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

Last change on this file since 12196 was 12196, checked in by gz, 10 years ago

Merge r11497:r11498 into trunk: pass signal number through to async quit handler so can exit by resignalling.

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