source: trunk/source/lisp-kernel/windows-calls.c @ 11096

Last change on this file since 11096 was 11096, checked in by gb, 12 years ago

Stop supporting file descriptors for Windows file/device I/O.
(A handle on win64 is 64 bits wide; since a handle is an offset into
a kernel table, it seens very unlikely that this would be an issue,
but we should probably change the callers.)

Use the per-thread event handle in tcr->io_datum in the overlapped
struct on reads and writes; this should mean that things like
GetOverlappedResult?() return when that event is signaled, not when
the file handle is signaled because of other I/O activity in other
threads.

File size: 17.7 KB
Line 
1/*
2   Copyright (C) 2008, Clozure Associates and contributors,
3   This file is part of Clozure CL. 
4
5   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
6   License , known as the LLGPL and distributed with Clozure CL as the
7   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
8   which is distributed with Clozure CL as the file "LGPL".  Where these
9   conflict, the preamble takes precedence. 
10
11   Clozure CL is referenced in the preamble as the "LIBRARY."
12
13   The LLGPL is also available online at
14   http://opensource.franz.com/preamble.html
15*/
16
17#include "lisp.h"
18#include "x86-exceptions.h"
19#include <io.h>
20#include <unistd.h>
21#include <sys/fcntl.h>
22#include <errno.h>
23#include <sys/stat.h>
24#include <windows.h>
25#include <psapi.h>
26#include <dirent.h>
27#undef __argv
28#include <stdio.h>
29#include <math.h>
30
31#ifndef WIN_32
32#define _dosmaperr mingw_dosmaperr
33#else
34void
35_dosmaperr(unsigned long oserrno)
36{
37  switch(oserrno) {
38  case  ERROR_INVALID_FUNCTION:
39    errno = EINVAL;
40    break;
41  case ERROR_FILE_NOT_FOUND:
42    errno = ENOENT;
43    break;
44  case ERROR_PATH_NOT_FOUND:
45    errno = ENOENT;
46    break;
47  case  ERROR_TOO_MANY_OPEN_FILES:
48    errno = EMFILE;
49    break;
50  case  ERROR_ACCESS_DENIED:
51    errno = EACCES;
52    break;
53  case  ERROR_ARENA_TRASHED:
54    errno = ENOMEM;
55    break;
56  case  ERROR_NOT_ENOUGH_MEMORY:
57    errno = ENOMEM;
58    break;
59  case  ERROR_INVALID_BLOCK:
60    errno = ENOMEM;
61    break;
62  case  ERROR_BAD_ENVIRONMENT:
63    errno = E2BIG;
64    break;
65  case  ERROR_BAD_FORMAT:
66    errno = ENOEXEC;
67    break;
68  case  ERROR_INVALID_ACCESS:
69    errno = EINVAL;
70    break;
71  case  ERROR_INVALID_DATA:
72    errno = EINVAL;
73    break;
74  case  ERROR_INVALID_DRIVE:
75    errno = ENOENT;
76    break;
77  case  ERROR_CURRENT_DIRECTORY:
78    errno = EACCES;
79    break;
80  case  ERROR_NOT_SAME_DEVICE:
81    errno = EXDEV;
82    break;
83  case  ERROR_NO_MORE_FILES:
84    errno = ENOENT;
85    break;
86  case  ERROR_LOCK_VIOLATION:
87    errno = EACCES;
88    break;
89  case  ERROR_BAD_NETPATH:
90    errno = ENOENT;
91    break;
92  case  ERROR_NETWORK_ACCESS_DENIED:
93    errno = EACCES;
94    break;
95  case  ERROR_BAD_NET_NAME:
96    errno = ENOENT;
97    break;
98  case  ERROR_FILE_EXISTS:
99    errno = EEXIST;
100    break;
101  case  ERROR_CANNOT_MAKE:
102    errno = EACCES;
103    break;
104  case  ERROR_FAIL_I24:
105    errno = EACCES;
106    break;
107  case  ERROR_INVALID_PARAMETER:
108    errno = EINVAL;
109    break;
110  case  ERROR_NO_PROC_SLOTS:
111    errno = EAGAIN;
112    break;
113  case  ERROR_DRIVE_LOCKED:
114    errno = EACCES;
115    break;
116  case  ERROR_BROKEN_PIPE:
117    errno = EPIPE;
118    break;
119  case  ERROR_DISK_FULL:
120    errno = ENOSPC;
121    break;
122  case  ERROR_INVALID_TARGET_HANDLE:
123    errno = EBADF;
124    break;
125  case  ERROR_INVALID_HANDLE:
126    errno = EINVAL;
127    break;
128  case  ERROR_WAIT_NO_CHILDREN:
129    errno = ECHILD;
130    break;
131  case  ERROR_CHILD_NOT_COMPLETE:
132    errno = ECHILD;
133    break;
134  case  ERROR_DIRECT_ACCESS_HANDLE:
135    errno = EBADF;
136    break;
137  case  ERROR_NEGATIVE_SEEK:
138    errno = EINVAL;
139    break;
140  case  ERROR_SEEK_ON_DEVICE:   
141    errno = EACCES;
142    break;
143  case  ERROR_DIR_NOT_EMPTY:
144    errno = ENOTEMPTY;
145    break;
146  case  ERROR_NOT_LOCKED:
147    errno = EACCES;
148    break;
149  case  ERROR_BAD_PATHNAME:
150    errno = ENOENT;
151    break;
152  case  ERROR_MAX_THRDS_REACHED:
153    errno = EAGAIN;
154    break;
155  case  ERROR_LOCK_FAILED:
156    errno = EACCES;
157    break;
158  case  ERROR_ALREADY_EXISTS:
159    errno = EEXIST;
160    break;
161  case  ERROR_FILENAME_EXCED_RANGE:
162    errno = ENOENT;
163    break;
164  case  ERROR_NESTING_NOT_ALLOWED:
165    errno = EAGAIN;
166    break;
167  case  ERROR_NOT_ENOUGH_QUOTA:
168    errno = ENOMEM;
169    break;
170  default:
171    errno = EINVAL;
172    break;
173  }
174}
175   
176#endif
177
178#define MAX_FD 32
179
180HANDLE
181lisp_open(wchar_t *path, int flag, int mode)
182{
183  HANDLE hfile;
184  DWORD dwDesiredAccess = 0;
185  DWORD dwShareMode = 0;
186  DWORD dwCreationDistribution = 0;
187  DWORD dwFlagsAndAttributes = 0;
188  SECURITY_ATTRIBUTES sa = {sizeof(SECURITY_ATTRIBUTES), NULL, TRUE};
189
190  if ((flag & S_IREAD) == S_IREAD) {
191    dwShareMode = FILE_SHARE_READ;
192  } else {
193    if ((flag & S_IWRITE) == S_IWRITE) {
194      dwShareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;
195    }
196  }
197
198  if ((flag & _O_WRONLY) == _O_WRONLY) {
199    dwDesiredAccess |= GENERIC_WRITE | FILE_WRITE_DATA |
200      FILE_READ_ATTRIBUTES | FILE_WRITE_ATTRIBUTES;
201  } else if ((flag & _O_RDWR) == _O_RDWR) {
202    dwDesiredAccess |= GENERIC_WRITE|GENERIC_READ | FILE_READ_DATA |
203      FILE_WRITE_DATA | FILE_READ_ATTRIBUTES | FILE_WRITE_ATTRIBUTES;
204  } else {
205    dwDesiredAccess |= GENERIC_READ | FILE_READ_DATA | FILE_READ_ATTRIBUTES |
206      FILE_WRITE_ATTRIBUTES;
207  }
208   
209  if ((flag & S_IREAD) == S_IREAD) {
210    dwShareMode |= FILE_SHARE_READ;
211  }
212  if ((flag & S_IWRITE) == S_IWRITE) {
213    dwShareMode |= FILE_SHARE_WRITE;
214  }
215
216  if ((flag & (_O_CREAT | _O_EXCL)) == (_O_CREAT | _O_EXCL)) {
217    dwCreationDistribution |= CREATE_NEW;
218  } else if ((flag &  O_TRUNC) == O_TRUNC) {
219    if ((flag &  O_CREAT) ==  O_CREAT) {
220      dwCreationDistribution |= CREATE_ALWAYS;
221    } else if ((flag & O_RDONLY) != O_RDONLY) {
222      dwCreationDistribution |= TRUNCATE_EXISTING;
223    }
224  } else if ((flag & _O_APPEND) == _O_APPEND) {
225    dwCreationDistribution |= OPEN_EXISTING;
226  } else if ((flag &  _O_CREAT) == _O_CREAT) {
227    dwCreationDistribution |= OPEN_ALWAYS;
228  } else {
229    dwCreationDistribution |= OPEN_EXISTING;
230  }
231  if ((flag &  _O_RANDOM) == _O_RANDOM) {
232    dwFlagsAndAttributes |= FILE_FLAG_RANDOM_ACCESS;
233  }
234  if ((flag &  _O_SEQUENTIAL) == _O_SEQUENTIAL) {
235    dwFlagsAndAttributes |= FILE_FLAG_SEQUENTIAL_SCAN;
236  }
237
238  if ((flag &  _O_TEMPORARY) == _O_TEMPORARY) {
239    dwFlagsAndAttributes |= FILE_FLAG_DELETE_ON_CLOSE;
240  }
241
242  if ((flag &  _O_SHORT_LIVED) == _O_SHORT_LIVED) {
243    dwFlagsAndAttributes |= FILE_FLAG_DELETE_ON_CLOSE;
244  }
245
246  if (flag & _O_NOINHERIT) {
247    sa.bInheritHandle = FALSE;
248  }
249
250#if 0
251  dwFlagsAndAttributes |= FILE_FLAG_OVERLAPPED;
252#endif
253   
254
255  hfile = CreateFileW(path,
256                      dwDesiredAccess,
257                      dwShareMode,
258                      &sa,
259                      dwCreationDistribution,
260                      dwFlagsAndAttributes,
261                      NULL);
262  if (hfile == ((HANDLE)-1)) {
263    _dosmaperr(GetLastError());
264    return (HANDLE)-1;
265  }
266  return hfile;
267}
268
269int
270lisp_close(HANDLE hfile)
271{
272  if (CloseHandle(hfile)) {
273    return 0;
274  }
275  _dosmaperr(GetLastError());
276  return -1;
277}
278
279extern TCR *get_tcr(int);
280
281ssize_t
282lisp_read(HANDLE hfile, void *buf, unsigned int count)
283{
284  HANDLE hevent;
285  OVERLAPPED overlapped;
286  DWORD err, nread;
287  pending_io pending;
288  TCR *tcr;
289
290 
291  memset(&overlapped,0,sizeof(overlapped));
292
293  if (GetFileType(hfile) == FILE_TYPE_DISK) {
294    overlapped.Offset = SetFilePointer(hfile, 0, &(overlapped.OffsetHigh), FILE_CURRENT);
295  }
296
297  tcr = (TCR *)get_tcr(1);
298  pending.h = hfile;
299  pending.o = &overlapped;
300  tcr->pending_io_info = &pending;
301  hevent = (HANDLE)(tcr->io_datum);
302  overlapped.hEvent = hevent;
303  do {
304    ResetEvent(hevent);
305    if (ReadFile(hfile, buf, count, &nread, &overlapped)) {
306      tcr->pending_io_info = NULL;
307      return nread;
308    }
309    err = GetLastError();
310
311    if (err == ERROR_HANDLE_EOF) {
312      tcr->pending_io_info = NULL;
313      return 0;
314    }
315
316    if (err != ERROR_IO_PENDING) {
317      _dosmaperr(err);
318      tcr->pending_io_info = NULL;
319      return -1;
320    }
321 
322    err = 0;
323    /* We block here */
324    if (GetOverlappedResult(hfile, &overlapped, &nread, TRUE)) {
325      if (nread) {
326        tcr->pending_io_info = NULL;
327        return nread;
328      }
329    } else {
330      err = GetLastError();
331    }
332  } while (!err);
333  tcr->pending_io_info = NULL;
334
335  switch (err) {
336  case ERROR_HANDLE_EOF: 
337    return 0;
338  case ERROR_OPERATION_ABORTED:
339    errno = EINTR;
340    return -1;
341  default:
342    _dosmaperr(err);
343    return -1;
344  }
345}
346
347ssize_t
348lisp_write(HANDLE hfile, void *buf, ssize_t count)
349{
350  HANDLE hevent;
351  OVERLAPPED overlapped;
352  DWORD err, nwritten;
353  TCR *tcr = (TCR *)get_tcr(1);
354
355  hevent = (HANDLE)tcr->io_datum;
356
357
358  memset(&overlapped,0,sizeof(overlapped));
359
360  if (GetFileType(hfile) == FILE_TYPE_DISK) {
361    overlapped.Offset = SetFilePointer(hfile, 0, &(overlapped.OffsetHigh), FILE_CURRENT);
362  }
363
364  overlapped.hEvent = hevent;
365  ResetEvent(hevent);
366  if (WriteFile(hfile, buf, count, &nwritten, &overlapped)) {
367    return nwritten;
368  }
369 
370  err = GetLastError();
371  _dosmaperr(err);
372  return -1;
373}
374
375int
376lisp_fchmod(HANDLE hfile, int mode)
377{
378  errno = ENOSYS;
379  return -1;
380}
381
382__int64
383lisp_lseek(HANDLE hfile, __int64 offset, int whence)
384{
385  DWORD high, low;
386
387  high = ((__int64)offset)>>32;
388  low = offset & 0xffffffff;
389  low = SetFilePointer(hfile, low, &high, whence);
390  if (low != INVALID_SET_FILE_POINTER) {
391    return ((((__int64)high)<<32)|low);
392  }
393  _dosmaperr(GetLastError());
394  return -1;
395}
396
397#define ALL_USERS(f) ((f) | ((f)>> 3) | ((f >> 6)))
398#define STAT_READONLY ALL_USERS(_S_IREAD)
399#define STAT_READWRITE ALL_USERS((_S_IREAD|_S_IWRITE))
400int
401lisp_stat(wchar_t *path, struct __stat64 *buf)
402{
403  return _wstat64(path,buf);
404}
405
406#define UNIX_EPOCH_IN_WINDOWS_EPOCH  116444736000000000LL
407
408__time64_t
409filetime_to_unix_time(FILETIME *ft)
410{
411  __time64_t then = *((__time64_t *) ft);
412
413  then -= UNIX_EPOCH_IN_WINDOWS_EPOCH;
414  return then/10000000;
415}
416
417int
418lisp_fstat(HANDLE hfile, struct __stat64 *buf)
419{
420  int filetype;
421
422  filetype = GetFileType(hfile) & ~FILE_TYPE_REMOTE;
423
424  if (filetype == FILE_TYPE_UNKNOWN) {
425    errno = EBADF;
426    return -1;
427  }
428
429  memset(buf, 0, sizeof(*buf));
430  buf->st_nlink = 1;
431 
432  switch(filetype) {
433  case FILE_TYPE_CHAR:
434  case FILE_TYPE_PIPE:
435    if (filetype == FILE_TYPE_CHAR) {
436      buf->st_mode = _S_IFCHR;
437    } else {
438      buf->st_mode = _S_IFIFO;
439    }
440    break;
441  case FILE_TYPE_DISK:
442    {
443      BY_HANDLE_FILE_INFORMATION info;
444
445      if (!GetFileInformationByHandle(hfile, &info)) {
446        _dosmaperr(GetLastError());
447        return -1;
448      }
449
450      if (info.dwFileAttributes & FILE_ATTRIBUTE_READONLY) {
451        buf->st_mode = STAT_READONLY;
452      } else {
453        buf->st_mode = STAT_READWRITE;
454      }
455      buf->st_mode |= _S_IFREG;
456      buf->st_size = ((((__int64)(info.nFileSizeHigh))<<32LL) |
457                      ((__int64)(info.nFileSizeLow)));
458      buf->st_mtime = filetime_to_unix_time(&info.ftLastWriteTime);
459      buf->st_atime = filetime_to_unix_time(&info.ftLastAccessTime);
460      buf->st_ctime = filetime_to_unix_time(&info.ftCreationTime);
461    }
462    break;
463  case FILE_TYPE_UNKNOWN:
464  default:
465    errno = EBADF;
466    return -1;
467  }
468  return 0;
469}
470
471int
472lisp_futex(int *uaddr, int op, int val, void *timeout, int *uaddr2, int val3)
473{
474  errno = ENOSYS;
475  return -1;
476}
477
478
479__int64
480lisp_ftruncate(HANDLE hfile, off_t new_size)
481{
482  __int64 oldpos;
483
484
485  oldpos = lisp_lseek(hfile, 0, SEEK_END);
486  if (oldpos == -1) {
487    return 0;
488  }
489  if (oldpos < new_size) {
490    char buf[4096];
491    __int64 n = new_size-oldpos;
492    DWORD nwritten, to_write;
493
494    memset(buf,0,sizeof(buf));
495    while(n) {
496      if (n > 4096LL) {
497        to_write = 4096;
498      } else {
499        to_write = n;
500      }
501      if (!WriteFile(hfile,buf,to_write,&nwritten,NULL)) {
502        _dosmaperr(GetLastError());
503        return -1;
504      }
505      n -= nwritten;
506    }
507    return 0;
508  }
509  lisp_lseek(hfile, new_size, SEEK_SET);
510  if (SetEndOfFile(hfile)) {
511    return 0;
512  }
513  _dosmaperr(GetLastError());
514  return -1;
515}
516
517
518_WDIR *
519lisp_opendir(wchar_t *path)
520{
521  return _wopendir(path);
522}
523
524struct _wdirent *
525lisp_readdir(_WDIR *dir)
526{
527  return _wreaddir(dir);
528}
529
530__int64
531lisp_closedir(_WDIR *dir)
532{
533  return _wclosedir(dir);
534}
535
536int
537lisp_pipe(int fd[2])
538{
539  HANDLE input, output;
540  SECURITY_ATTRIBUTES sa;
541
542  sa.nLength= sizeof(SECURITY_ATTRIBUTES);
543  sa.lpSecurityDescriptor = NULL;
544  sa.bInheritHandle = TRUE;
545
546  if (!CreatePipe(&input, &output, &sa, 0))
547    {
548      wperror("CreatePipe");
549      return -1;
550    }
551  fd[0] = (int) ((intptr_t)input);
552  fd[1] = (int) ((intptr_t)output);
553  return 0;
554}
555
556int
557lisp_gettimeofday(struct timeval *tp, void *tzp)
558{
559  return gettimeofday(tp, tzp);
560}
561
562#ifdef WIN_64
563
564/* Make sure that the lisp calls these functions, when they do something */
565/* This code is taken from the 32-bit mingw library and is in the
566   public domain */
567double
568acosh(double x)
569{
570  if (isnan (x)) 
571    return x;
572
573  if (x < 1.0)
574    {
575      errno = EDOM;
576      return nan("");
577    }
578
579  if (x > 0x1p32)
580    /*  Avoid overflow (and unnecessary calculation when
581        sqrt (x * x - 1) == x). GCC optimizes by replacing
582        the long double M_LN2 const with a fldln2 insn.  */ 
583    return log (x) + 6.9314718055994530941723E-1L;
584
585  /* Since  x >= 1, the arg to log will always be greater than
586     the fyl2xp1 limit (approx 0.29) so just use logl. */ 
587  return log (x + sqrt((x + 1.0) * (x - 1.0)));
588}
589
590float
591acoshf(float x)
592{
593  if (isnan (x)) 
594    return x;
595  if (x < 1.0f)
596    {
597      errno = EDOM;
598      return nan("");
599    }
600
601 if (x > 0x1p32f)
602    /*  Avoid overflow (and unnecessary calculation when
603        sqrt (x * x - 1) == x). GCC optimizes by replacing
604        the long double M_LN2 const with a fldln2 insn.  */ 
605    return log (x) + 6.9314718055994530941723E-1L;
606
607  /* Since  x >= 1, the arg to log will always be greater than
608     the fyl2xp1 limit (approx 0.29) so just use logl. */ 
609  return log (x + sqrt((x + 1.0) * (x - 1.0)));
610}
611
612double
613asinh(double x)
614{
615  double z;
616  if (!isfinite (x))
617    return x;
618  z = fabs (x);
619
620  /* Avoid setting FPU underflow exception flag in x * x. */
621#if 0
622  if ( z < 0x1p-32)
623    return x;
624#endif
625
626  /* Use log1p to avoid cancellation with small x. Put
627     x * x in denom, so overflow is harmless.
628     asinh(x) = log1p (x + sqrt (x * x + 1.0) - 1.0)
629              = log1p (x + x * x / (sqrt (x * x + 1.0) + 1.0))  */
630
631  z = log1p (z + z * z / (sqrt (z * z + 1.0) + 1.0));
632
633  return ( x > 0.0 ? z : -z);
634}
635
636float
637asinhf(float x)
638{
639  float z;
640  if (!isfinite (x))
641    return x;
642  z = fabsf (x);
643
644  /* Avoid setting FPU underflow exception flag in x * x. */
645#if 0
646  if ( z < 0x1p-32)
647    return x;
648#endif
649
650
651  /* Use log1p to avoid cancellation with small x. Put
652     x * x in denom, so overflow is harmless.
653     asinh(x) = log1p (x + sqrt (x * x + 1.0) - 1.0)
654              = log1p (x + x * x / (sqrt (x * x + 1.0) + 1.0))  */
655
656  z = log1p (z + z * z / (sqrt (z * z + 1.0) + 1.0));
657
658  return ( x > 0.0 ? z : -z);
659}
660
661double
662atanh(double x)
663{
664  double z;
665  if (isnan (x))
666    return x;
667  z = fabs (x);
668  if (z == 1.0)
669    {
670      errno  = ERANGE;
671      return (x > 0 ? INFINITY : -INFINITY);
672    }
673  if (z > 1.0)
674    {
675      errno = EDOM;
676      return nan("");
677    }
678  /* Rearrange formula to avoid precision loss for small x.
679
680  atanh(x) = 0.5 * log ((1.0 + x)/(1.0 - x))
681           = 0.5 * log1p ((1.0 + x)/(1.0 - x) - 1.0)
682           = 0.5 * log1p ((1.0 + x - 1.0 + x) /(1.0 - x))
683           = 0.5 * log1p ((2.0 * x ) / (1.0 - x))  */
684  z = 0.5 * log1p ((z + z) / (1.0 - z));
685  return x >= 0 ? z : -z;
686}
687
688float
689atanhf(float x)
690{
691  float z;
692  if (isnan (x))
693    return x;
694  z = fabsf (x);
695  if (z == 1.0)
696    {
697      errno  = ERANGE;
698      return (x > 0 ? INFINITY : -INFINITY);
699    }
700  if ( z > 1.0)
701    {
702      errno = EDOM;
703      return nanf("");
704    }
705  /* Rearrange formula to avoid precision loss for small x.
706
707  atanh(x) = 0.5 * log ((1.0 + x)/(1.0 - x))
708           = 0.5 * log1p ((1.0 + x)/(1.0 - x) - 1.0)
709           = 0.5 * log1p ((1.0 + x - 1.0 + x) /(1.0 - x))
710           = 0.5 * log1p ((2.0 * x ) / (1.0 - x))  */
711  z = 0.5 * log1p ((z + z) / (1.0 - z));
712  return x >= 0 ? z : -z;
713}
714
715#endif
716
717typedef struct {
718  char *name;
719  void *addr;
720} math_fn_entry;
721
722
723math_fn_entry math_fn_entries [] = {
724  {"acos",acos},
725  {"acosf",acosf},
726  {"acosh",acosh},
727  {"acoshf",acoshf},
728  {"asin",asin},
729  {"asinf",asinf},
730  {"asinh",asinh},
731  {"asinhf",asinhf},
732  {"atan",atan},
733  {"atan2",atan2},
734  {"atan2f",atan2f},
735  {"atanf",atanf},
736  {"atanh",atanh},
737  {"atanhf",atanhf},
738  {"cos",cos},
739  {"cosf",cosf},
740  {"cosh",cosh},
741  {"coshf",coshf},
742  {"exp",exp},
743  {"expf",expf},
744  {"log",log},
745  {"logf",logf},
746  {"pow",pow},
747  {"powf",powf},
748  {"sin",sin},
749  {"sinf",sinf},
750  {"sinh",sinh},
751  {"sinhf",sinhf},
752  {"tan",tan},
753  {"tanf",tanf},
754  {"tanh",tanh},
755  {"tanhf",tanhf},
756  {NULL, 0}};
757
758void *
759lookup_math_fn(char *name)
760{
761  math_fn_entry *p = math_fn_entries;
762  char *entry_name;
763 
764  while ((entry_name = p->name) != NULL) {
765    if (!strcmp(name, entry_name)) {
766      return p->addr;
767    }
768    p++;
769  }
770  return NULL;
771}
772
773HMODULE *modules = NULL;
774DWORD cbmodules = 0;
775HANDLE find_symbol_lock = 0;
776
777void *
778windows_find_symbol(void *handle, char *name)
779{
780  void *addr;
781
782  if ((handle == ((void *)-2L)) ||
783      (handle == ((void *)-1L))) {
784    handle = NULL;
785  }
786  if (handle != NULL) {
787    addr = GetProcAddress(handle, name);
788  } else {
789    DWORD cbneeded,  have, i;
790    WaitForSingleObject(find_symbol_lock,INFINITE);
791
792    if (cbmodules == 0) {
793      cbmodules = 16 * sizeof(HANDLE);
794      modules = malloc(cbmodules);
795    }
796   
797    while (1) {
798      EnumProcessModules(GetCurrentProcess(),modules,cbmodules,&cbneeded);
799      if (cbmodules >= cbneeded) {
800        break;
801      }
802      cbmodules = cbneeded;
803      modules = realloc(modules,cbmodules);
804    }
805    have = cbneeded/sizeof(HANDLE);
806
807    for (i = 0; i < have; i++) {
808      addr = GetProcAddress(modules[i],name);
809
810      if (addr) {
811        break;
812      }
813    }
814    ReleaseMutex(find_symbol_lock);
815    if (addr) {
816      return addr;
817    }
818    return lookup_math_fn(name);
819  }
820}
821
822/* Note that we're using 8-bit strings here */
823
824void *
825windows_open_shared_library(char *path)
826{
827  HMODULE module = (HMODULE)0;
828
829  /* Try to open an existing module in a way that increments its
830     reference count without running any initialization code in
831     the dll. */
832  if (!GetModuleHandleExA(0,path,&module)) {
833    /* If that failed ... */
834    module = LoadLibraryA(path);
835  }
836  return (void *)module;
837}
838
839
840void
841init_windows_io()
842{
843#ifdef WIN_32
844  extern void init_win32_ldt(void);
845  init_win32_ldt();
846#endif
847  find_symbol_lock = CreateMutex(NULL,false,NULL);
848}
849
850void
851init_winsock()
852{
853  WSADATA data;
854
855  WSAStartup((2<<8)|2,&data);
856}
Note: See TracBrowser for help on using the repository browser.