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

Last change on this file since 12095 was 12095, checked in by gb, 10 years ago

On Windows, try to obtain the UTF-16 version of argv; change some
of the functions that deal with determining the image name and
opening the image to accept UTF-16-encoded strings. When the
kernel's done with the image name and argv, convert the strings
involved to UTF-8 (since this doesn't lose information and makes
it a little easier to bootstrap changes to the lisp side of this.)

On the lisp side of this (when obtaining the heap image name and
command-line arguments), assume that the strings are UTF-8-encoded
and possibly do platform-dependent postprocessing. (I honestly
don't know how to reliably tell what encoding was used for things
that come from the command line on other platforms; if they may
not be UTF-8, we might want to make similar changes in the kernel
to support other encodings.

This is supposed to help address ticket:475; I don't know yet if
it does, or if the kernel changes will compie on non-Windows platforms.
One way to find out ...

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