source: branches/working-0711/ccl/lisp-kernel/windows-calls.c @ 11412

Last change on this file since 11412 was 11412, checked in by gz, 11 years ago

from trunk, assorted changes for other platforms

File size: 18.0 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  dwShareMode = FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE;
191
192  if ((flag & _O_WRONLY) == _O_WRONLY) {
193    dwDesiredAccess |= GENERIC_WRITE | FILE_WRITE_DATA |
194      FILE_READ_ATTRIBUTES | FILE_WRITE_ATTRIBUTES;
195  } else if ((flag & _O_RDWR) == _O_RDWR) {
196    dwDesiredAccess |= GENERIC_WRITE|GENERIC_READ | FILE_READ_DATA |
197      FILE_WRITE_DATA | FILE_READ_ATTRIBUTES | FILE_WRITE_ATTRIBUTES;
198  } else {
199    dwDesiredAccess |= GENERIC_READ | FILE_READ_DATA | FILE_READ_ATTRIBUTES |
200      FILE_WRITE_ATTRIBUTES;
201  }
202   
203
204  if ((flag & (_O_CREAT | _O_EXCL)) == (_O_CREAT | _O_EXCL)) {
205    dwCreationDistribution |= CREATE_NEW;
206  } else if ((flag &  O_TRUNC) == O_TRUNC) {
207    if ((flag &  O_CREAT) ==  O_CREAT) {
208      dwCreationDistribution |= CREATE_ALWAYS;
209    } else if ((flag & O_RDONLY) != O_RDONLY) {
210      dwCreationDistribution |= TRUNCATE_EXISTING;
211    }
212  } else if ((flag & _O_APPEND) == _O_APPEND) {
213    dwCreationDistribution |= OPEN_EXISTING;
214  } else if ((flag &  _O_CREAT) == _O_CREAT) {
215    dwCreationDistribution |= OPEN_ALWAYS;
216  } else {
217    dwCreationDistribution |= OPEN_EXISTING;
218  }
219  if ((flag &  _O_RANDOM) == _O_RANDOM) {
220    dwFlagsAndAttributes |= FILE_FLAG_RANDOM_ACCESS;
221  }
222  if ((flag &  _O_SEQUENTIAL) == _O_SEQUENTIAL) {
223    dwFlagsAndAttributes |= FILE_FLAG_SEQUENTIAL_SCAN;
224  }
225
226  if ((flag &  _O_TEMPORARY) == _O_TEMPORARY) {
227    dwFlagsAndAttributes |= FILE_FLAG_DELETE_ON_CLOSE;
228  }
229
230  if ((flag &  _O_SHORT_LIVED) == _O_SHORT_LIVED) {
231    dwFlagsAndAttributes |= FILE_FLAG_DELETE_ON_CLOSE;
232  }
233
234  if (flag & _O_NOINHERIT) {
235    sa.bInheritHandle = FALSE;
236  }
237
238#if 0
239  dwFlagsAndAttributes |= FILE_FLAG_OVERLAPPED;
240#endif
241   
242
243  hfile = CreateFileW(path,
244                      dwDesiredAccess,
245                      dwShareMode,
246                      &sa,
247                      dwCreationDistribution,
248                      dwFlagsAndAttributes,
249                      NULL);
250  if (hfile == ((HANDLE)-1)) {
251    _dosmaperr(GetLastError());
252    return (HANDLE)-1;
253  }
254  return hfile;
255}
256
257int
258lisp_close(HANDLE hfile)
259{
260  if (CloseHandle(hfile)) {
261    return 0;
262  }
263  _dosmaperr(GetLastError());
264  return -1;
265}
266
267extern TCR *get_tcr(int);
268
269ssize_t
270lisp_read(HANDLE hfile, void *buf, unsigned int count)
271{
272  HANDLE hevent;
273  OVERLAPPED overlapped;
274  DWORD err, nread, wait_result;
275  pending_io pending;
276  TCR *tcr;
277 
278 
279  memset(&overlapped,0,sizeof(overlapped));
280
281  if (GetFileType(hfile) == FILE_TYPE_DISK) {
282    overlapped.Offset = SetFilePointer(hfile, 0, &(overlapped.OffsetHigh), FILE_CURRENT);
283  }
284
285  tcr = (TCR *)get_tcr(1);
286  pending.h = hfile;
287  pending.o = &overlapped;
288  tcr->pending_io_info = &pending;
289  hevent = (HANDLE)(tcr->io_datum);
290  overlapped.hEvent = hevent;
291  ResetEvent(hevent);
292  if (ReadFile(hfile, buf, count, &nread, &overlapped)) {
293    tcr->pending_io_info = NULL;
294    return nread;
295  }
296  err = GetLastError();
297 
298  if (err == ERROR_HANDLE_EOF) {
299    tcr->pending_io_info = NULL;
300    return 0;
301  }
302
303  if (err != ERROR_IO_PENDING) {
304    _dosmaperr(err);
305    tcr->pending_io_info = NULL;
306    return -1;
307  }
308 
309  err = 0;
310 
311  /* We block here */   
312  wait_result = WaitForSingleObjectEx(hevent, INFINITE, true);
313  tcr->pending_io_info = NULL;
314  if (wait_result == WAIT_OBJECT_0) {
315    err = overlapped.Internal;
316    if (err == ERROR_HANDLE_EOF) {
317      return 0;
318    }
319    if (err) {
320      _dosmaperr(err);
321      return -1;
322    }
323    return overlapped.InternalHigh;
324  }
325
326  if (wait_result == WAIT_IO_COMPLETION) {
327    CancelIo(hfile);
328    errno = EINTR;
329    return -1;
330  }
331  err = GetLastError();
332 
333
334  switch (err) {
335  case ERROR_HANDLE_EOF: 
336    return 0;
337  case ERROR_OPERATION_ABORTED:
338    errno = EINTR;
339    return -1;
340  default:
341    _dosmaperr(err);
342    return -1;
343  }
344}
345
346ssize_t
347lisp_write(HANDLE hfile, void *buf, ssize_t count)
348{
349  HANDLE hevent;
350  OVERLAPPED overlapped;
351  DWORD err, nwritten;
352  TCR *tcr = (TCR *)get_tcr(1);
353
354  hevent = (HANDLE)tcr->io_datum;
355  if (hfile == (HANDLE)1) {
356    hfile = GetStdHandle(STD_OUTPUT_HANDLE);
357  } else if (hfile == (HANDLE) 2) {
358    hfile = GetStdHandle(STD_ERROR_HANDLE);
359  }
360
361
362  memset(&overlapped,0,sizeof(overlapped));
363
364  if (GetFileType(hfile) == FILE_TYPE_DISK) {
365    overlapped.Offset = SetFilePointer(hfile, 0, &(overlapped.OffsetHigh), FILE_CURRENT);
366  }
367
368  overlapped.hEvent = hevent;
369  ResetEvent(hevent);
370  if (WriteFile(hfile, buf, count, &nwritten, &overlapped)) {
371    return nwritten;
372  }
373 
374  err = GetLastError();
375  _dosmaperr(err);
376  return -1;
377}
378
379int
380lisp_fchmod(HANDLE hfile, int mode)
381{
382  errno = ENOSYS;
383  return -1;
384}
385
386__int64
387lisp_lseek(HANDLE hfile, __int64 offset, int whence)
388{
389  DWORD high, low;
390
391  high = ((__int64)offset)>>32;
392  low = offset & 0xffffffff;
393  low = SetFilePointer(hfile, low, &high, whence);
394  if (low != INVALID_SET_FILE_POINTER) {
395    return ((((__int64)high)<<32)|low);
396  }
397  _dosmaperr(GetLastError());
398  return -1;
399}
400
401#define ALL_USERS(f) ((f) | ((f)>> 3) | ((f >> 6)))
402#define STAT_READONLY ALL_USERS(_S_IREAD)
403#define STAT_READWRITE ALL_USERS((_S_IREAD|_S_IWRITE))
404int
405lisp_stat(wchar_t *path, struct __stat64 *buf)
406{
407  return _wstat64(path,buf);
408}
409
410#define UNIX_EPOCH_IN_WINDOWS_EPOCH  116444736000000000LL
411
412__time64_t
413filetime_to_unix_time(FILETIME *ft)
414{
415  __time64_t then = *((__time64_t *) ft);
416
417  then -= UNIX_EPOCH_IN_WINDOWS_EPOCH;
418  return then/10000000;
419}
420
421int
422lisp_fstat(HANDLE hfile, struct __stat64 *buf)
423{
424  int filetype;
425
426  filetype = GetFileType(hfile) & ~FILE_TYPE_REMOTE;
427
428  if (filetype == FILE_TYPE_UNKNOWN) {
429    errno = EBADF;
430    return -1;
431  }
432
433  memset(buf, 0, sizeof(*buf));
434  buf->st_nlink = 1;
435 
436  switch(filetype) {
437  case FILE_TYPE_CHAR:
438  case FILE_TYPE_PIPE:
439    if (filetype == FILE_TYPE_CHAR) {
440      buf->st_mode = _S_IFCHR;
441    } else {
442      buf->st_mode = _S_IFIFO;
443    }
444    break;
445  case FILE_TYPE_DISK:
446    {
447      BY_HANDLE_FILE_INFORMATION info;
448
449      if (!GetFileInformationByHandle(hfile, &info)) {
450        _dosmaperr(GetLastError());
451        return -1;
452      }
453
454      if (info.dwFileAttributes & FILE_ATTRIBUTE_READONLY) {
455        buf->st_mode = STAT_READONLY;
456      } else {
457        buf->st_mode = STAT_READWRITE;
458      }
459      buf->st_mode |= _S_IFREG;
460      buf->st_size = ((((__int64)(info.nFileSizeHigh))<<32LL) |
461                      ((__int64)(info.nFileSizeLow)));
462      buf->st_mtime = filetime_to_unix_time(&info.ftLastWriteTime);
463      buf->st_atime = filetime_to_unix_time(&info.ftLastAccessTime);
464      buf->st_ctime = filetime_to_unix_time(&info.ftCreationTime);
465    }
466    break;
467  case FILE_TYPE_UNKNOWN:
468  default:
469    errno = EBADF;
470    return -1;
471  }
472  return 0;
473}
474
475int
476lisp_futex(int *uaddr, int op, int val, void *timeout, int *uaddr2, int val3)
477{
478  errno = ENOSYS;
479  return -1;
480}
481
482
483__int64
484lisp_ftruncate(HANDLE hfile, off_t new_size)
485{
486  __int64 oldpos;
487
488
489  oldpos = lisp_lseek(hfile, 0, SEEK_END);
490  if (oldpos == -1) {
491    return 0;
492  }
493  if (oldpos < new_size) {
494    char buf[4096];
495    __int64 n = new_size-oldpos;
496    DWORD nwritten, to_write;
497
498    memset(buf,0,sizeof(buf));
499    while(n) {
500      if (n > 4096LL) {
501        to_write = 4096;
502      } else {
503        to_write = n;
504      }
505      if (!WriteFile(hfile,buf,to_write,&nwritten,NULL)) {
506        _dosmaperr(GetLastError());
507        return -1;
508      }
509      n -= nwritten;
510    }
511    return 0;
512  }
513  lisp_lseek(hfile, new_size, SEEK_SET);
514  if (SetEndOfFile(hfile)) {
515    return 0;
516  }
517  _dosmaperr(GetLastError());
518  return -1;
519}
520
521
522_WDIR *
523lisp_opendir(wchar_t *path)
524{
525  return _wopendir(path);
526}
527
528struct _wdirent *
529lisp_readdir(_WDIR *dir)
530{
531  return _wreaddir(dir);
532}
533
534__int64
535lisp_closedir(_WDIR *dir)
536{
537  return _wclosedir(dir);
538}
539
540int
541lisp_pipe(int fd[2])
542{
543  HANDLE input, output;
544  SECURITY_ATTRIBUTES sa;
545
546  sa.nLength= sizeof(SECURITY_ATTRIBUTES);
547  sa.lpSecurityDescriptor = NULL;
548  sa.bInheritHandle = TRUE;
549
550  if (!CreatePipe(&input, &output, &sa, 0))
551    {
552      wperror("CreatePipe");
553      return -1;
554    }
555  fd[0] = (int) ((intptr_t)input);
556  fd[1] = (int) ((intptr_t)output);
557  return 0;
558}
559
560int
561lisp_gettimeofday(struct timeval *tp, void *tzp)
562{
563  __time64_t now;
564
565  gettimeofday(tp,tzp);       /* trust it to get time zone right, at least */
566  GetSystemTimeAsFileTime((FILETIME*)&now);
567  now -= UNIX_EPOCH_IN_WINDOWS_EPOCH;
568  now /= 10000;
569  tp->tv_sec = now/1000LL;
570  tp->tv_usec = now%1000LL;
571  return 0;
572}
573
574#ifdef WIN_64
575
576/* Make sure that the lisp calls these functions, when they do something */
577/* This code is taken from the 32-bit mingw library and is in the
578   public domain */
579double
580acosh(double x)
581{
582  if (isnan (x)) 
583    return x;
584
585  if (x < 1.0)
586    {
587      errno = EDOM;
588      return nan("");
589    }
590
591  if (x > 0x1p32)
592    /*  Avoid overflow (and unnecessary calculation when
593        sqrt (x * x - 1) == x). GCC optimizes by replacing
594        the long double M_LN2 const with a fldln2 insn.  */ 
595    return log (x) + 6.9314718055994530941723E-1L;
596
597  /* Since  x >= 1, the arg to log will always be greater than
598     the fyl2xp1 limit (approx 0.29) so just use logl. */ 
599  return log (x + sqrt((x + 1.0) * (x - 1.0)));
600}
601
602float
603acoshf(float x)
604{
605  if (isnan (x)) 
606    return x;
607  if (x < 1.0f)
608    {
609      errno = EDOM;
610      return nan("");
611    }
612
613 if (x > 0x1p32f)
614    /*  Avoid overflow (and unnecessary calculation when
615        sqrt (x * x - 1) == x). GCC optimizes by replacing
616        the long double M_LN2 const with a fldln2 insn.  */ 
617    return log (x) + 6.9314718055994530941723E-1L;
618
619  /* Since  x >= 1, the arg to log will always be greater than
620     the fyl2xp1 limit (approx 0.29) so just use logl. */ 
621  return log (x + sqrt((x + 1.0) * (x - 1.0)));
622}
623
624double
625asinh(double x)
626{
627  double z;
628  if (!isfinite (x))
629    return x;
630  z = fabs (x);
631
632  /* Avoid setting FPU underflow exception flag in x * x. */
633#if 0
634  if ( z < 0x1p-32)
635    return x;
636#endif
637
638  /* Use log1p to avoid cancellation with small x. Put
639     x * x in denom, so overflow is harmless.
640     asinh(x) = log1p (x + sqrt (x * x + 1.0) - 1.0)
641              = log1p (x + x * x / (sqrt (x * x + 1.0) + 1.0))  */
642
643  z = log1p (z + z * z / (sqrt (z * z + 1.0) + 1.0));
644
645  return ( x >= 0.0 ? z : -z);
646}
647
648float
649asinhf(float x)
650{
651  float z;
652  if (!isfinite (x))
653    return x;
654  z = fabsf (x);
655
656  /* Avoid setting FPU underflow exception flag in x * x. */
657#if 0
658  if ( z < 0x1p-32)
659    return x;
660#endif
661
662
663  /* Use log1p to avoid cancellation with small x. Put
664     x * x in denom, so overflow is harmless.
665     asinh(x) = log1p (x + sqrt (x * x + 1.0) - 1.0)
666              = log1p (x + x * x / (sqrt (x * x + 1.0) + 1.0))  */
667
668  z = log1p (z + z * z / (sqrt (z * z + 1.0) + 1.0));
669
670  return ( x >= 0.0 ? z : -z);
671}
672
673double
674atanh(double x)
675{
676  double z;
677  if (isnan (x))
678    return x;
679  z = fabs (x);
680  if (z == 1.0)
681    {
682      errno  = ERANGE;
683      return (x > 0 ? INFINITY : -INFINITY);
684    }
685  if (z > 1.0)
686    {
687      errno = EDOM;
688      return nan("");
689    }
690  /* Rearrange formula to avoid precision loss for small x.
691
692  atanh(x) = 0.5 * log ((1.0 + x)/(1.0 - x))
693           = 0.5 * log1p ((1.0 + x)/(1.0 - x) - 1.0)
694           = 0.5 * log1p ((1.0 + x - 1.0 + x) /(1.0 - x))
695           = 0.5 * log1p ((2.0 * x ) / (1.0 - x))  */
696  z = 0.5 * log1p ((z + z) / (1.0 - z));
697  return x >= 0 ? z : -z;
698}
699
700float
701atanhf(float x)
702{
703  float z;
704  if (isnan (x))
705    return x;
706  z = fabsf (x);
707  if (z == 1.0)
708    {
709      errno  = ERANGE;
710      return (x > 0 ? INFINITY : -INFINITY);
711    }
712  if ( z > 1.0)
713    {
714      errno = EDOM;
715      return nanf("");
716    }
717  /* Rearrange formula to avoid precision loss for small x.
718
719  atanh(x) = 0.5 * log ((1.0 + x)/(1.0 - x))
720           = 0.5 * log1p ((1.0 + x)/(1.0 - x) - 1.0)
721           = 0.5 * log1p ((1.0 + x - 1.0 + x) /(1.0 - x))
722           = 0.5 * log1p ((2.0 * x ) / (1.0 - x))  */
723  z = 0.5 * log1p ((z + z) / (1.0 - z));
724  return x >= 0 ? z : -z;
725}
726
727#endif
728
729typedef struct {
730  char *name;
731  void *addr;
732} math_fn_entry;
733
734
735math_fn_entry math_fn_entries [] = {
736  {"acos",acos},
737  {"acosf",acosf},
738  {"acosh",acosh},
739  {"acoshf",acoshf},
740  {"asin",asin},
741  {"asinf",asinf},
742  {"asinh",asinh},
743  {"asinhf",asinhf},
744  {"atan",atan},
745  {"atan2",atan2},
746  {"atan2f",atan2f},
747  {"atanf",atanf},
748  {"atanh",atanh},
749  {"atanhf",atanhf},
750  {"cos",cos},
751  {"cosf",cosf},
752  {"cosh",cosh},
753  {"coshf",coshf},
754  {"exp",exp},
755  {"expf",expf},
756  {"log",log},
757  {"logf",logf},
758  {"pow",pow},
759  {"powf",powf},
760  {"sin",sin},
761  {"sinf",sinf},
762  {"sinh",sinh},
763  {"sinhf",sinhf},
764  {"tan",tan},
765  {"tanf",tanf},
766  {"tanh",tanh},
767  {"tanhf",tanhf},
768  {NULL, 0}};
769
770void *
771lookup_math_fn(char *name)
772{
773  math_fn_entry *p = math_fn_entries;
774  char *entry_name;
775 
776  while ((entry_name = p->name) != NULL) {
777    if (!strcmp(name, entry_name)) {
778      return p->addr;
779    }
780    p++;
781  }
782  return NULL;
783}
784
785HMODULE *modules = NULL;
786DWORD cbmodules = 0;
787HANDLE find_symbol_lock = 0;
788
789void *
790windows_find_symbol(void *handle, char *name)
791{
792  void *addr;
793
794  if ((handle == ((void *)-2L)) ||
795      (handle == ((void *)-1L))) {
796    handle = NULL;
797  }
798  if (handle != NULL) {
799    addr = GetProcAddress(handle, name);
800  } else {
801    DWORD cbneeded,  have, i;
802    WaitForSingleObject(find_symbol_lock,INFINITE);
803
804    if (cbmodules == 0) {
805      cbmodules = 16 * sizeof(HANDLE);
806      modules = malloc(cbmodules);
807    }
808   
809    while (1) {
810      EnumProcessModules(GetCurrentProcess(),modules,cbmodules,&cbneeded);
811      if (cbmodules >= cbneeded) {
812        break;
813      }
814      cbmodules = cbneeded;
815      modules = realloc(modules,cbmodules);
816    }
817    have = cbneeded/sizeof(HANDLE);
818
819    for (i = 0; i < have; i++) {
820      addr = GetProcAddress(modules[i],name);
821
822      if (addr) {
823        break;
824      }
825    }
826    ReleaseMutex(find_symbol_lock);
827    if (addr) {
828      return addr;
829    }
830    return lookup_math_fn(name);
831  }
832}
833
834/* Note that we're using 8-bit strings here */
835
836void *
837windows_open_shared_library(char *path)
838{
839  HMODULE module = (HMODULE)0;
840
841  /* Try to open an existing module in a way that increments its
842     reference count without running any initialization code in
843     the dll. */
844  if (!GetModuleHandleExA(0,path,&module)) {
845    /* If that failed ... */
846    module = LoadLibraryA(path);
847  }
848  return (void *)module;
849}
850
851
852void
853init_windows_io()
854{
855#ifdef WIN_32
856  extern void init_win32_ldt(void);
857  init_win32_ldt();
858#endif
859  find_symbol_lock = CreateMutex(NULL,false,NULL);
860}
861
862void
863init_winsock()
864{
865  WSADATA data;
866
867  WSAStartup((2<<8)|2,&data);
868}
Note: See TracBrowser for help on using the repository browser.