1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
9 * Copyright (C) 1992-2007, Free Software Foundation, Inc. *
11 * GNAT is free software; you can redistribute it and/or modify it under *
12 * terms of the GNU General Public License as published by the Free Soft- *
13 * ware Foundation; either version 2, or (at your option) any later ver- *
14 * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
15 * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
16 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
17 * for more details. You should have received a copy of the GNU General *
18 * Public License distributed with GNAT; see file COPYING. If not, write *
19 * to the Free Software Foundation, 51 Franklin Street, Fifth Floor, *
20 * Boston, MA 02110-1301, USA. *
22 * As a special exception, if you link this file with other files to *
23 * produce an executable, this file does not by itself cause the resulting *
24 * executable to be covered by the GNU General Public License. This except- *
25 * ion does not however invalidate any other reasons why the executable *
26 * file might be covered by the GNU Public License. *
28 * GNAT was originally developed by the GNAT team at New York University. *
29 * Extensive contributions were provided by Ada Core Technologies Inc. *
31 ****************************************************************************/
33 /* This file contains those routines named by Import pragmas in
34 packages in the GNAT hierarchy (especially GNAT.OS_Lib) and in
35 package Osint. Many of the subprograms in OS_Lib import standard
36 library calls directly. This file contains all other routines. */
40 /* No need to redefine exit here. */
43 /* We want to use the POSIX variants of include files. */
47 #if defined (__mips_vxworks)
49 #endif /* __mips_vxworks */
55 #define HOST_EXECUTABLE_SUFFIX ".exe"
56 #define HOST_OBJECT_SUFFIX ".obj"
70 /* We don't have libiberty, so use malloc. */
71 #define xmalloc(S) malloc (S)
72 #define xrealloc(V,S) realloc (V,S)
82 #include <sys/utime.h>
84 #elif defined (__MINGW32__)
87 #include <sys/utime.h>
90 #elif defined (__Lynx__)
92 /* Lynx utime.h only defines the entities of interest to us if
93 defined (VMOS_DEV), so ... */
102 /* wait.h processing */
105 #include <sys/wait.h>
107 #elif defined (__vxworks) && defined (__RTP__)
109 #elif defined (__Lynx__)
110 /* ??? We really need wait.h and it includes resource.h on Lynx. GCC
111 has a resource.h header as well, included instead of the lynx
112 version in our setup, causing lots of errors. We don't really need
113 the lynx contents of this file, so just workaround the issue by
114 preventing the inclusion of the GCC header from doing anything. */
115 #define GCC_RESOURCE_H
116 #include <sys/wait.h>
117 #elif defined (__nucleus__)
118 /* No wait() or waitpid() calls available */
121 #include <sys/wait.h>
124 #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
127 /* Header files and definitions for __gnat_set_file_time_name. */
129 #define __NEW_STARLET 1
131 #include <vms/atrdef.h>
132 #include <vms/fibdef.h>
133 #include <vms/stsdef.h>
134 #include <vms/iodef.h>
136 #include <vms/descrip.h>
140 /* Use native 64-bit arithmetic. */
141 #define unix_time_to_vms(X,Y) \
142 { unsigned long long reftime, tmptime = (X); \
143 $DESCRIPTOR (unixtime,"1-JAN-1970 0:00:00.00"); \
144 SYS$BINTIM (&unixtime, &reftime); \
145 Y = tmptime * 10000000 + reftime; }
147 /* descrip.h doesn't have everything ... */
148 typedef struct fibdef* __fibdef_ptr32 __attribute__ (( mode (SI) ));
149 struct dsc$descriptor_fib
151 unsigned int fib$l_len;
152 __fibdef_ptr32 fib$l_addr;
155 /* I/O Status Block. */
158 unsigned short status, count;
162 static char *tryfile;
164 /* Variable length string. */
168 char string[NAM$C_MAXRSS+1];
175 #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
183 #define DIR_SEPARATOR '\\'
188 /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
189 defined in the current system. On DOS-like systems these flags control
190 whether the file is opened/created in text-translation mode (CR/LF in
191 external file mapped to LF in internal file), but in Unix-like systems,
192 no text translation is required, so these flags have no effect. */
194 #if defined (__EMX__)
210 #ifndef HOST_EXECUTABLE_SUFFIX
211 #define HOST_EXECUTABLE_SUFFIX ""
214 #ifndef HOST_OBJECT_SUFFIX
215 #define HOST_OBJECT_SUFFIX ".o"
218 #ifndef PATH_SEPARATOR
219 #define PATH_SEPARATOR ':'
222 #ifndef DIR_SEPARATOR
223 #define DIR_SEPARATOR '/'
226 /* Check for cross-compilation */
227 #ifdef CROSS_DIRECTORY_STRUCTURE
228 int __gnat_is_cross_compiler = 1;
230 int __gnat_is_cross_compiler = 0;
233 char __gnat_dir_separator = DIR_SEPARATOR;
235 char __gnat_path_separator = PATH_SEPARATOR;
237 /* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
238 the base filenames that libraries specified with -lsomelib options
239 may have. This is used by GNATMAKE to check whether an executable
240 is up-to-date or not. The syntax is
242 library_template ::= { pattern ; } pattern NUL
243 pattern ::= [ prefix ] * [ postfix ]
245 These should only specify names of static libraries as it makes
246 no sense to determine at link time if dynamic-link libraries are
247 up to date or not. Any libraries that are not found are supposed
250 * if they are needed but not present, the link
253 * otherwise they are libraries in the system paths and so
254 they are considered part of the system and not checked
257 ??? This should be part of a GNAT host-specific compiler
258 file instead of being included in all user applications
259 as well. This is only a temporary work-around for 3.11b. */
261 #ifndef GNAT_LIBRARY_TEMPLATE
262 #if defined (__EMX__)
263 #define GNAT_LIBRARY_TEMPLATE "*.a"
265 #define GNAT_LIBRARY_TEMPLATE "*.olb"
267 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
271 const char *__gnat_library_template = GNAT_LIBRARY_TEMPLATE;
273 /* This variable is used in hostparm.ads to say whether the host is a VMS
276 const int __gnat_vmsp = 1;
278 const int __gnat_vmsp = 0;
282 #define GNAT_MAX_PATH_LEN MAX_PATH
285 #define GNAT_MAX_PATH_LEN 256 /* PATH_MAX */
287 #elif defined (__vxworks) || defined (__OPENNT) || defined(__nucleus__)
288 #define GNAT_MAX_PATH_LEN PATH_MAX
292 #if defined (__MINGW32__)
296 #include <sys/param.h>
300 #include <sys/param.h>
304 #define GNAT_MAX_PATH_LEN MAXPATHLEN
306 #define GNAT_MAX_PATH_LEN 256
311 /* The __gnat_max_path_len variable is used to export the maximum
312 length of a path name to Ada code. max_path_len is also provided
313 for compatibility with older GNAT versions, please do not use
316 int __gnat_max_path_len = GNAT_MAX_PATH_LEN;
317 int max_path_len = GNAT_MAX_PATH_LEN;
319 /* The following macro HAVE_READDIR_R should be defined if the
320 system provides the routine readdir_r. */
321 #undef HAVE_READDIR_R
323 #if defined(VMS) && defined (__LONG_POINTERS)
325 /* Return a 32 bit pointer to an array of 32 bit pointers
326 given a 64 bit pointer to an array of 64 bit pointers */
328 typedef __char_ptr32 *__char_ptr_char_ptr32 __attribute__ ((mode (SI)));
330 static __char_ptr_char_ptr32
331 to_ptr32 (char **ptr64)
334 __char_ptr_char_ptr32 short_argv;
336 for (argc=0; ptr64[argc]; argc++);
338 /* Reallocate argv with 32 bit pointers. */
339 short_argv = (__char_ptr_char_ptr32) decc$malloc
340 (sizeof (__char_ptr32) * (argc + 1));
342 for (argc=0; ptr64[argc]; argc++)
343 short_argv[argc] = (__char_ptr32) decc$strdup (ptr64[argc]);
345 short_argv[argc] = (__char_ptr32) 0;
349 #define MAYBE_TO_PTR32(argv) to_ptr32 (argv)
351 #define MAYBE_TO_PTR32(argv) argv
358 time_t res = time (NULL);
359 return (OS_Time) res;
373 time_t time = (time_t) *p_time;
376 /* On Windows systems, the time is sometimes rounded up to the nearest
377 even second, so if the number of seconds is odd, increment it. */
383 res = localtime (&time);
385 res = gmtime (&time);
390 *p_year = res->tm_year;
391 *p_month = res->tm_mon;
392 *p_day = res->tm_mday;
393 *p_hours = res->tm_hour;
394 *p_mins = res->tm_min;
395 *p_secs = res->tm_sec;
398 *p_year = *p_month = *p_day = *p_hours = *p_mins = *p_secs = 0;
401 /* Place the contents of the symbolic link named PATH in the buffer BUF,
402 which has size BUFSIZ. If PATH is a symbolic link, then return the number
403 of characters of its content in BUF. Otherwise, return -1.
404 For systems not supporting symbolic links, always return -1. */
407 __gnat_readlink (char *path ATTRIBUTE_UNUSED,
408 char *buf ATTRIBUTE_UNUSED,
409 size_t bufsiz ATTRIBUTE_UNUSED)
411 #if defined (MSDOS) || defined (_WIN32) || defined (__EMX__) \
412 || defined (VMS) || defined(__vxworks) || defined (__nucleus__)
415 return readlink (path, buf, bufsiz);
419 /* Creates a symbolic link named NEWPATH which contains the string OLDPATH.
420 If NEWPATH exists it will NOT be overwritten.
421 For systems not supporting symbolic links, always return -1. */
424 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED,
425 char *newpath ATTRIBUTE_UNUSED)
427 #if defined (MSDOS) || defined (_WIN32) || defined (__EMX__) \
428 || defined (VMS) || defined(__vxworks) || defined (__nucleus__)
431 return symlink (oldpath, newpath);
435 /* Try to lock a file, return 1 if success. */
437 #if defined (__vxworks) || defined (__nucleus__) || defined (MSDOS) || defined (_WIN32)
439 /* Version that does not use link. */
442 __gnat_try_lock (char *dir, char *file)
446 TCHAR wfull_path[GNAT_MAX_PATH_LEN];
447 TCHAR wfile[GNAT_MAX_PATH_LEN];
448 TCHAR wdir[GNAT_MAX_PATH_LEN];
450 S2WSU (wdir, dir, GNAT_MAX_PATH_LEN);
451 S2WSU (wfile, file, GNAT_MAX_PATH_LEN);
453 _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
454 fd = _topen (wfull_path, O_CREAT | O_EXCL, 0600);
458 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
459 fd = open (full_path, O_CREAT | O_EXCL, 0600);
469 #elif defined (__EMX__) || defined (VMS)
471 /* More cases that do not use link; identical code, to solve too long
475 __gnat_try_lock (char *dir, char *file)
480 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
481 fd = open (full_path, O_CREAT | O_EXCL, 0600);
492 /* Version using link(), more secure over NFS. */
493 /* See TN 6913-016 for discussion ??? */
496 __gnat_try_lock (char *dir, char *file)
500 struct stat stat_result;
503 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
504 sprintf (temp_file, "%s%cTMP-%ld-%ld",
505 dir, DIR_SEPARATOR, (long)getpid(), (long)getppid ());
507 /* Create the temporary file and write the process number. */
508 fd = open (temp_file, O_CREAT | O_WRONLY, 0600);
514 /* Link it with the new file. */
515 link (temp_file, full_path);
517 /* Count the references on the old one. If we have a count of two, then
518 the link did succeed. Remove the temporary file before returning. */
519 __gnat_stat (temp_file, &stat_result);
521 return stat_result.st_nlink == 2;
525 /* Return the maximum file name length. */
528 __gnat_get_maximum_file_name_length (void)
533 if (getenv ("GNAT$EXTENDED_FILE_SPECIFICATIONS"))
542 /* Return nonzero if file names are case sensitive. */
545 __gnat_get_file_names_case_sensitive (void)
547 #if defined (__EMX__) || defined (MSDOS) || defined (VMS) || defined (WINNT)
555 __gnat_get_default_identifier_character_set (void)
557 #if defined (__EMX__) || defined (MSDOS)
564 /* Return the current working directory. */
567 __gnat_get_current_dir (char *dir, int *length)
569 #if defined (__MINGW32__)
570 TCHAR wdir[GNAT_MAX_PATH_LEN];
572 _tgetcwd (wdir, *length);
574 WS2SU (dir, wdir, GNAT_MAX_PATH_LEN);
577 /* Force Unix style, which is what GNAT uses internally. */
578 getcwd (dir, *length, 0);
580 getcwd (dir, *length);
583 *length = strlen (dir);
585 if (dir [*length - 1] != DIR_SEPARATOR)
587 dir [*length] = DIR_SEPARATOR;
593 /* Return the suffix for object files. */
596 __gnat_get_object_suffix_ptr (int *len, const char **value)
598 *value = HOST_OBJECT_SUFFIX;
603 *len = strlen (*value);
608 /* Return the suffix for executable files. */
611 __gnat_get_executable_suffix_ptr (int *len, const char **value)
613 *value = HOST_EXECUTABLE_SUFFIX;
617 *len = strlen (*value);
622 /* Return the suffix for debuggable files. Usually this is the same as the
623 executable extension. */
626 __gnat_get_debuggable_suffix_ptr (int *len, const char **value)
629 *value = HOST_EXECUTABLE_SUFFIX;
631 /* On DOS, the extensionless COFF file is what gdb likes. */
638 *len = strlen (*value);
643 /* Returns the OS filename and corresponding encoding. */
646 __gnat_os_filename (char *filename, char *w_filename,
647 char *os_name, int *o_length,
648 char *encoding, int *e_length)
650 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE)
651 WS2SU (os_name, (TCHAR *)w_filename, o_length);
652 *o_length = strlen (os_name);
653 strcpy (encoding, "encoding=utf8");
654 *e_length = strlen (encoding);
656 strcpy (os_name, filename);
657 *o_length = strlen (filename);
663 __gnat_fopen (char *path, char *mode, int encoding)
665 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE)
666 TCHAR wpath[GNAT_MAX_PATH_LEN];
669 S2WS (wmode, mode, 10);
671 if (encoding == Encoding_UTF8)
672 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
674 S2WS (wpath, path, GNAT_MAX_PATH_LEN);
676 return _tfopen (wpath, wmode);
678 return decc$fopen (path, mode);
680 return fopen (path, mode);
685 __gnat_freopen (char *path, char *mode, FILE *stream, int encoding)
687 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE)
688 TCHAR wpath[GNAT_MAX_PATH_LEN];
691 S2WS (wmode, mode, 10);
693 if (encoding == Encoding_UTF8)
694 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
696 S2WS (wpath, path, GNAT_MAX_PATH_LEN);
698 return _tfreopen (wpath, wmode, stream);
700 return decc$freopen (path, mode, stream);
702 return freopen (path, mode, stream);
707 __gnat_open_read (char *path, int fmode)
710 int o_fmode = O_BINARY;
716 /* Optional arguments mbc,deq,fop increase read performance. */
717 fd = open (path, O_RDONLY | o_fmode, 0444,
718 "mbc=16", "deq=64", "fop=tef");
719 #elif defined (__vxworks)
720 fd = open (path, O_RDONLY | o_fmode, 0444);
721 #elif defined (__MINGW32__)
723 TCHAR wpath[GNAT_MAX_PATH_LEN];
725 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
726 fd = _topen (wpath, O_RDONLY | o_fmode, 0444);
729 fd = open (path, O_RDONLY | o_fmode);
732 return fd < 0 ? -1 : fd;
735 #if defined (__EMX__) || defined (__MINGW32__)
736 #define PERM (S_IREAD | S_IWRITE)
738 /* Excerpt from DECC C RTL Reference Manual:
739 To create files with OpenVMS RMS default protections using the UNIX
740 system-call functions umask, mkdir, creat, and open, call mkdir, creat,
741 and open with a file-protection mode argument of 0777 in a program
742 that never specifically calls umask. These default protections include
743 correctly establishing protections based on ACLs, previous versions of
747 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
751 __gnat_open_rw (char *path, int fmode)
754 int o_fmode = O_BINARY;
760 fd = open (path, O_RDWR | o_fmode, PERM,
761 "mbc=16", "deq=64", "fop=tef");
762 #elif defined (__MINGW32__)
764 TCHAR wpath[GNAT_MAX_PATH_LEN];
766 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
767 fd = _topen (wpath, O_RDWR | o_fmode, PERM);
770 fd = open (path, O_RDWR | o_fmode, PERM);
773 return fd < 0 ? -1 : fd;
777 __gnat_open_create (char *path, int fmode)
780 int o_fmode = O_BINARY;
786 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM,
787 "mbc=16", "deq=64", "fop=tef");
788 #elif defined (__MINGW32__)
790 TCHAR wpath[GNAT_MAX_PATH_LEN];
792 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
793 fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
796 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
799 return fd < 0 ? -1 : fd;
803 __gnat_create_output_file (char *path)
807 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM,
808 "rfm=stmlf", "ctx=rec", "rat=none", "rop=nlk",
809 "shr=del,get,put,upd");
810 #elif defined (__MINGW32__)
812 TCHAR wpath[GNAT_MAX_PATH_LEN];
814 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
815 fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
818 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
821 return fd < 0 ? -1 : fd;
825 __gnat_open_append (char *path, int fmode)
828 int o_fmode = O_BINARY;
834 fd = open (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM,
835 "mbc=16", "deq=64", "fop=tef");
836 #elif defined (__MINGW32__)
838 TCHAR wpath[GNAT_MAX_PATH_LEN];
840 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
841 fd = _topen (wpath, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
844 fd = open (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
847 return fd < 0 ? -1 : fd;
850 /* Open a new file. Return error (-1) if the file already exists. */
853 __gnat_open_new (char *path, int fmode)
856 int o_fmode = O_BINARY;
862 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM,
863 "mbc=16", "deq=64", "fop=tef");
864 #elif defined (__MINGW32__)
866 TCHAR wpath[GNAT_MAX_PATH_LEN];
868 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
869 fd = _topen (wpath, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
872 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
875 return fd < 0 ? -1 : fd;
878 /* Open a new temp file. Return error (-1) if the file already exists.
879 Special options for VMS allow the file to be shared between parent and child
880 processes, however they really slow down output. Used in gnatchop. */
883 __gnat_open_new_temp (char *path, int fmode)
886 int o_fmode = O_BINARY;
888 strcpy (path, "GNAT-XXXXXX");
890 #if (defined (__FreeBSD__) || defined (linux)) && !defined (__vxworks)
891 return mkstemp (path);
892 #elif defined (__Lynx__)
894 #elif defined (__nucleus__)
897 if (mktemp (path) == NULL)
905 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM,
906 "rfm=stmlf", "ctx=rec", "rat=none", "shr=del,get,put,upd",
907 "mbc=16", "deq=64", "fop=tef");
909 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
912 return fd < 0 ? -1 : fd;
915 /* Return the number of bytes in the specified file. */
918 __gnat_file_length (int fd)
923 ret = fstat (fd, &statbuf);
924 if (ret || !S_ISREG (statbuf.st_mode))
927 return (statbuf.st_size);
930 /* Return the number of bytes in the specified named file. */
933 __gnat_named_file_length (char *name)
938 ret = __gnat_stat (name, &statbuf);
939 if (ret || !S_ISREG (statbuf.st_mode))
942 return (statbuf.st_size);
945 /* Create a temporary filename and put it in string pointed to by
949 __gnat_tmp_name (char *tmp_filename)
955 /* tempnam tries to create a temporary file in directory pointed to by
956 TMP environment variable, in c:\temp if TMP is not set, and in
957 directory specified by P_tmpdir in stdio.h if c:\temp does not
958 exist. The filename will be created with the prefix "gnat-". */
960 pname = (char *) tempnam ("c:\\temp", "gnat-");
962 /* if pname is NULL, the file was not created properly, the disk is full
963 or there is no more free temporary files */
966 *tmp_filename = '\0';
968 /* If pname start with a back slash and not path information it means that
969 the filename is valid for the current working directory. */
971 else if (pname[0] == '\\')
973 strcpy (tmp_filename, ".\\");
974 strcat (tmp_filename, pname+1);
977 strcpy (tmp_filename, pname);
982 #elif defined (linux) || defined (__FreeBSD__)
983 #define MAX_SAFE_PATH 1000
984 char *tmpdir = getenv ("TMPDIR");
986 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
987 a buffer overflow. */
988 if (tmpdir == NULL || strlen (tmpdir) > MAX_SAFE_PATH)
989 strcpy (tmp_filename, "/tmp/gnat-XXXXXX");
991 sprintf (tmp_filename, "%s/gnat-XXXXXX", tmpdir);
993 close (mkstemp(tmp_filename));
995 tmpnam (tmp_filename);
999 /* Open directory and returns a DIR pointer. */
1001 DIR* __gnat_opendir (char *name)
1004 /* Not supported in RTX */
1008 #elif defined (__MINGW32__)
1009 TCHAR wname[GNAT_MAX_PATH_LEN];
1011 S2WSU (wname, name, GNAT_MAX_PATH_LEN);
1012 return (DIR*)_topendir (wname);
1015 return opendir (name);
1019 /* Read the next entry in a directory. The returned string points somewhere
1023 __gnat_readdir (DIR *dirp, char *buffer, int *len)
1026 /* Not supported in RTX */
1029 #elif defined (__MINGW32__)
1030 struct _tdirent *dirent = _treaddir ((_TDIR*)dirp);
1034 WS2SU (buffer, dirent->d_name, GNAT_MAX_PATH_LEN);
1035 *len = strlen (buffer);
1042 #elif defined (HAVE_READDIR_R)
1043 /* If possible, try to use the thread-safe version. */
1044 if (readdir_r (dirp, buffer) != NULL)
1046 *len = strlen (((struct dirent*) buffer)->d_name);
1047 return ((struct dirent*) buffer)->d_name;
1053 struct dirent *dirent = (struct dirent *) readdir (dirp);
1057 strcpy (buffer, dirent->d_name);
1058 *len = strlen (buffer);
1067 /* Close a directory entry. */
1069 int __gnat_closedir (DIR *dirp)
1072 /* Not supported in RTX */
1076 #elif defined (__MINGW32__)
1077 return _tclosedir ((_TDIR*)dirp);
1080 return closedir (dirp);
1084 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1087 __gnat_readdir_is_thread_safe (void)
1089 #ifdef HAVE_READDIR_R
1096 #if defined (_WIN32) && !defined (RTX)
1097 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1098 static const unsigned long long w32_epoch_offset = 11644473600ULL;
1100 /* Returns the file modification timestamp using Win32 routines which are
1101 immune against daylight saving time change. It is in fact not possible to
1102 use fstat for this purpose as the DST modify the st_mtime field of the
1106 win32_filetime (HANDLE h)
1111 unsigned long long ull_time;
1114 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1115 since <Jan 1st 1601>. This function must return the number of seconds
1116 since <Jan 1st 1970>. */
1118 if (GetFileTime (h, NULL, NULL, &t_write.ft_time))
1119 return (time_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
1124 /* Return a GNAT time stamp given a file name. */
1127 __gnat_file_time_name (char *name)
1130 #if defined (__EMX__) || defined (MSDOS)
1131 int fd = open (name, O_RDONLY | O_BINARY);
1132 time_t ret = __gnat_file_time_fd (fd);
1134 return (OS_Time)ret;
1136 #elif defined (_WIN32) && !defined (RTX)
1138 TCHAR wname[GNAT_MAX_PATH_LEN];
1140 S2WSU (wname, name, GNAT_MAX_PATH_LEN);
1142 HANDLE h = CreateFile
1143 (wname, GENERIC_READ, FILE_SHARE_READ, 0,
1144 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
1146 if (h != INVALID_HANDLE_VALUE)
1148 ret = win32_filetime (h);
1151 return (OS_Time) ret;
1153 struct stat statbuf;
1154 if (__gnat_stat (name, &statbuf) != 0) {
1158 /* VMS has file versioning. */
1159 return (OS_Time)statbuf.st_ctime;
1161 return (OS_Time)statbuf.st_mtime;
1167 /* Return a GNAT time stamp given a file descriptor. */
1170 __gnat_file_time_fd (int fd)
1172 /* The following workaround code is due to the fact that under EMX and
1173 DJGPP fstat attempts to convert time values to GMT rather than keep the
1174 actual OS timestamp of the file. By using the OS2/DOS functions directly
1175 the GNAT timestamp are independent of this behavior, which is desired to
1176 facilitate the distribution of GNAT compiled libraries. */
1178 #if defined (__EMX__) || defined (MSDOS)
1182 int ret = DosQueryFileInfo (fd, 1, (unsigned char *) &fs,
1183 sizeof (FILESTATUS));
1185 unsigned file_year = fs.fdateLastWrite.year;
1186 unsigned file_month = fs.fdateLastWrite.month;
1187 unsigned file_day = fs.fdateLastWrite.day;
1188 unsigned file_hour = fs.ftimeLastWrite.hours;
1189 unsigned file_min = fs.ftimeLastWrite.minutes;
1190 unsigned file_tsec = fs.ftimeLastWrite.twosecs;
1194 int ret = getftime (fd, &fs);
1196 unsigned file_year = fs.ft_year;
1197 unsigned file_month = fs.ft_month;
1198 unsigned file_day = fs.ft_day;
1199 unsigned file_hour = fs.ft_hour;
1200 unsigned file_min = fs.ft_min;
1201 unsigned file_tsec = fs.ft_tsec;
1204 /* Calculate the seconds since epoch from the time components. First count
1205 the whole days passed. The value for years returned by the DOS and OS2
1206 functions count years from 1980, so to compensate for the UNIX epoch which
1207 begins in 1970 start with 10 years worth of days and add days for each
1208 four year period since then. */
1211 int cum_days[12] = {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
1212 int days_passed = 3652 + (file_year / 4) * 1461;
1213 int years_since_leap = file_year % 4;
1215 if (years_since_leap == 1)
1217 else if (years_since_leap == 2)
1219 else if (years_since_leap == 3)
1220 days_passed += 1096;
1225 days_passed += cum_days[file_month - 1];
1226 if (years_since_leap == 0 && file_year != 20 && file_month > 2)
1229 days_passed += file_day - 1;
1231 /* OK - have whole days. Multiply -- then add in other parts. */
1233 tot_secs = days_passed * 86400;
1234 tot_secs += file_hour * 3600;
1235 tot_secs += file_min * 60;
1236 tot_secs += file_tsec * 2;
1237 return (OS_Time) tot_secs;
1239 #elif defined (_WIN32) && !defined (RTX)
1240 HANDLE h = (HANDLE) _get_osfhandle (fd);
1241 time_t ret = win32_filetime (h);
1242 return (OS_Time) ret;
1245 struct stat statbuf;
1247 if (fstat (fd, &statbuf) != 0) {
1248 return (OS_Time) -1;
1251 /* VMS has file versioning. */
1252 return (OS_Time) statbuf.st_ctime;
1254 return (OS_Time) statbuf.st_mtime;
1260 /* Set the file time stamp. */
1263 __gnat_set_file_time_name (char *name, time_t time_stamp)
1265 #if defined (__EMX__) || defined (MSDOS) || defined (__vxworks)
1267 /* Code to implement __gnat_set_file_time_name for these systems. */
1269 #elif defined (_WIN32) && !defined (RTX)
1273 unsigned long long ull_time;
1275 TCHAR wname[GNAT_MAX_PATH_LEN];
1277 S2WSU (wname, name, GNAT_MAX_PATH_LEN);
1279 HANDLE h = CreateFile
1280 (wname, GENERIC_WRITE, FILE_SHARE_WRITE, NULL,
1281 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS,
1283 if (h == INVALID_HANDLE_VALUE)
1285 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1286 t_write.ull_time = ((unsigned long long)time_stamp + w32_epoch_offset);
1287 /* Convert to 100 nanosecond units */
1288 t_write.ull_time *= 10000000ULL;
1290 SetFileTime(h, NULL, NULL, &t_write.ft_time);
1300 unsigned long long backup, create, expire, revise;
1304 unsigned short value;
1307 unsigned system : 4;
1313 } Fat = { 0, 0, 0, 0, 0, { 0 }};
1317 { ATR$S_CREDATE, ATR$C_CREDATE, &Fat.create },
1318 { ATR$S_REVDATE, ATR$C_REVDATE, &Fat.revise },
1319 { ATR$S_EXPDATE, ATR$C_EXPDATE, &Fat.expire },
1320 { ATR$S_BAKDATE, ATR$C_BAKDATE, &Fat.backup },
1321 { ATR$S_FPRO, ATR$C_FPRO, &Fat.prot },
1322 { ATR$S_UIC, ATR$C_UIC, &Fat.uic },
1327 struct dsc$descriptor_fib fibdsc = {sizeof (fib), (void *) &fib};
1331 unsigned long long newtime;
1332 unsigned long long revtime;
1336 struct vstring file;
1337 struct dsc$descriptor_s filedsc
1338 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) file.string};
1339 struct vstring device;
1340 struct dsc$descriptor_s devicedsc
1341 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) device.string};
1342 struct vstring timev;
1343 struct dsc$descriptor_s timedsc
1344 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) timev.string};
1345 struct vstring result;
1346 struct dsc$descriptor_s resultdsc
1347 = {NAM$C_MAXRSS, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, (void *) result.string};
1349 /* Convert parameter name (a file spec) to host file form. Note that this
1350 is needed on VMS to prepare for subsequent calls to VMS RMS library
1351 routines. Note that it would not work to call __gnat_to_host_dir_spec
1352 as was done in a previous version, since this fails silently unless
1353 the feature logical DECC$EFS_CHARSET is enabled, in which case a DNF
1354 (directory not found) condition is signalled. */
1355 tryfile = (char *) __gnat_to_host_file_spec (name);
1357 /* Allocate and initialize a FAB and NAM structures. */
1361 nam.nam$l_esa = file.string;
1362 nam.nam$b_ess = NAM$C_MAXRSS;
1363 nam.nam$l_rsa = result.string;
1364 nam.nam$b_rss = NAM$C_MAXRSS;
1365 fab.fab$l_fna = tryfile;
1366 fab.fab$b_fns = strlen (tryfile);
1367 fab.fab$l_nam = &nam;
1369 /* Validate filespec syntax and device existence. */
1370 status = SYS$PARSE (&fab, 0, 0);
1371 if ((status & 1) != 1)
1372 LIB$SIGNAL (status);
1374 file.string[nam.nam$b_esl] = 0;
1376 /* Find matching filespec. */
1377 status = SYS$SEARCH (&fab, 0, 0);
1378 if ((status & 1) != 1)
1379 LIB$SIGNAL (status);
1381 file.string[nam.nam$b_esl] = 0;
1382 result.string[result.length=nam.nam$b_rsl] = 0;
1384 /* Get the device name and assign an IO channel. */
1385 strncpy (device.string, nam.nam$l_dev, nam.nam$b_dev);
1386 devicedsc.dsc$w_length = nam.nam$b_dev;
1388 status = SYS$ASSIGN (&devicedsc, &chan, 0, 0, 0);
1389 if ((status & 1) != 1)
1390 LIB$SIGNAL (status);
1392 /* Initialize the FIB and fill in the directory id field. */
1393 memset (&fib, 0, sizeof (fib));
1394 fib.fib$w_did[0] = nam.nam$w_did[0];
1395 fib.fib$w_did[1] = nam.nam$w_did[1];
1396 fib.fib$w_did[2] = nam.nam$w_did[2];
1397 fib.fib$l_acctl = 0;
1399 strcpy (file.string, (strrchr (result.string, ']') + 1));
1400 filedsc.dsc$w_length = strlen (file.string);
1401 result.string[result.length = 0] = 0;
1403 /* Open and close the file to fill in the attributes. */
1405 = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
1406 &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
1407 if ((status & 1) != 1)
1408 LIB$SIGNAL (status);
1409 if ((iosb.status & 1) != 1)
1410 LIB$SIGNAL (iosb.status);
1412 result.string[result.length] = 0;
1413 status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0, &fibdsc, 0, 0, 0,
1415 if ((status & 1) != 1)
1416 LIB$SIGNAL (status);
1417 if ((iosb.status & 1) != 1)
1418 LIB$SIGNAL (iosb.status);
1423 /* Set creation time to requested time. */
1424 unix_time_to_vms (time_stamp, newtime);
1426 t = time ((time_t) 0);
1428 /* Set revision time to now in local time. */
1429 unix_time_to_vms (t, revtime);
1432 /* Reopen the file, modify the times and then close. */
1433 fib.fib$l_acctl = FIB$M_WRITE;
1435 = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
1436 &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
1437 if ((status & 1) != 1)
1438 LIB$SIGNAL (status);
1439 if ((iosb.status & 1) != 1)
1440 LIB$SIGNAL (iosb.status);
1442 Fat.create = newtime;
1443 Fat.revise = revtime;
1445 status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0,
1446 &fibdsc, 0, 0, 0, &atrlst, 0);
1447 if ((status & 1) != 1)
1448 LIB$SIGNAL (status);
1449 if ((iosb.status & 1) != 1)
1450 LIB$SIGNAL (iosb.status);
1452 /* Deassign the channel and exit. */
1453 status = SYS$DASSGN (chan);
1454 if ((status & 1) != 1)
1455 LIB$SIGNAL (status);
1457 struct utimbuf utimbuf;
1460 /* Set modification time to requested time. */
1461 utimbuf.modtime = time_stamp;
1463 /* Set access time to now in local time. */
1464 t = time ((time_t) 0);
1465 utimbuf.actime = mktime (localtime (&t));
1467 utime (name, &utimbuf);
1472 #include <windows.h>
1475 /* Get the list of installed standard libraries from the
1476 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1480 __gnat_get_libraries_from_registry (void)
1482 char *result = (char *) "";
1484 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE) && ! defined (RTX)
1487 DWORD name_size, value_size;
1494 /* First open the key. */
1495 res = RegOpenKeyExA (HKEY_LOCAL_MACHINE, "SOFTWARE", 0, KEY_READ, ®_key);
1497 if (res == ERROR_SUCCESS)
1498 res = RegOpenKeyExA (reg_key, "Ada Core Technologies", 0,
1499 KEY_READ, ®_key);
1501 if (res == ERROR_SUCCESS)
1502 res = RegOpenKeyExA (reg_key, "GNAT", 0, KEY_READ, ®_key);
1504 if (res == ERROR_SUCCESS)
1505 res = RegOpenKeyExA (reg_key, "Standard Libraries", 0, KEY_READ, ®_key);
1507 /* If the key exists, read out all the values in it and concatenate them
1509 for (index = 0; res == ERROR_SUCCESS; index++)
1511 value_size = name_size = 256;
1512 res = RegEnumValueA (reg_key, index, (TCHAR*)name, &name_size, 0,
1513 &type, (LPBYTE)value, &value_size);
1515 if (res == ERROR_SUCCESS && type == REG_SZ)
1517 char *old_result = result;
1519 result = (char *) xmalloc (strlen (old_result) + value_size + 2);
1520 strcpy (result, old_result);
1521 strcat (result, value);
1522 strcat (result, ";");
1526 /* Remove the trailing ";". */
1528 result[strlen (result) - 1] = 0;
1535 __gnat_stat (char *name, struct stat *statbuf)
1538 /* Under Windows the directory name for the stat function must not be
1539 terminated by a directory separator except if just after a drive name. */
1540 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
1544 S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
1545 name_len = _tcslen (wname);
1547 if (name_len > GNAT_MAX_PATH_LEN)
1550 last_char = wname[name_len - 1];
1552 while (name_len > 1 && (last_char == _T('\\') || last_char == _T('/')))
1554 wname[name_len - 1] = _T('\0');
1556 last_char = wname[name_len - 1];
1559 /* Only a drive letter followed by ':', we must add a directory separator
1560 for the stat routine to work properly. */
1561 if (name_len == 2 && wname[1] == _T(':'))
1562 _tcscat (wname, _T("\\"));
1564 return _tstat (wname, statbuf);
1567 return stat (name, statbuf);
1572 __gnat_file_exists (char *name)
1574 #if defined (__MINGW32__) && !defined (RTX)
1575 /* On Windows do not use __gnat_stat() because a bug in Microsoft
1576 _stat() routine. When the system time-zone is set with a negative
1577 offset the _stat() routine fails on specific files like CON: */
1578 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
1580 S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
1581 return GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
1583 struct stat statbuf;
1585 return !__gnat_stat (name, &statbuf);
1590 __gnat_is_absolute_path (char *name, int length)
1593 /* On VxWorks systems, an absolute path can be represented (depending on
1594 the host platform) as either /dir/file, or device:/dir/file, or
1595 device:drive_letter:/dir/file. */
1602 for (index = 0; index < length; index++)
1604 if (name[index] == ':' &&
1605 ((name[index + 1] == '/') ||
1606 (isalpha (name[index + 1]) && index + 2 <= length &&
1607 name[index + 2] == '/')))
1610 else if (name[index] == '/')
1615 return (length != 0) &&
1616 (*name == '/' || *name == DIR_SEPARATOR
1617 #if defined (__EMX__) || defined (MSDOS) || defined (WINNT)
1618 || (length > 1 && isalpha (name[0]) && name[1] == ':')
1625 __gnat_is_regular_file (char *name)
1628 struct stat statbuf;
1630 ret = __gnat_stat (name, &statbuf);
1631 return (!ret && S_ISREG (statbuf.st_mode));
1635 __gnat_is_directory (char *name)
1638 struct stat statbuf;
1640 ret = __gnat_stat (name, &statbuf);
1641 return (!ret && S_ISDIR (statbuf.st_mode));
1645 __gnat_is_readable_file (char *name)
1649 struct stat statbuf;
1651 ret = __gnat_stat (name, &statbuf);
1652 mode = statbuf.st_mode & S_IRUSR;
1653 return (!ret && mode);
1657 __gnat_is_writable_file (char *name)
1661 struct stat statbuf;
1663 ret = __gnat_stat (name, &statbuf);
1664 mode = statbuf.st_mode & S_IWUSR;
1665 return (!ret && mode);
1669 __gnat_set_writable (char *name)
1671 #if ! defined (__vxworks) && ! defined(__nucleus__)
1672 struct stat statbuf;
1674 if (stat (name, &statbuf) == 0)
1676 statbuf.st_mode = statbuf.st_mode | S_IWUSR;
1677 chmod (name, statbuf.st_mode);
1683 __gnat_set_executable (char *name)
1685 #if ! defined (__vxworks) && ! defined(__nucleus__)
1686 struct stat statbuf;
1688 if (stat (name, &statbuf) == 0)
1690 statbuf.st_mode = statbuf.st_mode | S_IXUSR;
1691 chmod (name, statbuf.st_mode);
1697 __gnat_set_readonly (char *name)
1699 #if ! defined (__vxworks) && ! defined(__nucleus__)
1700 struct stat statbuf;
1702 if (stat (name, &statbuf) == 0)
1704 statbuf.st_mode = statbuf.st_mode & 07577;
1705 chmod (name, statbuf.st_mode);
1711 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
1713 #if defined (__vxworks) || defined (__nucleus__)
1716 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
1718 struct stat statbuf;
1720 ret = lstat (name, &statbuf);
1721 return (!ret && S_ISLNK (statbuf.st_mode));
1728 #if defined (sun) && defined (__SVR4)
1729 /* Using fork on Solaris will duplicate all the threads. fork1, which
1730 duplicates only the active thread, must be used instead, or spawning
1731 subprocess from a program with tasking will lead into numerous problems. */
1736 __gnat_portable_spawn (char *args[])
1739 int finished ATTRIBUTE_UNUSED;
1740 int pid ATTRIBUTE_UNUSED;
1742 #if defined (__vxworks) || defined(__nucleus__) || defined(RTX)
1745 #elif defined (MSDOS) || defined (_WIN32)
1746 /* args[0] must be quotes as it could contain a full pathname with spaces */
1747 char *args_0 = args[0];
1748 args[0] = (char *)xmalloc (strlen (args_0) + 3);
1749 strcpy (args[0], "\"");
1750 strcat (args[0], args_0);
1751 strcat (args[0], "\"");
1753 status = spawnvp (P_WAIT, args_0, (const char* const*)args);
1755 /* restore previous value */
1757 args[0] = (char *)args_0;
1767 pid = spawnvp (P_NOWAIT, args[0], args);
1779 if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
1781 return -1; /* execv is in parent context on VMS. */
1789 finished = waitpid (pid, &status, 0);
1791 if (finished != pid || WIFEXITED (status) == 0)
1794 return WEXITSTATUS (status);
1800 /* Create a copy of the given file descriptor.
1801 Return -1 if an error occurred. */
1804 __gnat_dup (int oldfd)
1806 #if defined (__vxworks) && !defined (__RTP__)
1807 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
1815 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
1816 Return -1 if an error occurred. */
1819 __gnat_dup2 (int oldfd, int newfd)
1821 #if defined (__vxworks) && !defined (__RTP__)
1822 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
1826 return dup2 (oldfd, newfd);
1830 /* WIN32 code to implement a wait call that wait for any child process. */
1832 #if defined (_WIN32) && !defined (RTX)
1834 /* Synchronization code, to be thread safe. */
1836 static CRITICAL_SECTION plist_cs;
1839 __gnat_plist_init (void)
1841 InitializeCriticalSection (&plist_cs);
1847 EnterCriticalSection (&plist_cs);
1853 LeaveCriticalSection (&plist_cs);
1856 typedef struct _process_list
1859 struct _process_list *next;
1862 static Process_List *PLIST = NULL;
1864 static int plist_length = 0;
1867 add_handle (HANDLE h)
1871 pl = (Process_List *) xmalloc (sizeof (Process_List));
1875 /* -------------------- critical section -------------------- */
1880 /* -------------------- critical section -------------------- */
1886 remove_handle (HANDLE h)
1889 Process_List *prev = NULL;
1893 /* -------------------- critical section -------------------- */
1902 prev->next = pl->next;
1914 /* -------------------- critical section -------------------- */
1920 win32_no_block_spawn (char *command, char *args[])
1924 PROCESS_INFORMATION PI;
1925 SECURITY_ATTRIBUTES SA;
1930 /* compute the total command line length */
1934 csize += strlen (args[k]) + 1;
1938 full_command = (char *) xmalloc (csize);
1941 SI.cb = sizeof (STARTUPINFO);
1942 SI.lpReserved = NULL;
1943 SI.lpReserved2 = NULL;
1944 SI.lpDesktop = NULL;
1948 SI.wShowWindow = SW_HIDE;
1950 /* Security attributes. */
1951 SA.nLength = sizeof (SECURITY_ATTRIBUTES);
1952 SA.bInheritHandle = TRUE;
1953 SA.lpSecurityDescriptor = NULL;
1955 /* Prepare the command string. */
1956 strcpy (full_command, command);
1957 strcat (full_command, " ");
1962 strcat (full_command, args[k]);
1963 strcat (full_command, " ");
1968 int wsize = csize * 2;
1969 TCHAR *wcommand = (TCHAR *) xmalloc (wsize);
1971 S2WSU (wcommand, full_command, wsize);
1973 free (full_command);
1975 result = CreateProcess
1976 (NULL, wcommand, &SA, NULL, TRUE,
1977 GetPriorityClass (GetCurrentProcess()), NULL, NULL, &SI, &PI);
1984 add_handle (PI.hProcess);
1985 CloseHandle (PI.hThread);
1986 return (int) PI.hProcess;
1993 win32_wait (int *status)
2002 if (plist_length == 0)
2008 hl = (HANDLE *) xmalloc (sizeof (HANDLE) * plist_length);
2013 /* -------------------- critical section -------------------- */
2020 /* -------------------- critical section -------------------- */
2024 res = WaitForMultipleObjects (plist_length, hl, FALSE, INFINITE);
2025 h = hl[res - WAIT_OBJECT_0];
2030 GetExitCodeProcess (h, &exitcode);
2033 *status = (int) exitcode;
2040 __gnat_portable_no_block_spawn (char *args[])
2044 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX)
2047 #elif defined (__EMX__) || defined (MSDOS)
2049 /* ??? For PC machines I (Franco) don't know the system calls to implement
2050 this routine. So I'll fake it as follows. This routine will behave
2051 exactly like the blocking portable_spawn and will systematically return
2052 a pid of 0 unless the spawned task did not complete successfully, in
2053 which case we return a pid of -1. To synchronize with this the
2054 portable_wait below systematically returns a pid of 0 and reports that
2055 the subprocess terminated successfully. */
2057 if (spawnvp (P_WAIT, args[0], args) != 0)
2060 #elif defined (_WIN32)
2062 pid = win32_no_block_spawn (args[0], args);
2071 if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
2073 return -1; /* execv is in parent context on VMS. */
2085 __gnat_portable_wait (int *process_status)
2090 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX)
2091 /* Not sure what to do here, so do same as __EMX__ case, i.e., nothing but
2094 #elif defined (_WIN32)
2096 pid = win32_wait (&status);
2098 #elif defined (__EMX__) || defined (MSDOS)
2099 /* ??? See corresponding comment in portable_no_block_spawn. */
2103 pid = waitpid (-1, &status, 0);
2104 status = status & 0xffff;
2107 *process_status = status;
2112 __gnat_os_exit (int status)
2117 /* Locate a regular file, give a Path value. */
2120 __gnat_locate_regular_file (char *file_name, char *path_val)
2123 char *file_path = alloca (strlen (file_name) + 1);
2126 /* Return immediately if file_name is empty */
2128 if (*file_name == '\0')
2131 /* Remove quotes around file_name if present */
2137 strcpy (file_path, ptr);
2139 ptr = file_path + strlen (file_path) - 1;
2144 /* Handle absolute pathnames. */
2146 absolute = __gnat_is_absolute_path (file_path, strlen (file_name));
2150 if (__gnat_is_regular_file (file_path))
2151 return xstrdup (file_path);
2156 /* If file_name include directory separator(s), try it first as
2157 a path name relative to the current directory */
2158 for (ptr = file_name; *ptr && *ptr != '/' && *ptr != DIR_SEPARATOR; ptr++)
2163 if (__gnat_is_regular_file (file_name))
2164 return xstrdup (file_name);
2171 /* The result has to be smaller than path_val + file_name. */
2172 char *file_path = alloca (strlen (path_val) + strlen (file_name) + 2);
2176 for (; *path_val == PATH_SEPARATOR; path_val++)
2182 /* Skip the starting quote */
2184 if (*path_val == '"')
2187 for (ptr = file_path; *path_val && *path_val != PATH_SEPARATOR; )
2188 *ptr++ = *path_val++;
2192 /* Skip the ending quote */
2197 if (*ptr != '/' && *ptr != DIR_SEPARATOR)
2198 *++ptr = DIR_SEPARATOR;
2200 strcpy (++ptr, file_name);
2202 if (__gnat_is_regular_file (file_path))
2203 return xstrdup (file_path);
2210 /* Locate an executable given a Path argument. This routine is only used by
2211 gnatbl and should not be used otherwise. Use locate_exec_on_path
2215 __gnat_locate_exec (char *exec_name, char *path_val)
2218 if (!strstr (exec_name, HOST_EXECUTABLE_SUFFIX))
2220 char *full_exec_name
2221 = alloca (strlen (exec_name) + strlen (HOST_EXECUTABLE_SUFFIX) + 1);
2223 strcpy (full_exec_name, exec_name);
2224 strcat (full_exec_name, HOST_EXECUTABLE_SUFFIX);
2225 ptr = __gnat_locate_regular_file (full_exec_name, path_val);
2228 return __gnat_locate_regular_file (exec_name, path_val);
2232 return __gnat_locate_regular_file (exec_name, path_val);
2235 /* Locate an executable using the Systems default PATH. */
2238 __gnat_locate_exec_on_path (char *exec_name)
2242 #if defined (_WIN32) && !defined (RTX)
2243 TCHAR *wpath_val = _tgetenv (_T("PATH"));
2245 /* In Win32 systems we expand the PATH as for XP environment
2246 variables are not automatically expanded. We also prepend the
2247 ".;" to the path to match normal NT path search semantics */
2249 #define EXPAND_BUFFER_SIZE 32767
2251 wapath_val = alloca (EXPAND_BUFFER_SIZE);
2253 wapath_val [0] = '.';
2254 wapath_val [1] = ';';
2256 DWORD res = ExpandEnvironmentStrings
2257 (wpath_val, &wapath_val[2], EXPAND_BUFFER_SIZE - 2);
2259 if (!res) wapath_val [0] = _T('\0');
2261 apath_val = alloca (EXPAND_BUFFER_SIZE);
2263 WS2SU (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
2264 return __gnat_locate_exec (exec_name, apath_val);
2269 char *path_val = "/VAXC$PATH";
2271 char *path_val = getenv ("PATH");
2273 if (path_val == NULL) return NULL;
2274 apath_val = alloca (strlen (path_val) + 1);
2275 strcpy (apath_val, path_val);
2276 return __gnat_locate_exec (exec_name, apath_val);
2282 /* These functions are used to translate to and from VMS and Unix syntax
2283 file, directory and path specifications. */
2286 #define MAXNAMES 256
2287 #define NEW_CANONICAL_FILELIST_INCREMENT 64
2289 static char new_canonical_dirspec [MAXPATH];
2290 static char new_canonical_filespec [MAXPATH];
2291 static char new_canonical_pathspec [MAXNAMES*MAXPATH];
2292 static unsigned new_canonical_filelist_index;
2293 static unsigned new_canonical_filelist_in_use;
2294 static unsigned new_canonical_filelist_allocated;
2295 static char **new_canonical_filelist;
2296 static char new_host_pathspec [MAXNAMES*MAXPATH];
2297 static char new_host_dirspec [MAXPATH];
2298 static char new_host_filespec [MAXPATH];
2300 /* Routine is called repeatedly by decc$from_vms via
2301 __gnat_to_canonical_file_list_init until it returns 0 or the expansion
2305 wildcard_translate_unix (char *name)
2308 char buff [MAXPATH];
2310 strncpy (buff, name, MAXPATH);
2311 buff [MAXPATH - 1] = (char) 0;
2312 ver = strrchr (buff, '.');
2314 /* Chop off the version. */
2318 /* Dynamically extend the allocation by the increment. */
2319 if (new_canonical_filelist_in_use == new_canonical_filelist_allocated)
2321 new_canonical_filelist_allocated += NEW_CANONICAL_FILELIST_INCREMENT;
2322 new_canonical_filelist = (char **) xrealloc
2323 (new_canonical_filelist,
2324 new_canonical_filelist_allocated * sizeof (char *));
2327 new_canonical_filelist[new_canonical_filelist_in_use++] = xstrdup (buff);
2332 /* Translate a wildcard VMS file spec into a list of Unix file specs. First do
2333 full translation and copy the results into a list (_init), then return them
2334 one at a time (_next). If onlydirs set, only expand directory files. */
2337 __gnat_to_canonical_file_list_init (char *filespec, int onlydirs)
2340 char buff [MAXPATH];
2342 len = strlen (filespec);
2343 strncpy (buff, filespec, MAXPATH);
2345 /* Only look for directories */
2346 if (onlydirs && !strstr (&buff [len-5], "*.dir"))
2347 strncat (buff, "*.dir", MAXPATH);
2349 buff [MAXPATH - 1] = (char) 0;
2351 decc$from_vms (buff, wildcard_translate_unix, 1);
2353 /* Remove the .dir extension. */
2359 for (i = 0; i < new_canonical_filelist_in_use; i++)
2361 ext = strstr (new_canonical_filelist[i], ".dir");
2367 return new_canonical_filelist_in_use;
2370 /* Return the next filespec in the list. */
2373 __gnat_to_canonical_file_list_next ()
2375 return new_canonical_filelist[new_canonical_filelist_index++];
2378 /* Free storage used in the wildcard expansion. */
2381 __gnat_to_canonical_file_list_free ()
2385 for (i = 0; i < new_canonical_filelist_in_use; i++)
2386 free (new_canonical_filelist[i]);
2388 free (new_canonical_filelist);
2390 new_canonical_filelist_in_use = 0;
2391 new_canonical_filelist_allocated = 0;
2392 new_canonical_filelist_index = 0;
2393 new_canonical_filelist = 0;
2396 /* The functional equivalent of decc$translate_vms routine.
2397 Designed to produce the same output, but is protected against
2398 malformed paths (original version ACCVIOs in this case) and
2399 does not require VMS-specific DECC RTL */
2401 #define NAM$C_MAXRSS 1024
2404 __gnat_translate_vms (char *src)
2406 static char retbuf [NAM$C_MAXRSS+1];
2407 char *srcendpos, *pos1, *pos2, *retpos;
2408 int disp, path_present = 0;
2410 if (!src) return NULL;
2412 srcendpos = strchr (src, '\0');
2415 /* Look for the node and/or device in front of the path */
2417 pos2 = strchr (pos1, ':');
2419 if (pos2 && (pos2 < srcendpos) && (*(pos2 + 1) == ':')) {
2420 /* There is a node name. "node_name::" becomes "node_name!" */
2422 strncpy (retbuf, pos1, disp);
2423 retpos [disp] = '!';
2424 retpos = retpos + disp + 1;
2426 pos2 = strchr (pos1, ':');
2430 /* There is a device name. "dev_name:" becomes "/dev_name/" */
2433 strncpy (retpos, pos1, disp);
2434 retpos = retpos + disp;
2439 /* No explicit device; we must look ahead and prepend /sys$disk/ if
2440 the path is absolute */
2441 if ((*pos1 == '[' || *pos1 == '<') && (pos1 < srcendpos)
2442 && !strchr (".-]>", *(pos1 + 1))) {
2443 strncpy (retpos, "/sys$disk/", 10);
2447 /* Process the path part */
2448 while (*pos1 == '[' || *pos1 == '<') {
2451 if (*pos1 == ']' || *pos1 == '>') {
2452 /* Special case, [] translates to '.' */
2457 /* '[000000' means root dir. It can be present in the middle of
2458 the path due to expansion of logical devices, in which case
2460 if (!strncmp (pos1, "000000", 6) && path_present > 1 &&
2461 (*(pos1 + 6) == ']' || *(pos1 + 6) == '>' || *(pos1 + 6) == '.')) {
2463 if (*pos1 == '.') pos1++;
2465 else if (*pos1 == '.') {
2470 /* There is a qualified path */
2471 while (*pos1 && *pos1 != ']' && *pos1 != '>') {
2474 /* '.' is used to separate directories. Replace it with '/' but
2475 only if there isn't already '/' just before */
2476 if (*(retpos - 1) != '/') *(retpos++) = '/';
2478 if (pos1 + 1 < srcendpos && *pos1 == '.' && *(pos1 + 1) == '.') {
2479 /* ellipsis refers to entire subtree; replace with '**' */
2480 *(retpos++) = '*'; *(retpos++) = '*'; *(retpos++) = '/';
2485 /* When after '.' '[' '<' is equivalent to Unix ".." but there
2486 may be several in a row */
2487 if (*(pos1 - 1) == '.' || *(pos1 - 1) == '[' ||
2488 *(pos1 - 1) == '<') {
2489 while (*pos1 == '-') {
2491 *(retpos++) = '.'; *(retpos++) = '.'; *(retpos++) = '/';
2496 /* otherwise fall through to default */
2498 *(retpos++) = *(pos1++);
2505 if (pos1 < srcendpos) {
2506 /* Now add the actual file name, until the version suffix if any */
2507 if (path_present) *(retpos++) = '/';
2508 pos2 = strchr (pos1, ';');
2509 disp = pos2? (pos2 - pos1) : (srcendpos - pos1);
2510 strncpy (retpos, pos1, disp);
2512 if (pos2 && pos2 < srcendpos) {
2513 /* There is a non-empty version suffix. ";<ver>" becomes ".<ver>" */
2515 disp = srcendpos - pos2 - 1;
2516 strncpy (retpos, pos2 + 1, disp);
2527 /* Translate a VMS syntax directory specification in to Unix syntax. If
2528 PREFIXFLAG is set, append an underscore "/". If no indicators of VMS syntax
2529 found, return input string. Also translate a dirname that contains no
2530 slashes, in case it's a logical name. */
2533 __gnat_to_canonical_dir_spec (char *dirspec, int prefixflag)
2537 strcpy (new_canonical_dirspec, "");
2538 if (strlen (dirspec))
2542 if (strchr (dirspec, ']') || strchr (dirspec, ':'))
2544 strncpy (new_canonical_dirspec,
2545 __gnat_translate_vms (dirspec),
2548 else if (!strchr (dirspec, '/') && (dirspec1 = getenv (dirspec)) != 0)
2550 strncpy (new_canonical_dirspec,
2551 __gnat_translate_vms (dirspec1),
2556 strncpy (new_canonical_dirspec, dirspec, MAXPATH);
2560 len = strlen (new_canonical_dirspec);
2561 if (prefixflag && new_canonical_dirspec [len-1] != '/')
2562 strncat (new_canonical_dirspec, "/", MAXPATH);
2564 new_canonical_dirspec [MAXPATH - 1] = (char) 0;
2566 return new_canonical_dirspec;
2570 /* Translate a VMS syntax file specification into Unix syntax.
2571 If no indicators of VMS syntax found, check if it's an uppercase
2572 alphanumeric_ name and if so try it out as an environment
2573 variable (logical name). If all else fails return the
2577 __gnat_to_canonical_file_spec (char *filespec)
2581 strncpy (new_canonical_filespec, "", MAXPATH);
2583 if (strchr (filespec, ']') || strchr (filespec, ':'))
2585 char *tspec = (char *) __gnat_translate_vms (filespec);
2587 if (tspec != (char *) -1)
2588 strncpy (new_canonical_filespec, tspec, MAXPATH);
2590 else if ((strlen (filespec) == strspn (filespec,
2591 "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"))
2592 && (filespec1 = getenv (filespec)))
2594 char *tspec = (char *) __gnat_translate_vms (filespec1);
2596 if (tspec != (char *) -1)
2597 strncpy (new_canonical_filespec, tspec, MAXPATH);
2601 strncpy (new_canonical_filespec, filespec, MAXPATH);
2604 new_canonical_filespec [MAXPATH - 1] = (char) 0;
2606 return new_canonical_filespec;
2609 /* Translate a VMS syntax path specification into Unix syntax.
2610 If no indicators of VMS syntax found, return input string. */
2613 __gnat_to_canonical_path_spec (char *pathspec)
2615 char *curr, *next, buff [MAXPATH];
2620 /* If there are /'s, assume it's a Unix path spec and return. */
2621 if (strchr (pathspec, '/'))
2624 new_canonical_pathspec[0] = 0;
2629 next = strchr (curr, ',');
2631 next = strchr (curr, 0);
2633 strncpy (buff, curr, next - curr);
2634 buff[next - curr] = 0;
2636 /* Check for wildcards and expand if present. */
2637 if (strchr (buff, '*') || strchr (buff, '%') || strstr (buff, "..."))
2641 dirs = __gnat_to_canonical_file_list_init (buff, 1);
2642 for (i = 0; i < dirs; i++)
2646 next_dir = __gnat_to_canonical_file_list_next ();
2647 strncat (new_canonical_pathspec, next_dir, MAXPATH);
2649 /* Don't append the separator after the last expansion. */
2651 strncat (new_canonical_pathspec, ":", MAXPATH);
2654 __gnat_to_canonical_file_list_free ();
2657 strncat (new_canonical_pathspec,
2658 __gnat_to_canonical_dir_spec (buff, 0), MAXPATH);
2663 strncat (new_canonical_pathspec, ":", MAXPATH);
2667 new_canonical_pathspec [MAXPATH - 1] = (char) 0;
2669 return new_canonical_pathspec;
2672 static char filename_buff [MAXPATH];
2675 translate_unix (char *name, int type)
2677 strncpy (filename_buff, name, MAXPATH);
2678 filename_buff [MAXPATH - 1] = (char) 0;
2682 /* Translate a Unix syntax path spec into a VMS style (comma separated list of
2686 to_host_path_spec (char *pathspec)
2688 char *curr, *next, buff [MAXPATH];
2693 /* Can't very well test for colons, since that's the Unix separator! */
2694 if (strchr (pathspec, ']') || strchr (pathspec, ','))
2697 new_host_pathspec[0] = 0;
2702 next = strchr (curr, ':');
2704 next = strchr (curr, 0);
2706 strncpy (buff, curr, next - curr);
2707 buff[next - curr] = 0;
2709 strncat (new_host_pathspec, __gnat_to_host_dir_spec (buff, 0), MAXPATH);
2712 strncat (new_host_pathspec, ",", MAXPATH);
2716 new_host_pathspec [MAXPATH - 1] = (char) 0;
2718 return new_host_pathspec;
2721 /* Translate a Unix syntax directory specification into VMS syntax. The
2722 PREFIXFLAG has no effect, but is kept for symmetry with
2723 to_canonical_dir_spec. If indicators of VMS syntax found, return input
2727 __gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
2729 int len = strlen (dirspec);
2731 strncpy (new_host_dirspec, dirspec, MAXPATH);
2732 new_host_dirspec [MAXPATH - 1] = (char) 0;
2734 if (strchr (new_host_dirspec, ']') || strchr (new_host_dirspec, ':'))
2735 return new_host_dirspec;
2737 while (len > 1 && new_host_dirspec[len - 1] == '/')
2739 new_host_dirspec[len - 1] = 0;
2743 decc$to_vms (new_host_dirspec, translate_unix, 1, 2);
2744 strncpy (new_host_dirspec, filename_buff, MAXPATH);
2745 new_host_dirspec [MAXPATH - 1] = (char) 0;
2747 return new_host_dirspec;
2750 /* Translate a Unix syntax file specification into VMS syntax.
2751 If indicators of VMS syntax found, return input string. */
2754 __gnat_to_host_file_spec (char *filespec)
2756 strncpy (new_host_filespec, "", MAXPATH);
2757 if (strchr (filespec, ']') || strchr (filespec, ':'))
2759 strncpy (new_host_filespec, filespec, MAXPATH);
2763 decc$to_vms (filespec, translate_unix, 1, 1);
2764 strncpy (new_host_filespec, filename_buff, MAXPATH);
2767 new_host_filespec [MAXPATH - 1] = (char) 0;
2769 return new_host_filespec;
2773 __gnat_adjust_os_resource_limits ()
2775 SYS$ADJWSL (131072, 0);
2780 /* Dummy functions for Osint import for non-VMS systems. */
2783 __gnat_to_canonical_file_list_init
2784 (char *dirspec ATTRIBUTE_UNUSED, int onlydirs ATTRIBUTE_UNUSED)
2790 __gnat_to_canonical_file_list_next (void)
2796 __gnat_to_canonical_file_list_free (void)
2801 __gnat_to_canonical_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
2807 __gnat_to_canonical_file_spec (char *filespec)
2813 __gnat_to_canonical_path_spec (char *pathspec)
2819 __gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
2825 __gnat_to_host_file_spec (char *filespec)
2831 __gnat_adjust_os_resource_limits (void)
2837 /* For EMX, we cannot include dummy in libgcc, since it is too difficult
2838 to coordinate this with the EMX distribution. Consequently, we put the
2839 definition of dummy which is used for exception handling, here. */
2841 #if defined (__EMX__)
2845 #if defined (__mips_vxworks)
2849 CACHE_USER_FLUSH (0, ENTIRE_CACHE);
2853 #if defined (CROSS_DIRECTORY_STRUCTURE) \
2854 || (! ((defined (sparc) || defined (i386)) && defined (sun) \
2855 && defined (__SVR4)) \
2856 && ! (defined (linux) && (defined (i386) || defined (__x86_64__))) \
2857 && ! (defined (linux) && defined (__ia64__)) \
2858 && ! defined (__FreeBSD__) \
2859 && ! defined (__hpux__) \
2860 && ! defined (__APPLE__) \
2861 && ! defined (_AIX) \
2862 && ! (defined (__alpha__) && defined (__osf__)) \
2863 && ! defined (VMS) \
2864 && ! defined (__MINGW32__) \
2865 && ! (defined (__mips) && defined (__sgi)))
2867 /* Dummy function to satisfy g-trasym.o. See the preprocessor conditional
2868 just above for a list of native platforms that provide a non-dummy
2869 version of this procedure in libaddr2line.a. */
2872 convert_addresses (const char *file_name ATTRIBUTE_UNUSED,
2873 void *addrs ATTRIBUTE_UNUSED,
2874 int n_addr ATTRIBUTE_UNUSED,
2875 void *buf ATTRIBUTE_UNUSED,
2876 int *len ATTRIBUTE_UNUSED)
2882 #if defined (_WIN32)
2883 int __gnat_argument_needs_quote = 1;
2885 int __gnat_argument_needs_quote = 0;
2888 /* This option is used to enable/disable object files handling from the
2889 binder file by the GNAT Project module. For example, this is disabled on
2890 Windows (prior to GCC 3.4) as it is already done by the mdll module.
2891 Stating with GCC 3.4 the shared libraries are not based on mdll
2892 anymore as it uses the GCC's -shared option */
2893 #if defined (_WIN32) \
2894 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
2895 int __gnat_prj_add_obj_files = 0;
2897 int __gnat_prj_add_obj_files = 1;
2900 /* char used as prefix/suffix for environment variables */
2901 #if defined (_WIN32)
2902 char __gnat_environment_char = '%';
2904 char __gnat_environment_char = '$';
2907 /* This functions copy the file attributes from a source file to a
2910 mode = 0 : In this mode copy only the file time stamps (last access and
2911 last modification time stamps).
2913 mode = 1 : In this mode, time stamps and read/write/execute attributes are
2916 Returns 0 if operation was successful and -1 in case of error. */
2919 __gnat_copy_attribs (char *from, char *to, int mode)
2921 #if defined (VMS) || defined (__vxworks) || defined (__nucleus__)
2925 struct utimbuf tbuf;
2927 if (stat (from, &fbuf) == -1)
2932 tbuf.actime = fbuf.st_atime;
2933 tbuf.modtime = fbuf.st_mtime;
2935 if (utime (to, &tbuf) == -1)
2942 if (chmod (to, fbuf.st_mode) == -1)
2953 __gnat_lseek (int fd, long offset, int whence)
2955 return (int) lseek (fd, offset, whence);
2958 /* This function returns the major version number of GCC being used. */
2960 get_gcc_version (void)
2965 return (int) (version_string[0] - '0');
2970 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED,
2971 int close_on_exec_p ATTRIBUTE_UNUSED)
2973 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
2974 int flags = fcntl (fd, F_GETFD, 0);
2977 if (close_on_exec_p)
2978 flags |= FD_CLOEXEC;
2980 flags &= ~FD_CLOEXEC;
2981 return fcntl (fd, F_SETFD, flags | FD_CLOEXEC);
2984 /* For the Windows case, we should use SetHandleInformation to remove
2985 the HANDLE_INHERIT property from fd. This is not implemented yet,
2986 but for our purposes (support of GNAT.Expect) this does not matter,
2987 as by default handles are *not* inherited. */
2991 /* Indicates if platforms supports automatic initialization through the
2992 constructor mechanism */
2994 __gnat_binder_supports_auto_init ()
3003 /* Indicates that Stand-Alone Libraries are automatically initialized through
3004 the constructor mechanism */
3006 __gnat_sals_init_using_constructors ()
3008 #if defined (__vxworks) || defined (__Lynx__) || defined (VMS)
3015 /* In RTX mode, the procedure to get the time (as file time) is different
3016 in RTSS mode and Win32 mode. In order to avoid duplicating an Ada file,
3017 we introduce an intermediate procedure to link against the corresponding
3018 one in each situation. */
3021 void GetTimeAsFileTime(LPFILETIME pTime)
3024 RtGetRtssTimeAsFileTime (pTime); /* RTSS interface */
3026 GetSystemTimeAsFileTime (pTime); /* w32 interface */
3032 /* pthread affinity support */
3035 #include <pthread.h>
3037 __gnat_pthread_setaffinity_np (pthread_t th,
3039 const cpu_set_t *cpuset)
3041 return pthread_setaffinity_np (th, cpusetsize, cpuset);
3045 __gnat_pthread_setaffinity_np (pthread_t th,