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

Last change on this file since 11497 was 11497, checked in by gz, 12 years ago

Add a lisp_sigexit kernel-import, to allow exit by resignalling

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