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

Last change on this file since 11089 was 11089, checked in by gz, 13 years ago

Merge/bootstrap assorted low level stuff from trunk - kernel, syscall stuff, lowmem-bias, formatting tweaks, a few bug fixes included

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