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 (__NetBSD__) || defined (linux)) && \
892 return mkstemp (path);
893 #elif defined (__Lynx__)
895 #elif defined (__nucleus__)
898 if (mktemp (path) == NULL)
906 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM,
907 "rfm=stmlf", "ctx=rec", "rat=none", "shr=del,get,put,upd",
908 "mbc=16", "deq=64", "fop=tef");
910 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
913 return fd < 0 ? -1 : fd;
916 /* Return the number of bytes in the specified file. */
919 __gnat_file_length (int fd)
924 ret = fstat (fd, &statbuf);
925 if (ret || !S_ISREG (statbuf.st_mode))
928 return (statbuf.st_size);
931 /* Return the number of bytes in the specified named file. */
934 __gnat_named_file_length (char *name)
939 ret = __gnat_stat (name, &statbuf);
940 if (ret || !S_ISREG (statbuf.st_mode))
943 return (statbuf.st_size);
946 /* Create a temporary filename and put it in string pointed to by
950 __gnat_tmp_name (char *tmp_filename)
956 /* tempnam tries to create a temporary file in directory pointed to by
957 TMP environment variable, in c:\temp if TMP is not set, and in
958 directory specified by P_tmpdir in stdio.h if c:\temp does not
959 exist. The filename will be created with the prefix "gnat-". */
961 pname = (char *) tempnam ("c:\\temp", "gnat-");
963 /* if pname is NULL, the file was not created properly, the disk is full
964 or there is no more free temporary files */
967 *tmp_filename = '\0';
969 /* If pname start with a back slash and not path information it means that
970 the filename is valid for the current working directory. */
972 else if (pname[0] == '\\')
974 strcpy (tmp_filename, ".\\");
975 strcat (tmp_filename, pname+1);
978 strcpy (tmp_filename, pname);
983 #elif defined (linux) || defined (__FreeBSD__) || defined (__NetBSD__)
984 #define MAX_SAFE_PATH 1000
985 char *tmpdir = getenv ("TMPDIR");
987 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
988 a buffer overflow. */
989 if (tmpdir == NULL || strlen (tmpdir) > MAX_SAFE_PATH)
990 strcpy (tmp_filename, "/tmp/gnat-XXXXXX");
992 sprintf (tmp_filename, "%s/gnat-XXXXXX", tmpdir);
994 close (mkstemp(tmp_filename));
996 tmpnam (tmp_filename);
1000 /* Open directory and returns a DIR pointer. */
1002 DIR* __gnat_opendir (char *name)
1005 /* Not supported in RTX */
1009 #elif defined (__MINGW32__)
1010 TCHAR wname[GNAT_MAX_PATH_LEN];
1012 S2WSU (wname, name, GNAT_MAX_PATH_LEN);
1013 return (DIR*)_topendir (wname);
1016 return opendir (name);
1020 /* Read the next entry in a directory. The returned string points somewhere
1024 __gnat_readdir (DIR *dirp, char *buffer, int *len)
1027 /* Not supported in RTX */
1030 #elif defined (__MINGW32__)
1031 struct _tdirent *dirent = _treaddir ((_TDIR*)dirp);
1035 WS2SU (buffer, dirent->d_name, GNAT_MAX_PATH_LEN);
1036 *len = strlen (buffer);
1043 #elif defined (HAVE_READDIR_R)
1044 /* If possible, try to use the thread-safe version. */
1045 if (readdir_r (dirp, buffer) != NULL)
1047 *len = strlen (((struct dirent*) buffer)->d_name);
1048 return ((struct dirent*) buffer)->d_name;
1054 struct dirent *dirent = (struct dirent *) readdir (dirp);
1058 strcpy (buffer, dirent->d_name);
1059 *len = strlen (buffer);
1068 /* Close a directory entry. */
1070 int __gnat_closedir (DIR *dirp)
1073 /* Not supported in RTX */
1077 #elif defined (__MINGW32__)
1078 return _tclosedir ((_TDIR*)dirp);
1081 return closedir (dirp);
1085 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1088 __gnat_readdir_is_thread_safe (void)
1090 #ifdef HAVE_READDIR_R
1097 #if defined (_WIN32) && !defined (RTX)
1098 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1099 static const unsigned long long w32_epoch_offset = 11644473600ULL;
1101 /* Returns the file modification timestamp using Win32 routines which are
1102 immune against daylight saving time change. It is in fact not possible to
1103 use fstat for this purpose as the DST modify the st_mtime field of the
1107 win32_filetime (HANDLE h)
1112 unsigned long long ull_time;
1115 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1116 since <Jan 1st 1601>. This function must return the number of seconds
1117 since <Jan 1st 1970>. */
1119 if (GetFileTime (h, NULL, NULL, &t_write.ft_time))
1120 return (time_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
1125 /* Return a GNAT time stamp given a file name. */
1128 __gnat_file_time_name (char *name)
1131 #if defined (__EMX__) || defined (MSDOS)
1132 int fd = open (name, O_RDONLY | O_BINARY);
1133 time_t ret = __gnat_file_time_fd (fd);
1135 return (OS_Time)ret;
1137 #elif defined (_WIN32) && !defined (RTX)
1139 TCHAR wname[GNAT_MAX_PATH_LEN];
1141 S2WSU (wname, name, GNAT_MAX_PATH_LEN);
1143 HANDLE h = CreateFile
1144 (wname, GENERIC_READ, FILE_SHARE_READ, 0,
1145 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
1147 if (h != INVALID_HANDLE_VALUE)
1149 ret = win32_filetime (h);
1152 return (OS_Time) ret;
1154 struct stat statbuf;
1155 if (__gnat_stat (name, &statbuf) != 0) {
1159 /* VMS has file versioning. */
1160 return (OS_Time)statbuf.st_ctime;
1162 return (OS_Time)statbuf.st_mtime;
1168 /* Return a GNAT time stamp given a file descriptor. */
1171 __gnat_file_time_fd (int fd)
1173 /* The following workaround code is due to the fact that under EMX and
1174 DJGPP fstat attempts to convert time values to GMT rather than keep the
1175 actual OS timestamp of the file. By using the OS2/DOS functions directly
1176 the GNAT timestamp are independent of this behavior, which is desired to
1177 facilitate the distribution of GNAT compiled libraries. */
1179 #if defined (__EMX__) || defined (MSDOS)
1183 int ret = DosQueryFileInfo (fd, 1, (unsigned char *) &fs,
1184 sizeof (FILESTATUS));
1186 unsigned file_year = fs.fdateLastWrite.year;
1187 unsigned file_month = fs.fdateLastWrite.month;
1188 unsigned file_day = fs.fdateLastWrite.day;
1189 unsigned file_hour = fs.ftimeLastWrite.hours;
1190 unsigned file_min = fs.ftimeLastWrite.minutes;
1191 unsigned file_tsec = fs.ftimeLastWrite.twosecs;
1195 int ret = getftime (fd, &fs);
1197 unsigned file_year = fs.ft_year;
1198 unsigned file_month = fs.ft_month;
1199 unsigned file_day = fs.ft_day;
1200 unsigned file_hour = fs.ft_hour;
1201 unsigned file_min = fs.ft_min;
1202 unsigned file_tsec = fs.ft_tsec;
1205 /* Calculate the seconds since epoch from the time components. First count
1206 the whole days passed. The value for years returned by the DOS and OS2
1207 functions count years from 1980, so to compensate for the UNIX epoch which
1208 begins in 1970 start with 10 years worth of days and add days for each
1209 four year period since then. */
1212 int cum_days[12] = {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
1213 int days_passed = 3652 + (file_year / 4) * 1461;
1214 int years_since_leap = file_year % 4;
1216 if (years_since_leap == 1)
1218 else if (years_since_leap == 2)
1220 else if (years_since_leap == 3)
1221 days_passed += 1096;
1226 days_passed += cum_days[file_month - 1];
1227 if (years_since_leap == 0 && file_year != 20 && file_month > 2)
1230 days_passed += file_day - 1;
1232 /* OK - have whole days. Multiply -- then add in other parts. */
1234 tot_secs = days_passed * 86400;
1235 tot_secs += file_hour * 3600;
1236 tot_secs += file_min * 60;
1237 tot_secs += file_tsec * 2;
1238 return (OS_Time) tot_secs;
1240 #elif defined (_WIN32) && !defined (RTX)
1241 HANDLE h = (HANDLE) _get_osfhandle (fd);
1242 time_t ret = win32_filetime (h);
1243 return (OS_Time) ret;
1246 struct stat statbuf;
1248 if (fstat (fd, &statbuf) != 0) {
1249 return (OS_Time) -1;
1252 /* VMS has file versioning. */
1253 return (OS_Time) statbuf.st_ctime;
1255 return (OS_Time) statbuf.st_mtime;
1261 /* Set the file time stamp. */
1264 __gnat_set_file_time_name (char *name, time_t time_stamp)
1266 #if defined (__EMX__) || defined (MSDOS) || defined (__vxworks)
1268 /* Code to implement __gnat_set_file_time_name for these systems. */
1270 #elif defined (_WIN32) && !defined (RTX)
1274 unsigned long long ull_time;
1276 TCHAR wname[GNAT_MAX_PATH_LEN];
1278 S2WSU (wname, name, GNAT_MAX_PATH_LEN);
1280 HANDLE h = CreateFile
1281 (wname, GENERIC_WRITE, FILE_SHARE_WRITE, NULL,
1282 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS,
1284 if (h == INVALID_HANDLE_VALUE)
1286 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1287 t_write.ull_time = ((unsigned long long)time_stamp + w32_epoch_offset);
1288 /* Convert to 100 nanosecond units */
1289 t_write.ull_time *= 10000000ULL;
1291 SetFileTime(h, NULL, NULL, &t_write.ft_time);
1301 unsigned long long backup, create, expire, revise;
1305 unsigned short value;
1308 unsigned system : 4;
1314 } Fat = { 0, 0, 0, 0, 0, { 0 }};
1318 { ATR$S_CREDATE, ATR$C_CREDATE, &Fat.create },
1319 { ATR$S_REVDATE, ATR$C_REVDATE, &Fat.revise },
1320 { ATR$S_EXPDATE, ATR$C_EXPDATE, &Fat.expire },
1321 { ATR$S_BAKDATE, ATR$C_BAKDATE, &Fat.backup },
1322 { ATR$S_FPRO, ATR$C_FPRO, &Fat.prot },
1323 { ATR$S_UIC, ATR$C_UIC, &Fat.uic },
1328 struct dsc$descriptor_fib fibdsc = {sizeof (fib), (void *) &fib};
1332 unsigned long long newtime;
1333 unsigned long long revtime;
1337 struct vstring file;
1338 struct dsc$descriptor_s filedsc
1339 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) file.string};
1340 struct vstring device;
1341 struct dsc$descriptor_s devicedsc
1342 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) device.string};
1343 struct vstring timev;
1344 struct dsc$descriptor_s timedsc
1345 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) timev.string};
1346 struct vstring result;
1347 struct dsc$descriptor_s resultdsc
1348 = {NAM$C_MAXRSS, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, (void *) result.string};
1350 /* Convert parameter name (a file spec) to host file form. Note that this
1351 is needed on VMS to prepare for subsequent calls to VMS RMS library
1352 routines. Note that it would not work to call __gnat_to_host_dir_spec
1353 as was done in a previous version, since this fails silently unless
1354 the feature logical DECC$EFS_CHARSET is enabled, in which case a DNF
1355 (directory not found) condition is signalled. */
1356 tryfile = (char *) __gnat_to_host_file_spec (name);
1358 /* Allocate and initialize a FAB and NAM structures. */
1362 nam.nam$l_esa = file.string;
1363 nam.nam$b_ess = NAM$C_MAXRSS;
1364 nam.nam$l_rsa = result.string;
1365 nam.nam$b_rss = NAM$C_MAXRSS;
1366 fab.fab$l_fna = tryfile;
1367 fab.fab$b_fns = strlen (tryfile);
1368 fab.fab$l_nam = &nam;
1370 /* Validate filespec syntax and device existence. */
1371 status = SYS$PARSE (&fab, 0, 0);
1372 if ((status & 1) != 1)
1373 LIB$SIGNAL (status);
1375 file.string[nam.nam$b_esl] = 0;
1377 /* Find matching filespec. */
1378 status = SYS$SEARCH (&fab, 0, 0);
1379 if ((status & 1) != 1)
1380 LIB$SIGNAL (status);
1382 file.string[nam.nam$b_esl] = 0;
1383 result.string[result.length=nam.nam$b_rsl] = 0;
1385 /* Get the device name and assign an IO channel. */
1386 strncpy (device.string, nam.nam$l_dev, nam.nam$b_dev);
1387 devicedsc.dsc$w_length = nam.nam$b_dev;
1389 status = SYS$ASSIGN (&devicedsc, &chan, 0, 0, 0);
1390 if ((status & 1) != 1)
1391 LIB$SIGNAL (status);
1393 /* Initialize the FIB and fill in the directory id field. */
1394 memset (&fib, 0, sizeof (fib));
1395 fib.fib$w_did[0] = nam.nam$w_did[0];
1396 fib.fib$w_did[1] = nam.nam$w_did[1];
1397 fib.fib$w_did[2] = nam.nam$w_did[2];
1398 fib.fib$l_acctl = 0;
1400 strcpy (file.string, (strrchr (result.string, ']') + 1));
1401 filedsc.dsc$w_length = strlen (file.string);
1402 result.string[result.length = 0] = 0;
1404 /* Open and close the file to fill in the attributes. */
1406 = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
1407 &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
1408 if ((status & 1) != 1)
1409 LIB$SIGNAL (status);
1410 if ((iosb.status & 1) != 1)
1411 LIB$SIGNAL (iosb.status);
1413 result.string[result.length] = 0;
1414 status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0, &fibdsc, 0, 0, 0,
1416 if ((status & 1) != 1)
1417 LIB$SIGNAL (status);
1418 if ((iosb.status & 1) != 1)
1419 LIB$SIGNAL (iosb.status);
1424 /* Set creation time to requested time. */
1425 unix_time_to_vms (time_stamp, newtime);
1427 t = time ((time_t) 0);
1429 /* Set revision time to now in local time. */
1430 unix_time_to_vms (t, revtime);
1433 /* Reopen the file, modify the times and then close. */
1434 fib.fib$l_acctl = FIB$M_WRITE;
1436 = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
1437 &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
1438 if ((status & 1) != 1)
1439 LIB$SIGNAL (status);
1440 if ((iosb.status & 1) != 1)
1441 LIB$SIGNAL (iosb.status);
1443 Fat.create = newtime;
1444 Fat.revise = revtime;
1446 status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0,
1447 &fibdsc, 0, 0, 0, &atrlst, 0);
1448 if ((status & 1) != 1)
1449 LIB$SIGNAL (status);
1450 if ((iosb.status & 1) != 1)
1451 LIB$SIGNAL (iosb.status);
1453 /* Deassign the channel and exit. */
1454 status = SYS$DASSGN (chan);
1455 if ((status & 1) != 1)
1456 LIB$SIGNAL (status);
1458 struct utimbuf utimbuf;
1461 /* Set modification time to requested time. */
1462 utimbuf.modtime = time_stamp;
1464 /* Set access time to now in local time. */
1465 t = time ((time_t) 0);
1466 utimbuf.actime = mktime (localtime (&t));
1468 utime (name, &utimbuf);
1473 #include <windows.h>
1476 /* Get the list of installed standard libraries from the
1477 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1481 __gnat_get_libraries_from_registry (void)
1483 char *result = (char *) "";
1485 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE) && ! defined (RTX)
1488 DWORD name_size, value_size;
1495 /* First open the key. */
1496 res = RegOpenKeyExA (HKEY_LOCAL_MACHINE, "SOFTWARE", 0, KEY_READ, ®_key);
1498 if (res == ERROR_SUCCESS)
1499 res = RegOpenKeyExA (reg_key, "Ada Core Technologies", 0,
1500 KEY_READ, ®_key);
1502 if (res == ERROR_SUCCESS)
1503 res = RegOpenKeyExA (reg_key, "GNAT", 0, KEY_READ, ®_key);
1505 if (res == ERROR_SUCCESS)
1506 res = RegOpenKeyExA (reg_key, "Standard Libraries", 0, KEY_READ, ®_key);
1508 /* If the key exists, read out all the values in it and concatenate them
1510 for (index = 0; res == ERROR_SUCCESS; index++)
1512 value_size = name_size = 256;
1513 res = RegEnumValueA (reg_key, index, (TCHAR*)name, &name_size, 0,
1514 &type, (LPBYTE)value, &value_size);
1516 if (res == ERROR_SUCCESS && type == REG_SZ)
1518 char *old_result = result;
1520 result = (char *) xmalloc (strlen (old_result) + value_size + 2);
1521 strcpy (result, old_result);
1522 strcat (result, value);
1523 strcat (result, ";");
1527 /* Remove the trailing ";". */
1529 result[strlen (result) - 1] = 0;
1536 __gnat_stat (char *name, struct stat *statbuf)
1539 /* Under Windows the directory name for the stat function must not be
1540 terminated by a directory separator except if just after a drive name. */
1541 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
1545 S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
1546 name_len = _tcslen (wname);
1548 if (name_len > GNAT_MAX_PATH_LEN)
1551 last_char = wname[name_len - 1];
1553 while (name_len > 1 && (last_char == _T('\\') || last_char == _T('/')))
1555 wname[name_len - 1] = _T('\0');
1557 last_char = wname[name_len - 1];
1560 /* Only a drive letter followed by ':', we must add a directory separator
1561 for the stat routine to work properly. */
1562 if (name_len == 2 && wname[1] == _T(':'))
1563 _tcscat (wname, _T("\\"));
1565 return _tstat (wname, statbuf);
1568 return stat (name, statbuf);
1573 __gnat_file_exists (char *name)
1575 #if defined (__MINGW32__) && !defined (RTX)
1576 /* On Windows do not use __gnat_stat() because a bug in Microsoft
1577 _stat() routine. When the system time-zone is set with a negative
1578 offset the _stat() routine fails on specific files like CON: */
1579 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
1581 S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
1582 return GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
1584 struct stat statbuf;
1586 return !__gnat_stat (name, &statbuf);
1591 __gnat_is_absolute_path (char *name, int length)
1594 /* On VxWorks systems, an absolute path can be represented (depending on
1595 the host platform) as either /dir/file, or device:/dir/file, or
1596 device:drive_letter:/dir/file. */
1603 for (index = 0; index < length; index++)
1605 if (name[index] == ':' &&
1606 ((name[index + 1] == '/') ||
1607 (isalpha (name[index + 1]) && index + 2 <= length &&
1608 name[index + 2] == '/')))
1611 else if (name[index] == '/')
1616 return (length != 0) &&
1617 (*name == '/' || *name == DIR_SEPARATOR
1618 #if defined (__EMX__) || defined (MSDOS) || defined (WINNT)
1619 || (length > 1 && isalpha (name[0]) && name[1] == ':')
1626 __gnat_is_regular_file (char *name)
1629 struct stat statbuf;
1631 ret = __gnat_stat (name, &statbuf);
1632 return (!ret && S_ISREG (statbuf.st_mode));
1636 __gnat_is_directory (char *name)
1639 struct stat statbuf;
1641 ret = __gnat_stat (name, &statbuf);
1642 return (!ret && S_ISDIR (statbuf.st_mode));
1646 __gnat_is_readable_file (char *name)
1650 struct stat statbuf;
1652 ret = __gnat_stat (name, &statbuf);
1653 mode = statbuf.st_mode & S_IRUSR;
1654 return (!ret && mode);
1658 __gnat_is_writable_file (char *name)
1662 struct stat statbuf;
1664 ret = __gnat_stat (name, &statbuf);
1665 mode = statbuf.st_mode & S_IWUSR;
1666 return (!ret && mode);
1670 __gnat_set_writable (char *name)
1672 #if ! defined (__vxworks) && ! defined(__nucleus__)
1673 struct stat statbuf;
1675 if (stat (name, &statbuf) == 0)
1677 statbuf.st_mode = statbuf.st_mode | S_IWUSR;
1678 chmod (name, statbuf.st_mode);
1684 __gnat_set_executable (char *name)
1686 #if ! defined (__vxworks) && ! defined(__nucleus__)
1687 struct stat statbuf;
1689 if (stat (name, &statbuf) == 0)
1691 statbuf.st_mode = statbuf.st_mode | S_IXUSR;
1692 chmod (name, statbuf.st_mode);
1698 __gnat_set_readonly (char *name)
1700 #if ! defined (__vxworks) && ! defined(__nucleus__)
1701 struct stat statbuf;
1703 if (stat (name, &statbuf) == 0)
1705 statbuf.st_mode = statbuf.st_mode & 07577;
1706 chmod (name, statbuf.st_mode);
1712 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
1714 #if defined (__vxworks) || defined (__nucleus__)
1717 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
1719 struct stat statbuf;
1721 ret = lstat (name, &statbuf);
1722 return (!ret && S_ISLNK (statbuf.st_mode));
1729 #if defined (sun) && defined (__SVR4)
1730 /* Using fork on Solaris will duplicate all the threads. fork1, which
1731 duplicates only the active thread, must be used instead, or spawning
1732 subprocess from a program with tasking will lead into numerous problems. */
1737 __gnat_portable_spawn (char *args[])
1740 int finished ATTRIBUTE_UNUSED;
1741 int pid ATTRIBUTE_UNUSED;
1743 #if defined (__vxworks) || defined(__nucleus__) || defined(RTX)
1746 #elif defined (MSDOS) || defined (_WIN32)
1747 /* args[0] must be quotes as it could contain a full pathname with spaces */
1748 char *args_0 = args[0];
1749 args[0] = (char *)xmalloc (strlen (args_0) + 3);
1750 strcpy (args[0], "\"");
1751 strcat (args[0], args_0);
1752 strcat (args[0], "\"");
1754 status = spawnvp (P_WAIT, args_0, (const char* const*)args);
1756 /* restore previous value */
1758 args[0] = (char *)args_0;
1768 pid = spawnvp (P_NOWAIT, args[0], args);
1780 if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
1782 return -1; /* execv is in parent context on VMS. */
1790 finished = waitpid (pid, &status, 0);
1792 if (finished != pid || WIFEXITED (status) == 0)
1795 return WEXITSTATUS (status);
1801 /* Create a copy of the given file descriptor.
1802 Return -1 if an error occurred. */
1805 __gnat_dup (int oldfd)
1807 #if defined (__vxworks) && !defined (__RTP__)
1808 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
1816 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
1817 Return -1 if an error occurred. */
1820 __gnat_dup2 (int oldfd, int newfd)
1822 #if defined (__vxworks) && !defined (__RTP__)
1823 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
1827 return dup2 (oldfd, newfd);
1831 /* WIN32 code to implement a wait call that wait for any child process. */
1833 #if defined (_WIN32) && !defined (RTX)
1835 /* Synchronization code, to be thread safe. */
1837 static CRITICAL_SECTION plist_cs;
1840 __gnat_plist_init (void)
1842 InitializeCriticalSection (&plist_cs);
1848 EnterCriticalSection (&plist_cs);
1854 LeaveCriticalSection (&plist_cs);
1857 typedef struct _process_list
1860 struct _process_list *next;
1863 static Process_List *PLIST = NULL;
1865 static int plist_length = 0;
1868 add_handle (HANDLE h)
1872 pl = (Process_List *) xmalloc (sizeof (Process_List));
1876 /* -------------------- critical section -------------------- */
1881 /* -------------------- critical section -------------------- */
1887 remove_handle (HANDLE h)
1890 Process_List *prev = NULL;
1894 /* -------------------- critical section -------------------- */
1903 prev->next = pl->next;
1915 /* -------------------- critical section -------------------- */
1921 win32_no_block_spawn (char *command, char *args[])
1925 PROCESS_INFORMATION PI;
1926 SECURITY_ATTRIBUTES SA;
1931 /* compute the total command line length */
1935 csize += strlen (args[k]) + 1;
1939 full_command = (char *) xmalloc (csize);
1942 SI.cb = sizeof (STARTUPINFO);
1943 SI.lpReserved = NULL;
1944 SI.lpReserved2 = NULL;
1945 SI.lpDesktop = NULL;
1949 SI.wShowWindow = SW_HIDE;
1951 /* Security attributes. */
1952 SA.nLength = sizeof (SECURITY_ATTRIBUTES);
1953 SA.bInheritHandle = TRUE;
1954 SA.lpSecurityDescriptor = NULL;
1956 /* Prepare the command string. */
1957 strcpy (full_command, command);
1958 strcat (full_command, " ");
1963 strcat (full_command, args[k]);
1964 strcat (full_command, " ");
1969 int wsize = csize * 2;
1970 TCHAR *wcommand = (TCHAR *) xmalloc (wsize);
1972 S2WSU (wcommand, full_command, wsize);
1974 free (full_command);
1976 result = CreateProcess
1977 (NULL, wcommand, &SA, NULL, TRUE,
1978 GetPriorityClass (GetCurrentProcess()), NULL, NULL, &SI, &PI);
1985 add_handle (PI.hProcess);
1986 CloseHandle (PI.hThread);
1987 return (int) PI.hProcess;
1994 win32_wait (int *status)
2003 if (plist_length == 0)
2009 hl = (HANDLE *) xmalloc (sizeof (HANDLE) * plist_length);
2014 /* -------------------- critical section -------------------- */
2021 /* -------------------- critical section -------------------- */
2025 res = WaitForMultipleObjects (plist_length, hl, FALSE, INFINITE);
2026 h = hl[res - WAIT_OBJECT_0];
2031 GetExitCodeProcess (h, &exitcode);
2034 *status = (int) exitcode;
2041 __gnat_portable_no_block_spawn (char *args[])
2045 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX)
2048 #elif defined (__EMX__) || defined (MSDOS)
2050 /* ??? For PC machines I (Franco) don't know the system calls to implement
2051 this routine. So I'll fake it as follows. This routine will behave
2052 exactly like the blocking portable_spawn and will systematically return
2053 a pid of 0 unless the spawned task did not complete successfully, in
2054 which case we return a pid of -1. To synchronize with this the
2055 portable_wait below systematically returns a pid of 0 and reports that
2056 the subprocess terminated successfully. */
2058 if (spawnvp (P_WAIT, args[0], args) != 0)
2061 #elif defined (_WIN32)
2063 pid = win32_no_block_spawn (args[0], args);
2072 if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
2074 return -1; /* execv is in parent context on VMS. */
2086 __gnat_portable_wait (int *process_status)
2091 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX)
2092 /* Not sure what to do here, so do same as __EMX__ case, i.e., nothing but
2095 #elif defined (_WIN32)
2097 pid = win32_wait (&status);
2099 #elif defined (__EMX__) || defined (MSDOS)
2100 /* ??? See corresponding comment in portable_no_block_spawn. */
2104 pid = waitpid (-1, &status, 0);
2105 status = status & 0xffff;
2108 *process_status = status;
2113 __gnat_os_exit (int status)
2118 /* Locate a regular file, give a Path value. */
2121 __gnat_locate_regular_file (char *file_name, char *path_val)
2124 char *file_path = alloca (strlen (file_name) + 1);
2127 /* Return immediately if file_name is empty */
2129 if (*file_name == '\0')
2132 /* Remove quotes around file_name if present */
2138 strcpy (file_path, ptr);
2140 ptr = file_path + strlen (file_path) - 1;
2145 /* Handle absolute pathnames. */
2147 absolute = __gnat_is_absolute_path (file_path, strlen (file_name));
2151 if (__gnat_is_regular_file (file_path))
2152 return xstrdup (file_path);
2157 /* If file_name include directory separator(s), try it first as
2158 a path name relative to the current directory */
2159 for (ptr = file_name; *ptr && *ptr != '/' && *ptr != DIR_SEPARATOR; ptr++)
2164 if (__gnat_is_regular_file (file_name))
2165 return xstrdup (file_name);
2172 /* The result has to be smaller than path_val + file_name. */
2173 char *file_path = alloca (strlen (path_val) + strlen (file_name) + 2);
2177 for (; *path_val == PATH_SEPARATOR; path_val++)
2183 /* Skip the starting quote */
2185 if (*path_val == '"')
2188 for (ptr = file_path; *path_val && *path_val != PATH_SEPARATOR; )
2189 *ptr++ = *path_val++;
2193 /* Skip the ending quote */
2198 if (*ptr != '/' && *ptr != DIR_SEPARATOR)
2199 *++ptr = DIR_SEPARATOR;
2201 strcpy (++ptr, file_name);
2203 if (__gnat_is_regular_file (file_path))
2204 return xstrdup (file_path);
2211 /* Locate an executable given a Path argument. This routine is only used by
2212 gnatbl and should not be used otherwise. Use locate_exec_on_path
2216 __gnat_locate_exec (char *exec_name, char *path_val)
2219 if (!strstr (exec_name, HOST_EXECUTABLE_SUFFIX))
2221 char *full_exec_name
2222 = alloca (strlen (exec_name) + strlen (HOST_EXECUTABLE_SUFFIX) + 1);
2224 strcpy (full_exec_name, exec_name);
2225 strcat (full_exec_name, HOST_EXECUTABLE_SUFFIX);
2226 ptr = __gnat_locate_regular_file (full_exec_name, path_val);
2229 return __gnat_locate_regular_file (exec_name, path_val);
2233 return __gnat_locate_regular_file (exec_name, path_val);
2236 /* Locate an executable using the Systems default PATH. */
2239 __gnat_locate_exec_on_path (char *exec_name)
2243 #if defined (_WIN32) && !defined (RTX)
2244 TCHAR *wpath_val = _tgetenv (_T("PATH"));
2246 /* In Win32 systems we expand the PATH as for XP environment
2247 variables are not automatically expanded. We also prepend the
2248 ".;" to the path to match normal NT path search semantics */
2250 #define EXPAND_BUFFER_SIZE 32767
2252 wapath_val = alloca (EXPAND_BUFFER_SIZE);
2254 wapath_val [0] = '.';
2255 wapath_val [1] = ';';
2257 DWORD res = ExpandEnvironmentStrings
2258 (wpath_val, &wapath_val[2], EXPAND_BUFFER_SIZE - 2);
2260 if (!res) wapath_val [0] = _T('\0');
2262 apath_val = alloca (EXPAND_BUFFER_SIZE);
2264 WS2SU (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
2265 return __gnat_locate_exec (exec_name, apath_val);
2270 char *path_val = "/VAXC$PATH";
2272 char *path_val = getenv ("PATH");
2274 if (path_val == NULL) return NULL;
2275 apath_val = alloca (strlen (path_val) + 1);
2276 strcpy (apath_val, path_val);
2277 return __gnat_locate_exec (exec_name, apath_val);
2283 /* These functions are used to translate to and from VMS and Unix syntax
2284 file, directory and path specifications. */
2287 #define MAXNAMES 256
2288 #define NEW_CANONICAL_FILELIST_INCREMENT 64
2290 static char new_canonical_dirspec [MAXPATH];
2291 static char new_canonical_filespec [MAXPATH];
2292 static char new_canonical_pathspec [MAXNAMES*MAXPATH];
2293 static unsigned new_canonical_filelist_index;
2294 static unsigned new_canonical_filelist_in_use;
2295 static unsigned new_canonical_filelist_allocated;
2296 static char **new_canonical_filelist;
2297 static char new_host_pathspec [MAXNAMES*MAXPATH];
2298 static char new_host_dirspec [MAXPATH];
2299 static char new_host_filespec [MAXPATH];
2301 /* Routine is called repeatedly by decc$from_vms via
2302 __gnat_to_canonical_file_list_init until it returns 0 or the expansion
2306 wildcard_translate_unix (char *name)
2309 char buff [MAXPATH];
2311 strncpy (buff, name, MAXPATH);
2312 buff [MAXPATH - 1] = (char) 0;
2313 ver = strrchr (buff, '.');
2315 /* Chop off the version. */
2319 /* Dynamically extend the allocation by the increment. */
2320 if (new_canonical_filelist_in_use == new_canonical_filelist_allocated)
2322 new_canonical_filelist_allocated += NEW_CANONICAL_FILELIST_INCREMENT;
2323 new_canonical_filelist = (char **) xrealloc
2324 (new_canonical_filelist,
2325 new_canonical_filelist_allocated * sizeof (char *));
2328 new_canonical_filelist[new_canonical_filelist_in_use++] = xstrdup (buff);
2333 /* Translate a wildcard VMS file spec into a list of Unix file specs. First do
2334 full translation and copy the results into a list (_init), then return them
2335 one at a time (_next). If onlydirs set, only expand directory files. */
2338 __gnat_to_canonical_file_list_init (char *filespec, int onlydirs)
2341 char buff [MAXPATH];
2343 len = strlen (filespec);
2344 strncpy (buff, filespec, MAXPATH);
2346 /* Only look for directories */
2347 if (onlydirs && !strstr (&buff [len-5], "*.dir"))
2348 strncat (buff, "*.dir", MAXPATH);
2350 buff [MAXPATH - 1] = (char) 0;
2352 decc$from_vms (buff, wildcard_translate_unix, 1);
2354 /* Remove the .dir extension. */
2360 for (i = 0; i < new_canonical_filelist_in_use; i++)
2362 ext = strstr (new_canonical_filelist[i], ".dir");
2368 return new_canonical_filelist_in_use;
2371 /* Return the next filespec in the list. */
2374 __gnat_to_canonical_file_list_next ()
2376 return new_canonical_filelist[new_canonical_filelist_index++];
2379 /* Free storage used in the wildcard expansion. */
2382 __gnat_to_canonical_file_list_free ()
2386 for (i = 0; i < new_canonical_filelist_in_use; i++)
2387 free (new_canonical_filelist[i]);
2389 free (new_canonical_filelist);
2391 new_canonical_filelist_in_use = 0;
2392 new_canonical_filelist_allocated = 0;
2393 new_canonical_filelist_index = 0;
2394 new_canonical_filelist = 0;
2397 /* The functional equivalent of decc$translate_vms routine.
2398 Designed to produce the same output, but is protected against
2399 malformed paths (original version ACCVIOs in this case) and
2400 does not require VMS-specific DECC RTL */
2402 #define NAM$C_MAXRSS 1024
2405 __gnat_translate_vms (char *src)
2407 static char retbuf [NAM$C_MAXRSS+1];
2408 char *srcendpos, *pos1, *pos2, *retpos;
2409 int disp, path_present = 0;
2411 if (!src) return NULL;
2413 srcendpos = strchr (src, '\0');
2416 /* Look for the node and/or device in front of the path */
2418 pos2 = strchr (pos1, ':');
2420 if (pos2 && (pos2 < srcendpos) && (*(pos2 + 1) == ':')) {
2421 /* There is a node name. "node_name::" becomes "node_name!" */
2423 strncpy (retbuf, pos1, disp);
2424 retpos [disp] = '!';
2425 retpos = retpos + disp + 1;
2427 pos2 = strchr (pos1, ':');
2431 /* There is a device name. "dev_name:" becomes "/dev_name/" */
2434 strncpy (retpos, pos1, disp);
2435 retpos = retpos + disp;
2440 /* No explicit device; we must look ahead and prepend /sys$disk/ if
2441 the path is absolute */
2442 if ((*pos1 == '[' || *pos1 == '<') && (pos1 < srcendpos)
2443 && !strchr (".-]>", *(pos1 + 1))) {
2444 strncpy (retpos, "/sys$disk/", 10);
2448 /* Process the path part */
2449 while (*pos1 == '[' || *pos1 == '<') {
2452 if (*pos1 == ']' || *pos1 == '>') {
2453 /* Special case, [] translates to '.' */
2458 /* '[000000' means root dir. It can be present in the middle of
2459 the path due to expansion of logical devices, in which case
2461 if (!strncmp (pos1, "000000", 6) && path_present > 1 &&
2462 (*(pos1 + 6) == ']' || *(pos1 + 6) == '>' || *(pos1 + 6) == '.')) {
2464 if (*pos1 == '.') pos1++;
2466 else if (*pos1 == '.') {
2471 /* There is a qualified path */
2472 while (*pos1 && *pos1 != ']' && *pos1 != '>') {
2475 /* '.' is used to separate directories. Replace it with '/' but
2476 only if there isn't already '/' just before */
2477 if (*(retpos - 1) != '/') *(retpos++) = '/';
2479 if (pos1 + 1 < srcendpos && *pos1 == '.' && *(pos1 + 1) == '.') {
2480 /* ellipsis refers to entire subtree; replace with '**' */
2481 *(retpos++) = '*'; *(retpos++) = '*'; *(retpos++) = '/';
2486 /* When after '.' '[' '<' is equivalent to Unix ".." but there
2487 may be several in a row */
2488 if (*(pos1 - 1) == '.' || *(pos1 - 1) == '[' ||
2489 *(pos1 - 1) == '<') {
2490 while (*pos1 == '-') {
2492 *(retpos++) = '.'; *(retpos++) = '.'; *(retpos++) = '/';
2497 /* otherwise fall through to default */
2499 *(retpos++) = *(pos1++);
2506 if (pos1 < srcendpos) {
2507 /* Now add the actual file name, until the version suffix if any */
2508 if (path_present) *(retpos++) = '/';
2509 pos2 = strchr (pos1, ';');
2510 disp = pos2? (pos2 - pos1) : (srcendpos - pos1);
2511 strncpy (retpos, pos1, disp);
2513 if (pos2 && pos2 < srcendpos) {
2514 /* There is a non-empty version suffix. ";<ver>" becomes ".<ver>" */
2516 disp = srcendpos - pos2 - 1;
2517 strncpy (retpos, pos2 + 1, disp);
2528 /* Translate a VMS syntax directory specification in to Unix syntax. If
2529 PREFIXFLAG is set, append an underscore "/". If no indicators of VMS syntax
2530 found, return input string. Also translate a dirname that contains no
2531 slashes, in case it's a logical name. */
2534 __gnat_to_canonical_dir_spec (char *dirspec, int prefixflag)
2538 strcpy (new_canonical_dirspec, "");
2539 if (strlen (dirspec))
2543 if (strchr (dirspec, ']') || strchr (dirspec, ':'))
2545 strncpy (new_canonical_dirspec,
2546 __gnat_translate_vms (dirspec),
2549 else if (!strchr (dirspec, '/') && (dirspec1 = getenv (dirspec)) != 0)
2551 strncpy (new_canonical_dirspec,
2552 __gnat_translate_vms (dirspec1),
2557 strncpy (new_canonical_dirspec, dirspec, MAXPATH);
2561 len = strlen (new_canonical_dirspec);
2562 if (prefixflag && new_canonical_dirspec [len-1] != '/')
2563 strncat (new_canonical_dirspec, "/", MAXPATH);
2565 new_canonical_dirspec [MAXPATH - 1] = (char) 0;
2567 return new_canonical_dirspec;
2571 /* Translate a VMS syntax file specification into Unix syntax.
2572 If no indicators of VMS syntax found, check if it's an uppercase
2573 alphanumeric_ name and if so try it out as an environment
2574 variable (logical name). If all else fails return the
2578 __gnat_to_canonical_file_spec (char *filespec)
2582 strncpy (new_canonical_filespec, "", MAXPATH);
2584 if (strchr (filespec, ']') || strchr (filespec, ':'))
2586 char *tspec = (char *) __gnat_translate_vms (filespec);
2588 if (tspec != (char *) -1)
2589 strncpy (new_canonical_filespec, tspec, MAXPATH);
2591 else if ((strlen (filespec) == strspn (filespec,
2592 "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"))
2593 && (filespec1 = getenv (filespec)))
2595 char *tspec = (char *) __gnat_translate_vms (filespec1);
2597 if (tspec != (char *) -1)
2598 strncpy (new_canonical_filespec, tspec, MAXPATH);
2602 strncpy (new_canonical_filespec, filespec, MAXPATH);
2605 new_canonical_filespec [MAXPATH - 1] = (char) 0;
2607 return new_canonical_filespec;
2610 /* Translate a VMS syntax path specification into Unix syntax.
2611 If no indicators of VMS syntax found, return input string. */
2614 __gnat_to_canonical_path_spec (char *pathspec)
2616 char *curr, *next, buff [MAXPATH];
2621 /* If there are /'s, assume it's a Unix path spec and return. */
2622 if (strchr (pathspec, '/'))
2625 new_canonical_pathspec[0] = 0;
2630 next = strchr (curr, ',');
2632 next = strchr (curr, 0);
2634 strncpy (buff, curr, next - curr);
2635 buff[next - curr] = 0;
2637 /* Check for wildcards and expand if present. */
2638 if (strchr (buff, '*') || strchr (buff, '%') || strstr (buff, "..."))
2642 dirs = __gnat_to_canonical_file_list_init (buff, 1);
2643 for (i = 0; i < dirs; i++)
2647 next_dir = __gnat_to_canonical_file_list_next ();
2648 strncat (new_canonical_pathspec, next_dir, MAXPATH);
2650 /* Don't append the separator after the last expansion. */
2652 strncat (new_canonical_pathspec, ":", MAXPATH);
2655 __gnat_to_canonical_file_list_free ();
2658 strncat (new_canonical_pathspec,
2659 __gnat_to_canonical_dir_spec (buff, 0), MAXPATH);
2664 strncat (new_canonical_pathspec, ":", MAXPATH);
2668 new_canonical_pathspec [MAXPATH - 1] = (char) 0;
2670 return new_canonical_pathspec;
2673 static char filename_buff [MAXPATH];
2676 translate_unix (char *name, int type)
2678 strncpy (filename_buff, name, MAXPATH);
2679 filename_buff [MAXPATH - 1] = (char) 0;
2683 /* Translate a Unix syntax path spec into a VMS style (comma separated list of
2687 to_host_path_spec (char *pathspec)
2689 char *curr, *next, buff [MAXPATH];
2694 /* Can't very well test for colons, since that's the Unix separator! */
2695 if (strchr (pathspec, ']') || strchr (pathspec, ','))
2698 new_host_pathspec[0] = 0;
2703 next = strchr (curr, ':');
2705 next = strchr (curr, 0);
2707 strncpy (buff, curr, next - curr);
2708 buff[next - curr] = 0;
2710 strncat (new_host_pathspec, __gnat_to_host_dir_spec (buff, 0), MAXPATH);
2713 strncat (new_host_pathspec, ",", MAXPATH);
2717 new_host_pathspec [MAXPATH - 1] = (char) 0;
2719 return new_host_pathspec;
2722 /* Translate a Unix syntax directory specification into VMS syntax. The
2723 PREFIXFLAG has no effect, but is kept for symmetry with
2724 to_canonical_dir_spec. If indicators of VMS syntax found, return input
2728 __gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
2730 int len = strlen (dirspec);
2732 strncpy (new_host_dirspec, dirspec, MAXPATH);
2733 new_host_dirspec [MAXPATH - 1] = (char) 0;
2735 if (strchr (new_host_dirspec, ']') || strchr (new_host_dirspec, ':'))
2736 return new_host_dirspec;
2738 while (len > 1 && new_host_dirspec[len - 1] == '/')
2740 new_host_dirspec[len - 1] = 0;
2744 decc$to_vms (new_host_dirspec, translate_unix, 1, 2);
2745 strncpy (new_host_dirspec, filename_buff, MAXPATH);
2746 new_host_dirspec [MAXPATH - 1] = (char) 0;
2748 return new_host_dirspec;
2751 /* Translate a Unix syntax file specification into VMS syntax.
2752 If indicators of VMS syntax found, return input string. */
2755 __gnat_to_host_file_spec (char *filespec)
2757 strncpy (new_host_filespec, "", MAXPATH);
2758 if (strchr (filespec, ']') || strchr (filespec, ':'))
2760 strncpy (new_host_filespec, filespec, MAXPATH);
2764 decc$to_vms (filespec, translate_unix, 1, 1);
2765 strncpy (new_host_filespec, filename_buff, MAXPATH);
2768 new_host_filespec [MAXPATH - 1] = (char) 0;
2770 return new_host_filespec;
2774 __gnat_adjust_os_resource_limits ()
2776 SYS$ADJWSL (131072, 0);
2781 /* Dummy functions for Osint import for non-VMS systems. */
2784 __gnat_to_canonical_file_list_init
2785 (char *dirspec ATTRIBUTE_UNUSED, int onlydirs ATTRIBUTE_UNUSED)
2791 __gnat_to_canonical_file_list_next (void)
2797 __gnat_to_canonical_file_list_free (void)
2802 __gnat_to_canonical_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
2808 __gnat_to_canonical_file_spec (char *filespec)
2814 __gnat_to_canonical_path_spec (char *pathspec)
2820 __gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
2826 __gnat_to_host_file_spec (char *filespec)
2832 __gnat_adjust_os_resource_limits (void)
2838 /* For EMX, we cannot include dummy in libgcc, since it is too difficult
2839 to coordinate this with the EMX distribution. Consequently, we put the
2840 definition of dummy which is used for exception handling, here. */
2842 #if defined (__EMX__)
2846 #if defined (__mips_vxworks)
2850 CACHE_USER_FLUSH (0, ENTIRE_CACHE);
2854 #if defined (CROSS_DIRECTORY_STRUCTURE) \
2855 || (! ((defined (sparc) || defined (i386)) && defined (sun) \
2856 && defined (__SVR4)) \
2857 && ! (defined (linux) && (defined (i386) || defined (__x86_64__))) \
2858 && ! (defined (linux) && defined (__ia64__)) \
2859 && ! defined (__FreeBSD__) \
2860 && ! defined (__hpux__) \
2861 && ! defined (__APPLE__) \
2862 && ! defined (_AIX) \
2863 && ! (defined (__alpha__) && defined (__osf__)) \
2864 && ! defined (VMS) \
2865 && ! defined (__MINGW32__) \
2866 && ! (defined (__mips) && defined (__sgi)))
2868 /* Dummy function to satisfy g-trasym.o. See the preprocessor conditional
2869 just above for a list of native platforms that provide a non-dummy
2870 version of this procedure in libaddr2line.a. */
2873 convert_addresses (const char *file_name ATTRIBUTE_UNUSED,
2874 void *addrs ATTRIBUTE_UNUSED,
2875 int n_addr ATTRIBUTE_UNUSED,
2876 void *buf ATTRIBUTE_UNUSED,
2877 int *len ATTRIBUTE_UNUSED)
2883 #if defined (_WIN32)
2884 int __gnat_argument_needs_quote = 1;
2886 int __gnat_argument_needs_quote = 0;
2889 /* This option is used to enable/disable object files handling from the
2890 binder file by the GNAT Project module. For example, this is disabled on
2891 Windows (prior to GCC 3.4) as it is already done by the mdll module.
2892 Stating with GCC 3.4 the shared libraries are not based on mdll
2893 anymore as it uses the GCC's -shared option */
2894 #if defined (_WIN32) \
2895 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
2896 int __gnat_prj_add_obj_files = 0;
2898 int __gnat_prj_add_obj_files = 1;
2901 /* char used as prefix/suffix for environment variables */
2902 #if defined (_WIN32)
2903 char __gnat_environment_char = '%';
2905 char __gnat_environment_char = '$';
2908 /* This functions copy the file attributes from a source file to a
2911 mode = 0 : In this mode copy only the file time stamps (last access and
2912 last modification time stamps).
2914 mode = 1 : In this mode, time stamps and read/write/execute attributes are
2917 Returns 0 if operation was successful and -1 in case of error. */
2920 __gnat_copy_attribs (char *from, char *to, int mode)
2922 #if defined (VMS) || defined (__vxworks) || defined (__nucleus__)
2926 struct utimbuf tbuf;
2928 if (stat (from, &fbuf) == -1)
2933 tbuf.actime = fbuf.st_atime;
2934 tbuf.modtime = fbuf.st_mtime;
2936 if (utime (to, &tbuf) == -1)
2943 if (chmod (to, fbuf.st_mode) == -1)
2954 __gnat_lseek (int fd, long offset, int whence)
2956 return (int) lseek (fd, offset, whence);
2959 /* This function returns the major version number of GCC being used. */
2961 get_gcc_version (void)
2966 return (int) (version_string[0] - '0');
2971 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED,
2972 int close_on_exec_p ATTRIBUTE_UNUSED)
2974 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
2975 int flags = fcntl (fd, F_GETFD, 0);
2978 if (close_on_exec_p)
2979 flags |= FD_CLOEXEC;
2981 flags &= ~FD_CLOEXEC;
2982 return fcntl (fd, F_SETFD, flags | FD_CLOEXEC);
2985 /* For the Windows case, we should use SetHandleInformation to remove
2986 the HANDLE_INHERIT property from fd. This is not implemented yet,
2987 but for our purposes (support of GNAT.Expect) this does not matter,
2988 as by default handles are *not* inherited. */
2992 /* Indicates if platforms supports automatic initialization through the
2993 constructor mechanism */
2995 __gnat_binder_supports_auto_init ()
3004 /* Indicates that Stand-Alone Libraries are automatically initialized through
3005 the constructor mechanism */
3007 __gnat_sals_init_using_constructors ()
3009 #if defined (__vxworks) || defined (__Lynx__) || defined (VMS)
3016 /* In RTX mode, the procedure to get the time (as file time) is different
3017 in RTSS mode and Win32 mode. In order to avoid duplicating an Ada file,
3018 we introduce an intermediate procedure to link against the corresponding
3019 one in each situation. */
3022 void GetTimeAsFileTime(LPFILETIME pTime)
3025 RtGetRtssTimeAsFileTime (pTime); /* RTSS interface */
3027 GetSystemTimeAsFileTime (pTime); /* w32 interface */
3033 /* pthread affinity support */
3036 #include <pthread.h>
3038 __gnat_pthread_setaffinity_np (pthread_t th,
3040 const cpu_set_t *cpuset)
3042 return pthread_setaffinity_np (th, cpusetsize, cpuset);
3046 __gnat_pthread_setaffinity_np (pthread_t th,