1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
9 * Copyright (C) 1992-2008, 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>
89 /* For isalpha-like tests in the compiler, we're expected to resort to
90 safe-ctype.h/ISALPHA. This isn't available for the runtime library
91 build, so we fallback on ctype.h/isalpha there. */
95 #define ISALPHA isalpha
98 #elif defined (__Lynx__)
100 /* Lynx utime.h only defines the entities of interest to us if
101 defined (VMOS_DEV), so ... */
110 /* wait.h processing */
113 #include <sys/wait.h>
115 #elif defined (__vxworks) && defined (__RTP__)
117 #elif defined (__Lynx__)
118 /* ??? We really need wait.h and it includes resource.h on Lynx. GCC
119 has a resource.h header as well, included instead of the lynx
120 version in our setup, causing lots of errors. We don't really need
121 the lynx contents of this file, so just workaround the issue by
122 preventing the inclusion of the GCC header from doing anything. */
123 #define GCC_RESOURCE_H
124 #include <sys/wait.h>
125 #elif defined (__nucleus__)
126 /* No wait() or waitpid() calls available */
129 #include <sys/wait.h>
132 #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
135 /* Header files and definitions for __gnat_set_file_time_name. */
137 #define __NEW_STARLET 1
139 #include <vms/atrdef.h>
140 #include <vms/fibdef.h>
141 #include <vms/stsdef.h>
142 #include <vms/iodef.h>
144 #include <vms/descrip.h>
148 /* Use native 64-bit arithmetic. */
149 #define unix_time_to_vms(X,Y) \
150 { unsigned long long reftime, tmptime = (X); \
151 $DESCRIPTOR (unixtime,"1-JAN-1970 0:00:00.00"); \
152 SYS$BINTIM (&unixtime, &reftime); \
153 Y = tmptime * 10000000 + reftime; }
155 /* descrip.h doesn't have everything ... */
156 typedef struct fibdef* __fibdef_ptr32 __attribute__ (( mode (SI) ));
157 struct dsc$descriptor_fib
159 unsigned int fib$l_len;
160 __fibdef_ptr32 fib$l_addr;
163 /* I/O Status Block. */
166 unsigned short status, count;
170 static char *tryfile;
172 /* Variable length string. */
176 char string[NAM$C_MAXRSS+1];
183 #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
191 #define DIR_SEPARATOR '\\'
196 /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
197 defined in the current system. On DOS-like systems these flags control
198 whether the file is opened/created in text-translation mode (CR/LF in
199 external file mapped to LF in internal file), but in Unix-like systems,
200 no text translation is required, so these flags have no effect. */
202 #if defined (__EMX__)
218 #ifndef HOST_EXECUTABLE_SUFFIX
219 #define HOST_EXECUTABLE_SUFFIX ""
222 #ifndef HOST_OBJECT_SUFFIX
223 #define HOST_OBJECT_SUFFIX ".o"
226 #ifndef PATH_SEPARATOR
227 #define PATH_SEPARATOR ':'
230 #ifndef DIR_SEPARATOR
231 #define DIR_SEPARATOR '/'
234 /* Check for cross-compilation */
235 #ifdef CROSS_DIRECTORY_STRUCTURE
236 int __gnat_is_cross_compiler = 1;
238 int __gnat_is_cross_compiler = 0;
241 char __gnat_dir_separator = DIR_SEPARATOR;
243 char __gnat_path_separator = PATH_SEPARATOR;
245 /* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
246 the base filenames that libraries specified with -lsomelib options
247 may have. This is used by GNATMAKE to check whether an executable
248 is up-to-date or not. The syntax is
250 library_template ::= { pattern ; } pattern NUL
251 pattern ::= [ prefix ] * [ postfix ]
253 These should only specify names of static libraries as it makes
254 no sense to determine at link time if dynamic-link libraries are
255 up to date or not. Any libraries that are not found are supposed
258 * if they are needed but not present, the link
261 * otherwise they are libraries in the system paths and so
262 they are considered part of the system and not checked
265 ??? This should be part of a GNAT host-specific compiler
266 file instead of being included in all user applications
267 as well. This is only a temporary work-around for 3.11b. */
269 #ifndef GNAT_LIBRARY_TEMPLATE
270 #if defined (__EMX__)
271 #define GNAT_LIBRARY_TEMPLATE "*.a"
273 #define GNAT_LIBRARY_TEMPLATE "*.olb"
275 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
279 const char *__gnat_library_template = GNAT_LIBRARY_TEMPLATE;
281 /* This variable is used in hostparm.ads to say whether the host is a VMS
284 const int __gnat_vmsp = 1;
286 const int __gnat_vmsp = 0;
290 #define GNAT_MAX_PATH_LEN MAX_PATH
293 #define GNAT_MAX_PATH_LEN 256 /* PATH_MAX */
295 #elif defined (__vxworks) || defined (__OPENNT) || defined(__nucleus__)
296 #define GNAT_MAX_PATH_LEN PATH_MAX
300 #if defined (__MINGW32__)
304 #include <sys/param.h>
308 #include <sys/param.h>
312 #define GNAT_MAX_PATH_LEN MAXPATHLEN
314 #define GNAT_MAX_PATH_LEN 256
319 /* The __gnat_max_path_len variable is used to export the maximum
320 length of a path name to Ada code. max_path_len is also provided
321 for compatibility with older GNAT versions, please do not use
324 int __gnat_max_path_len = GNAT_MAX_PATH_LEN;
325 int max_path_len = GNAT_MAX_PATH_LEN;
327 /* The following macro HAVE_READDIR_R should be defined if the
328 system provides the routine readdir_r. */
329 #undef HAVE_READDIR_R
331 #if defined(VMS) && defined (__LONG_POINTERS)
333 /* Return a 32 bit pointer to an array of 32 bit pointers
334 given a 64 bit pointer to an array of 64 bit pointers */
336 typedef __char_ptr32 *__char_ptr_char_ptr32 __attribute__ ((mode (SI)));
338 static __char_ptr_char_ptr32
339 to_ptr32 (char **ptr64)
342 __char_ptr_char_ptr32 short_argv;
344 for (argc=0; ptr64[argc]; argc++);
346 /* Reallocate argv with 32 bit pointers. */
347 short_argv = (__char_ptr_char_ptr32) decc$malloc
348 (sizeof (__char_ptr32) * (argc + 1));
350 for (argc=0; ptr64[argc]; argc++)
351 short_argv[argc] = (__char_ptr32) decc$strdup (ptr64[argc]);
353 short_argv[argc] = (__char_ptr32) 0;
357 #define MAYBE_TO_PTR32(argv) to_ptr32 (argv)
359 #define MAYBE_TO_PTR32(argv) argv
366 time_t res = time (NULL);
367 return (OS_Time) res;
370 /* Return the current local time as a string in the ISO 8601 format of
371 "YYYY-MM-DD HH:MM:SS.SS". The returned string is 22 + 1 (NULL) characters
375 __gnat_current_time_string
378 const char *format = "%Y-%m-%d %H:%M:%S";
379 /* Format string necessary to describe the ISO 8601 format */
381 const time_t t_val = time (NULL);
383 strftime (result, 22, format, localtime (&t_val));
384 /* Convert the local time into a string following the ISO format, copying
385 at most 22 characters into the result string. */
390 /* The sub-seconds are manually set to zero since type time_t lacks the
391 precision necessary for nanoseconds. */
405 time_t time = (time_t) *p_time;
408 /* On Windows systems, the time is sometimes rounded up to the nearest
409 even second, so if the number of seconds is odd, increment it. */
415 res = localtime (&time);
417 res = gmtime (&time);
422 *p_year = res->tm_year;
423 *p_month = res->tm_mon;
424 *p_day = res->tm_mday;
425 *p_hours = res->tm_hour;
426 *p_mins = res->tm_min;
427 *p_secs = res->tm_sec;
430 *p_year = *p_month = *p_day = *p_hours = *p_mins = *p_secs = 0;
433 /* Place the contents of the symbolic link named PATH in the buffer BUF,
434 which has size BUFSIZ. If PATH is a symbolic link, then return the number
435 of characters of its content in BUF. Otherwise, return -1.
436 For systems not supporting symbolic links, always return -1. */
439 __gnat_readlink (char *path ATTRIBUTE_UNUSED,
440 char *buf ATTRIBUTE_UNUSED,
441 size_t bufsiz ATTRIBUTE_UNUSED)
443 #if defined (MSDOS) || defined (_WIN32) || defined (__EMX__) \
444 || defined (VMS) || defined(__vxworks) || defined (__nucleus__)
447 return readlink (path, buf, bufsiz);
451 /* Creates a symbolic link named NEWPATH which contains the string OLDPATH.
452 If NEWPATH exists it will NOT be overwritten.
453 For systems not supporting symbolic links, always return -1. */
456 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED,
457 char *newpath ATTRIBUTE_UNUSED)
459 #if defined (MSDOS) || defined (_WIN32) || defined (__EMX__) \
460 || defined (VMS) || defined(__vxworks) || defined (__nucleus__)
463 return symlink (oldpath, newpath);
467 /* Try to lock a file, return 1 if success. */
469 #if defined (__vxworks) || defined (__nucleus__) || defined (MSDOS) \
472 /* Version that does not use link. */
475 __gnat_try_lock (char *dir, char *file)
479 TCHAR wfull_path[GNAT_MAX_PATH_LEN];
480 TCHAR wfile[GNAT_MAX_PATH_LEN];
481 TCHAR wdir[GNAT_MAX_PATH_LEN];
483 S2WSU (wdir, dir, GNAT_MAX_PATH_LEN);
484 S2WSU (wfile, file, GNAT_MAX_PATH_LEN);
486 _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
487 fd = _topen (wfull_path, O_CREAT | O_EXCL, 0600);
491 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
492 fd = open (full_path, O_CREAT | O_EXCL, 0600);
502 #elif defined (__EMX__) || defined (VMS)
504 /* More cases that do not use link; identical code, to solve too long
508 __gnat_try_lock (char *dir, char *file)
513 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
514 fd = open (full_path, O_CREAT | O_EXCL, 0600);
525 /* Version using link(), more secure over NFS. */
526 /* See TN 6913-016 for discussion ??? */
529 __gnat_try_lock (char *dir, char *file)
533 struct stat stat_result;
536 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
537 sprintf (temp_file, "%s%cTMP-%ld-%ld",
538 dir, DIR_SEPARATOR, (long)getpid(), (long)getppid ());
540 /* Create the temporary file and write the process number. */
541 fd = open (temp_file, O_CREAT | O_WRONLY, 0600);
547 /* Link it with the new file. */
548 link (temp_file, full_path);
550 /* Count the references on the old one. If we have a count of two, then
551 the link did succeed. Remove the temporary file before returning. */
552 __gnat_stat (temp_file, &stat_result);
554 return stat_result.st_nlink == 2;
558 /* Return the maximum file name length. */
561 __gnat_get_maximum_file_name_length (void)
566 if (getenv ("GNAT$EXTENDED_FILE_SPECIFICATIONS"))
575 /* Return nonzero if file names are case sensitive. */
578 __gnat_get_file_names_case_sensitive (void)
580 #if defined (__EMX__) || defined (MSDOS) || defined (VMS) || defined (WINNT)
588 __gnat_get_default_identifier_character_set (void)
590 #if defined (__EMX__) || defined (MSDOS)
597 /* Return the current working directory. */
600 __gnat_get_current_dir (char *dir, int *length)
602 #if defined (__MINGW32__)
603 TCHAR wdir[GNAT_MAX_PATH_LEN];
605 _tgetcwd (wdir, *length);
607 WS2SU (dir, wdir, GNAT_MAX_PATH_LEN);
610 /* Force Unix style, which is what GNAT uses internally. */
611 getcwd (dir, *length, 0);
613 getcwd (dir, *length);
616 *length = strlen (dir);
618 if (dir [*length - 1] != DIR_SEPARATOR)
620 dir [*length] = DIR_SEPARATOR;
626 /* Return the suffix for object files. */
629 __gnat_get_object_suffix_ptr (int *len, const char **value)
631 *value = HOST_OBJECT_SUFFIX;
636 *len = strlen (*value);
641 /* Return the suffix for executable files. */
644 __gnat_get_executable_suffix_ptr (int *len, const char **value)
646 *value = HOST_EXECUTABLE_SUFFIX;
650 *len = strlen (*value);
655 /* Return the suffix for debuggable files. Usually this is the same as the
656 executable extension. */
659 __gnat_get_debuggable_suffix_ptr (int *len, const char **value)
662 *value = HOST_EXECUTABLE_SUFFIX;
664 /* On DOS, the extensionless COFF file is what gdb likes. */
671 *len = strlen (*value);
676 /* Returns the OS filename and corresponding encoding. */
679 __gnat_os_filename (char *filename, char *w_filename ATTRIBUTE_UNUSED,
680 char *os_name, int *o_length,
681 char *encoding ATTRIBUTE_UNUSED, int *e_length)
683 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE)
684 WS2SU (os_name, (TCHAR *)w_filename, o_length);
685 *o_length = strlen (os_name);
686 strcpy (encoding, "encoding=utf8");
687 *e_length = strlen (encoding);
689 strcpy (os_name, filename);
690 *o_length = strlen (filename);
696 __gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED)
698 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE)
699 TCHAR wpath[GNAT_MAX_PATH_LEN];
702 S2WS (wmode, mode, 10);
704 if (encoding == Encoding_UTF8)
705 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
707 S2WS (wpath, path, GNAT_MAX_PATH_LEN);
709 return _tfopen (wpath, wmode);
711 return decc$fopen (path, mode);
713 return fopen (path, mode);
718 __gnat_freopen (char *path, char *mode, FILE *stream, int encoding ATTRIBUTE_UNUSED)
720 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE)
721 TCHAR wpath[GNAT_MAX_PATH_LEN];
724 S2WS (wmode, mode, 10);
726 if (encoding == Encoding_UTF8)
727 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
729 S2WS (wpath, path, GNAT_MAX_PATH_LEN);
731 return _tfreopen (wpath, wmode, stream);
733 return decc$freopen (path, mode, stream);
735 return freopen (path, mode, stream);
740 __gnat_open_read (char *path, int fmode)
743 int o_fmode = O_BINARY;
749 /* Optional arguments mbc,deq,fop increase read performance. */
750 fd = open (path, O_RDONLY | o_fmode, 0444,
751 "mbc=16", "deq=64", "fop=tef");
752 #elif defined (__vxworks)
753 fd = open (path, O_RDONLY | o_fmode, 0444);
754 #elif defined (__MINGW32__)
756 TCHAR wpath[GNAT_MAX_PATH_LEN];
758 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
759 fd = _topen (wpath, O_RDONLY | o_fmode, 0444);
762 fd = open (path, O_RDONLY | o_fmode);
765 return fd < 0 ? -1 : fd;
768 #if defined (__EMX__) || defined (__MINGW32__)
769 #define PERM (S_IREAD | S_IWRITE)
771 /* Excerpt from DECC C RTL Reference Manual:
772 To create files with OpenVMS RMS default protections using the UNIX
773 system-call functions umask, mkdir, creat, and open, call mkdir, creat,
774 and open with a file-protection mode argument of 0777 in a program
775 that never specifically calls umask. These default protections include
776 correctly establishing protections based on ACLs, previous versions of
780 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
784 __gnat_open_rw (char *path, int fmode)
787 int o_fmode = O_BINARY;
793 fd = open (path, O_RDWR | o_fmode, PERM,
794 "mbc=16", "deq=64", "fop=tef");
795 #elif defined (__MINGW32__)
797 TCHAR wpath[GNAT_MAX_PATH_LEN];
799 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
800 fd = _topen (wpath, O_RDWR | o_fmode, PERM);
803 fd = open (path, O_RDWR | o_fmode, PERM);
806 return fd < 0 ? -1 : fd;
810 __gnat_open_create (char *path, int fmode)
813 int o_fmode = O_BINARY;
819 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM,
820 "mbc=16", "deq=64", "fop=tef");
821 #elif defined (__MINGW32__)
823 TCHAR wpath[GNAT_MAX_PATH_LEN];
825 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
826 fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
829 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
832 return fd < 0 ? -1 : fd;
836 __gnat_create_output_file (char *path)
840 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM,
841 "rfm=stmlf", "ctx=rec", "rat=none", "rop=nlk",
842 "shr=del,get,put,upd");
843 #elif defined (__MINGW32__)
845 TCHAR wpath[GNAT_MAX_PATH_LEN];
847 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
848 fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
851 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
854 return fd < 0 ? -1 : fd;
858 __gnat_open_append (char *path, int fmode)
861 int o_fmode = O_BINARY;
867 fd = open (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM,
868 "mbc=16", "deq=64", "fop=tef");
869 #elif defined (__MINGW32__)
871 TCHAR wpath[GNAT_MAX_PATH_LEN];
873 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
874 fd = _topen (wpath, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
877 fd = open (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
880 return fd < 0 ? -1 : fd;
883 /* Open a new file. Return error (-1) if the file already exists. */
886 __gnat_open_new (char *path, int fmode)
889 int o_fmode = O_BINARY;
895 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM,
896 "mbc=16", "deq=64", "fop=tef");
897 #elif defined (__MINGW32__)
899 TCHAR wpath[GNAT_MAX_PATH_LEN];
901 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
902 fd = _topen (wpath, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
905 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
908 return fd < 0 ? -1 : fd;
911 /* Open a new temp file. Return error (-1) if the file already exists.
912 Special options for VMS allow the file to be shared between parent and child
913 processes, however they really slow down output. Used in gnatchop. */
916 __gnat_open_new_temp (char *path, int fmode)
919 int o_fmode = O_BINARY;
921 strcpy (path, "GNAT-XXXXXX");
923 #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
924 || defined (linux) || defined(__GLIBC__)) && !defined (__vxworks)
925 return mkstemp (path);
926 #elif defined (__Lynx__)
928 #elif defined (__nucleus__)
931 if (mktemp (path) == NULL)
939 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM,
940 "rfm=stmlf", "ctx=rec", "rat=none", "shr=del,get,put,upd",
941 "mbc=16", "deq=64", "fop=tef");
943 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
946 return fd < 0 ? -1 : fd;
949 /* Return the number of bytes in the specified file. */
952 __gnat_file_length (int fd)
957 ret = fstat (fd, &statbuf);
958 if (ret || !S_ISREG (statbuf.st_mode))
961 return (statbuf.st_size);
964 /* Return the number of bytes in the specified named file. */
967 __gnat_named_file_length (char *name)
972 ret = __gnat_stat (name, &statbuf);
973 if (ret || !S_ISREG (statbuf.st_mode))
976 return (statbuf.st_size);
979 /* Create a temporary filename and put it in string pointed to by
983 __gnat_tmp_name (char *tmp_filename)
989 /* tempnam tries to create a temporary file in directory pointed to by
990 TMP environment variable, in c:\temp if TMP is not set, and in
991 directory specified by P_tmpdir in stdio.h if c:\temp does not
992 exist. The filename will be created with the prefix "gnat-". */
994 pname = (char *) tempnam ("c:\\temp", "gnat-");
996 /* if pname is NULL, the file was not created properly, the disk is full
997 or there is no more free temporary files */
1000 *tmp_filename = '\0';
1002 /* If pname start with a back slash and not path information it means that
1003 the filename is valid for the current working directory. */
1005 else if (pname[0] == '\\')
1007 strcpy (tmp_filename, ".\\");
1008 strcat (tmp_filename, pname+1);
1011 strcpy (tmp_filename, pname);
1016 #elif defined (linux) || defined (__FreeBSD__) || defined (__NetBSD__) \
1017 || defined (__OpenBSD__) || defined(__GLIBC__)
1018 #define MAX_SAFE_PATH 1000
1019 char *tmpdir = getenv ("TMPDIR");
1021 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1022 a buffer overflow. */
1023 if (tmpdir == NULL || strlen (tmpdir) > MAX_SAFE_PATH)
1024 strcpy (tmp_filename, "/tmp/gnat-XXXXXX");
1026 sprintf (tmp_filename, "%s/gnat-XXXXXX", tmpdir);
1028 close (mkstemp(tmp_filename));
1030 tmpnam (tmp_filename);
1034 /* Open directory and returns a DIR pointer. */
1036 DIR* __gnat_opendir (char *name)
1039 /* Not supported in RTX */
1043 #elif defined (__MINGW32__)
1044 TCHAR wname[GNAT_MAX_PATH_LEN];
1046 S2WSU (wname, name, GNAT_MAX_PATH_LEN);
1047 return (DIR*)_topendir (wname);
1050 return opendir (name);
1054 /* Read the next entry in a directory. The returned string points somewhere
1058 __gnat_readdir (DIR *dirp, char *buffer, int *len)
1061 /* Not supported in RTX */
1065 #elif defined (__MINGW32__)
1066 struct _tdirent *dirent = _treaddir ((_TDIR*)dirp);
1070 WS2SU (buffer, dirent->d_name, GNAT_MAX_PATH_LEN);
1071 *len = strlen (buffer);
1078 #elif defined (HAVE_READDIR_R)
1079 /* If possible, try to use the thread-safe version. */
1080 if (readdir_r (dirp, buffer) != NULL)
1082 *len = strlen (((struct dirent*) buffer)->d_name);
1083 return ((struct dirent*) buffer)->d_name;
1089 struct dirent *dirent = (struct dirent *) readdir (dirp);
1093 strcpy (buffer, dirent->d_name);
1094 *len = strlen (buffer);
1103 /* Close a directory entry. */
1105 int __gnat_closedir (DIR *dirp)
1108 /* Not supported in RTX */
1112 #elif defined (__MINGW32__)
1113 return _tclosedir ((_TDIR*)dirp);
1116 return closedir (dirp);
1120 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1123 __gnat_readdir_is_thread_safe (void)
1125 #ifdef HAVE_READDIR_R
1132 #if defined (_WIN32) && !defined (RTX)
1133 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1134 static const unsigned long long w32_epoch_offset = 11644473600ULL;
1136 /* Returns the file modification timestamp using Win32 routines which are
1137 immune against daylight saving time change. It is in fact not possible to
1138 use fstat for this purpose as the DST modify the st_mtime field of the
1142 win32_filetime (HANDLE h)
1147 unsigned long long ull_time;
1150 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1151 since <Jan 1st 1601>. This function must return the number of seconds
1152 since <Jan 1st 1970>. */
1154 if (GetFileTime (h, NULL, NULL, &t_write.ft_time))
1155 return (time_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
1160 /* Return a GNAT time stamp given a file name. */
1163 __gnat_file_time_name (char *name)
1166 #if defined (__EMX__) || defined (MSDOS)
1167 int fd = open (name, O_RDONLY | O_BINARY);
1168 time_t ret = __gnat_file_time_fd (fd);
1170 return (OS_Time)ret;
1172 #elif defined (_WIN32) && !defined (RTX)
1174 TCHAR wname[GNAT_MAX_PATH_LEN];
1176 S2WSU (wname, name, GNAT_MAX_PATH_LEN);
1178 HANDLE h = CreateFile
1179 (wname, GENERIC_READ, FILE_SHARE_READ, 0,
1180 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
1182 if (h != INVALID_HANDLE_VALUE)
1184 ret = win32_filetime (h);
1187 return (OS_Time) ret;
1189 struct stat statbuf;
1190 if (__gnat_stat (name, &statbuf) != 0) {
1194 /* VMS has file versioning. */
1195 return (OS_Time)statbuf.st_ctime;
1197 return (OS_Time)statbuf.st_mtime;
1203 /* Return a GNAT time stamp given a file descriptor. */
1206 __gnat_file_time_fd (int fd)
1208 /* The following workaround code is due to the fact that under EMX and
1209 DJGPP fstat attempts to convert time values to GMT rather than keep the
1210 actual OS timestamp of the file. By using the OS2/DOS functions directly
1211 the GNAT timestamp are independent of this behavior, which is desired to
1212 facilitate the distribution of GNAT compiled libraries. */
1214 #if defined (__EMX__) || defined (MSDOS)
1218 int ret = DosQueryFileInfo (fd, 1, (unsigned char *) &fs,
1219 sizeof (FILESTATUS));
1221 unsigned file_year = fs.fdateLastWrite.year;
1222 unsigned file_month = fs.fdateLastWrite.month;
1223 unsigned file_day = fs.fdateLastWrite.day;
1224 unsigned file_hour = fs.ftimeLastWrite.hours;
1225 unsigned file_min = fs.ftimeLastWrite.minutes;
1226 unsigned file_tsec = fs.ftimeLastWrite.twosecs;
1230 int ret = getftime (fd, &fs);
1232 unsigned file_year = fs.ft_year;
1233 unsigned file_month = fs.ft_month;
1234 unsigned file_day = fs.ft_day;
1235 unsigned file_hour = fs.ft_hour;
1236 unsigned file_min = fs.ft_min;
1237 unsigned file_tsec = fs.ft_tsec;
1240 /* Calculate the seconds since epoch from the time components. First count
1241 the whole days passed. The value for years returned by the DOS and OS2
1242 functions count years from 1980, so to compensate for the UNIX epoch which
1243 begins in 1970 start with 10 years worth of days and add days for each
1244 four year period since then. */
1247 int cum_days[12] = {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
1248 int days_passed = 3652 + (file_year / 4) * 1461;
1249 int years_since_leap = file_year % 4;
1251 if (years_since_leap == 1)
1253 else if (years_since_leap == 2)
1255 else if (years_since_leap == 3)
1256 days_passed += 1096;
1261 days_passed += cum_days[file_month - 1];
1262 if (years_since_leap == 0 && file_year != 20 && file_month > 2)
1265 days_passed += file_day - 1;
1267 /* OK - have whole days. Multiply -- then add in other parts. */
1269 tot_secs = days_passed * 86400;
1270 tot_secs += file_hour * 3600;
1271 tot_secs += file_min * 60;
1272 tot_secs += file_tsec * 2;
1273 return (OS_Time) tot_secs;
1275 #elif defined (_WIN32) && !defined (RTX)
1276 HANDLE h = (HANDLE) _get_osfhandle (fd);
1277 time_t ret = win32_filetime (h);
1278 return (OS_Time) ret;
1281 struct stat statbuf;
1283 if (fstat (fd, &statbuf) != 0) {
1284 return (OS_Time) -1;
1287 /* VMS has file versioning. */
1288 return (OS_Time) statbuf.st_ctime;
1290 return (OS_Time) statbuf.st_mtime;
1296 /* Set the file time stamp. */
1299 __gnat_set_file_time_name (char *name, time_t time_stamp)
1301 #if defined (__EMX__) || defined (MSDOS) || defined (__vxworks)
1303 /* Code to implement __gnat_set_file_time_name for these systems. */
1305 #elif defined (_WIN32) && !defined (RTX)
1309 unsigned long long ull_time;
1311 TCHAR wname[GNAT_MAX_PATH_LEN];
1313 S2WSU (wname, name, GNAT_MAX_PATH_LEN);
1315 HANDLE h = CreateFile
1316 (wname, GENERIC_WRITE, FILE_SHARE_WRITE, NULL,
1317 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS,
1319 if (h == INVALID_HANDLE_VALUE)
1321 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1322 t_write.ull_time = ((unsigned long long)time_stamp + w32_epoch_offset);
1323 /* Convert to 100 nanosecond units */
1324 t_write.ull_time *= 10000000ULL;
1326 SetFileTime(h, NULL, NULL, &t_write.ft_time);
1336 unsigned long long backup, create, expire, revise;
1340 unsigned short value;
1343 unsigned system : 4;
1349 } Fat = { 0, 0, 0, 0, 0, { 0 }};
1353 { ATR$S_CREDATE, ATR$C_CREDATE, &Fat.create },
1354 { ATR$S_REVDATE, ATR$C_REVDATE, &Fat.revise },
1355 { ATR$S_EXPDATE, ATR$C_EXPDATE, &Fat.expire },
1356 { ATR$S_BAKDATE, ATR$C_BAKDATE, &Fat.backup },
1357 { ATR$S_FPRO, ATR$C_FPRO, &Fat.prot },
1358 { ATR$S_UIC, ATR$C_UIC, &Fat.uic },
1363 struct dsc$descriptor_fib fibdsc = {sizeof (fib), (void *) &fib};
1367 unsigned long long newtime;
1368 unsigned long long revtime;
1372 struct vstring file;
1373 struct dsc$descriptor_s filedsc
1374 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) file.string};
1375 struct vstring device;
1376 struct dsc$descriptor_s devicedsc
1377 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) device.string};
1378 struct vstring timev;
1379 struct dsc$descriptor_s timedsc
1380 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) timev.string};
1381 struct vstring result;
1382 struct dsc$descriptor_s resultdsc
1383 = {NAM$C_MAXRSS, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, (void *) result.string};
1385 /* Convert parameter name (a file spec) to host file form. Note that this
1386 is needed on VMS to prepare for subsequent calls to VMS RMS library
1387 routines. Note that it would not work to call __gnat_to_host_dir_spec
1388 as was done in a previous version, since this fails silently unless
1389 the feature logical DECC$EFS_CHARSET is enabled, in which case a DNF
1390 (directory not found) condition is signalled. */
1391 tryfile = (char *) __gnat_to_host_file_spec (name);
1393 /* Allocate and initialize a FAB and NAM structures. */
1397 nam.nam$l_esa = file.string;
1398 nam.nam$b_ess = NAM$C_MAXRSS;
1399 nam.nam$l_rsa = result.string;
1400 nam.nam$b_rss = NAM$C_MAXRSS;
1401 fab.fab$l_fna = tryfile;
1402 fab.fab$b_fns = strlen (tryfile);
1403 fab.fab$l_nam = &nam;
1405 /* Validate filespec syntax and device existence. */
1406 status = SYS$PARSE (&fab, 0, 0);
1407 if ((status & 1) != 1)
1408 LIB$SIGNAL (status);
1410 file.string[nam.nam$b_esl] = 0;
1412 /* Find matching filespec. */
1413 status = SYS$SEARCH (&fab, 0, 0);
1414 if ((status & 1) != 1)
1415 LIB$SIGNAL (status);
1417 file.string[nam.nam$b_esl] = 0;
1418 result.string[result.length=nam.nam$b_rsl] = 0;
1420 /* Get the device name and assign an IO channel. */
1421 strncpy (device.string, nam.nam$l_dev, nam.nam$b_dev);
1422 devicedsc.dsc$w_length = nam.nam$b_dev;
1424 status = SYS$ASSIGN (&devicedsc, &chan, 0, 0, 0);
1425 if ((status & 1) != 1)
1426 LIB$SIGNAL (status);
1428 /* Initialize the FIB and fill in the directory id field. */
1429 memset (&fib, 0, sizeof (fib));
1430 fib.fib$w_did[0] = nam.nam$w_did[0];
1431 fib.fib$w_did[1] = nam.nam$w_did[1];
1432 fib.fib$w_did[2] = nam.nam$w_did[2];
1433 fib.fib$l_acctl = 0;
1435 strcpy (file.string, (strrchr (result.string, ']') + 1));
1436 filedsc.dsc$w_length = strlen (file.string);
1437 result.string[result.length = 0] = 0;
1439 /* Open and close the file to fill in the attributes. */
1441 = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
1442 &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
1443 if ((status & 1) != 1)
1444 LIB$SIGNAL (status);
1445 if ((iosb.status & 1) != 1)
1446 LIB$SIGNAL (iosb.status);
1448 result.string[result.length] = 0;
1449 status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0, &fibdsc, 0, 0, 0,
1451 if ((status & 1) != 1)
1452 LIB$SIGNAL (status);
1453 if ((iosb.status & 1) != 1)
1454 LIB$SIGNAL (iosb.status);
1459 /* Set creation time to requested time. */
1460 unix_time_to_vms (time_stamp, newtime);
1462 t = time ((time_t) 0);
1464 /* Set revision time to now in local time. */
1465 unix_time_to_vms (t, revtime);
1468 /* Reopen the file, modify the times and then close. */
1469 fib.fib$l_acctl = FIB$M_WRITE;
1471 = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
1472 &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
1473 if ((status & 1) != 1)
1474 LIB$SIGNAL (status);
1475 if ((iosb.status & 1) != 1)
1476 LIB$SIGNAL (iosb.status);
1478 Fat.create = newtime;
1479 Fat.revise = revtime;
1481 status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0,
1482 &fibdsc, 0, 0, 0, &atrlst, 0);
1483 if ((status & 1) != 1)
1484 LIB$SIGNAL (status);
1485 if ((iosb.status & 1) != 1)
1486 LIB$SIGNAL (iosb.status);
1488 /* Deassign the channel and exit. */
1489 status = SYS$DASSGN (chan);
1490 if ((status & 1) != 1)
1491 LIB$SIGNAL (status);
1493 struct utimbuf utimbuf;
1496 /* Set modification time to requested time. */
1497 utimbuf.modtime = time_stamp;
1499 /* Set access time to now in local time. */
1500 t = time ((time_t) 0);
1501 utimbuf.actime = mktime (localtime (&t));
1503 utime (name, &utimbuf);
1508 #include <windows.h>
1511 /* Get the list of installed standard libraries from the
1512 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1516 __gnat_get_libraries_from_registry (void)
1518 char *result = (char *) "";
1520 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE) && ! defined (RTX)
1523 DWORD name_size, value_size;
1530 /* First open the key. */
1531 res = RegOpenKeyExA (HKEY_LOCAL_MACHINE, "SOFTWARE", 0, KEY_READ, ®_key);
1533 if (res == ERROR_SUCCESS)
1534 res = RegOpenKeyExA (reg_key, "Ada Core Technologies", 0,
1535 KEY_READ, ®_key);
1537 if (res == ERROR_SUCCESS)
1538 res = RegOpenKeyExA (reg_key, "GNAT", 0, KEY_READ, ®_key);
1540 if (res == ERROR_SUCCESS)
1541 res = RegOpenKeyExA (reg_key, "Standard Libraries", 0, KEY_READ, ®_key);
1543 /* If the key exists, read out all the values in it and concatenate them
1545 for (index = 0; res == ERROR_SUCCESS; index++)
1547 value_size = name_size = 256;
1548 res = RegEnumValueA (reg_key, index, (TCHAR*)name, &name_size, 0,
1549 &type, (LPBYTE)value, &value_size);
1551 if (res == ERROR_SUCCESS && type == REG_SZ)
1553 char *old_result = result;
1555 result = (char *) xmalloc (strlen (old_result) + value_size + 2);
1556 strcpy (result, old_result);
1557 strcat (result, value);
1558 strcat (result, ";");
1562 /* Remove the trailing ";". */
1564 result[strlen (result) - 1] = 0;
1571 __gnat_stat (char *name, struct stat *statbuf)
1574 /* Under Windows the directory name for the stat function must not be
1575 terminated by a directory separator except if just after a drive name. */
1576 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
1580 S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
1581 name_len = _tcslen (wname);
1583 if (name_len > GNAT_MAX_PATH_LEN)
1586 last_char = wname[name_len - 1];
1588 while (name_len > 1 && (last_char == _T('\\') || last_char == _T('/')))
1590 wname[name_len - 1] = _T('\0');
1592 last_char = wname[name_len - 1];
1595 /* Only a drive letter followed by ':', we must add a directory separator
1596 for the stat routine to work properly. */
1597 if (name_len == 2 && wname[1] == _T(':'))
1598 _tcscat (wname, _T("\\"));
1600 return _tstat (wname, statbuf);
1603 return stat (name, statbuf);
1608 __gnat_file_exists (char *name)
1611 /* On Windows do not use __gnat_stat() because a bug in Microsoft
1612 _stat() routine. When the system time-zone is set with a negative
1613 offset the _stat() routine fails on specific files like CON: */
1614 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
1616 S2WSU (wname, name, GNAT_MAX_PATH_LEN + 2);
1617 return GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
1619 struct stat statbuf;
1621 return !__gnat_stat (name, &statbuf);
1626 __gnat_is_absolute_path (char *name, int length)
1629 /* On VxWorks systems, an absolute path can be represented (depending on
1630 the host platform) as either /dir/file, or device:/dir/file, or
1631 device:drive_letter:/dir/file. */
1638 for (index = 0; index < length; index++)
1640 if (name[index] == ':' &&
1641 ((name[index + 1] == '/') ||
1642 (isalpha (name[index + 1]) && index + 2 <= length &&
1643 name[index + 2] == '/')))
1646 else if (name[index] == '/')
1651 return (length != 0) &&
1652 (*name == '/' || *name == DIR_SEPARATOR
1653 #if defined (__EMX__) || defined (MSDOS) || defined (WINNT)
1654 || (length > 1 && ISALPHA (name[0]) && name[1] == ':')
1661 __gnat_is_regular_file (char *name)
1664 struct stat statbuf;
1666 ret = __gnat_stat (name, &statbuf);
1667 return (!ret && S_ISREG (statbuf.st_mode));
1671 __gnat_is_directory (char *name)
1674 struct stat statbuf;
1676 ret = __gnat_stat (name, &statbuf);
1677 return (!ret && S_ISDIR (statbuf.st_mode));
1681 __gnat_is_readable_file (char *name)
1685 struct stat statbuf;
1687 ret = __gnat_stat (name, &statbuf);
1688 mode = statbuf.st_mode & S_IRUSR;
1689 return (!ret && mode);
1693 __gnat_is_writable_file (char *name)
1697 struct stat statbuf;
1699 ret = __gnat_stat (name, &statbuf);
1700 mode = statbuf.st_mode & S_IWUSR;
1701 return (!ret && mode);
1705 __gnat_set_writable (char *name)
1707 #if ! defined (__vxworks) && ! defined(__nucleus__)
1708 struct stat statbuf;
1710 if (stat (name, &statbuf) == 0)
1712 statbuf.st_mode = statbuf.st_mode | S_IWUSR;
1713 chmod (name, statbuf.st_mode);
1719 __gnat_set_executable (char *name)
1721 #if ! defined (__vxworks) && ! defined(__nucleus__)
1722 struct stat statbuf;
1724 if (stat (name, &statbuf) == 0)
1726 statbuf.st_mode = statbuf.st_mode | S_IXUSR;
1727 chmod (name, statbuf.st_mode);
1733 __gnat_set_readonly (char *name)
1735 #if ! defined (__vxworks) && ! defined(__nucleus__)
1736 struct stat statbuf;
1738 if (stat (name, &statbuf) == 0)
1740 statbuf.st_mode = statbuf.st_mode & 07577;
1741 chmod (name, statbuf.st_mode);
1747 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
1749 #if defined (__vxworks) || defined (__nucleus__)
1752 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
1754 struct stat statbuf;
1756 ret = lstat (name, &statbuf);
1757 return (!ret && S_ISLNK (statbuf.st_mode));
1764 #if defined (sun) && defined (__SVR4)
1765 /* Using fork on Solaris will duplicate all the threads. fork1, which
1766 duplicates only the active thread, must be used instead, or spawning
1767 subprocess from a program with tasking will lead into numerous problems. */
1772 __gnat_portable_spawn (char *args[])
1775 int finished ATTRIBUTE_UNUSED;
1776 int pid ATTRIBUTE_UNUSED;
1778 #if defined (__vxworks) || defined(__nucleus__) || defined(RTX)
1781 #elif defined (MSDOS) || defined (_WIN32)
1782 /* args[0] must be quotes as it could contain a full pathname with spaces */
1783 char *args_0 = args[0];
1784 args[0] = (char *)xmalloc (strlen (args_0) + 3);
1785 strcpy (args[0], "\"");
1786 strcat (args[0], args_0);
1787 strcat (args[0], "\"");
1789 status = spawnvp (P_WAIT, args_0, (const char* const*)args);
1791 /* restore previous value */
1793 args[0] = (char *)args_0;
1803 pid = spawnvp (P_NOWAIT, args[0], args);
1815 if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
1817 return -1; /* execv is in parent context on VMS. */
1825 finished = waitpid (pid, &status, 0);
1827 if (finished != pid || WIFEXITED (status) == 0)
1830 return WEXITSTATUS (status);
1836 /* Create a copy of the given file descriptor.
1837 Return -1 if an error occurred. */
1840 __gnat_dup (int oldfd)
1842 #if defined (__vxworks) && !defined (__RTP__)
1843 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
1851 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
1852 Return -1 if an error occurred. */
1855 __gnat_dup2 (int oldfd, int newfd)
1857 #if defined (__vxworks) && !defined (__RTP__)
1858 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
1862 return dup2 (oldfd, newfd);
1866 /* WIN32 code to implement a wait call that wait for any child process. */
1868 #if defined (_WIN32) && !defined (RTX)
1870 /* Synchronization code, to be thread safe. */
1872 static CRITICAL_SECTION plist_cs;
1875 __gnat_plist_init (void)
1877 InitializeCriticalSection (&plist_cs);
1883 EnterCriticalSection (&plist_cs);
1889 LeaveCriticalSection (&plist_cs);
1892 typedef struct _process_list
1895 struct _process_list *next;
1898 static Process_List *PLIST = NULL;
1900 static int plist_length = 0;
1903 add_handle (HANDLE h)
1907 pl = (Process_List *) xmalloc (sizeof (Process_List));
1911 /* -------------------- critical section -------------------- */
1916 /* -------------------- critical section -------------------- */
1922 remove_handle (HANDLE h)
1925 Process_List *prev = NULL;
1929 /* -------------------- critical section -------------------- */
1938 prev->next = pl->next;
1950 /* -------------------- critical section -------------------- */
1956 win32_no_block_spawn (char *command, char *args[])
1960 PROCESS_INFORMATION PI;
1961 SECURITY_ATTRIBUTES SA;
1966 /* compute the total command line length */
1970 csize += strlen (args[k]) + 1;
1974 full_command = (char *) xmalloc (csize);
1977 SI.cb = sizeof (STARTUPINFO);
1978 SI.lpReserved = NULL;
1979 SI.lpReserved2 = NULL;
1980 SI.lpDesktop = NULL;
1984 SI.wShowWindow = SW_HIDE;
1986 /* Security attributes. */
1987 SA.nLength = sizeof (SECURITY_ATTRIBUTES);
1988 SA.bInheritHandle = TRUE;
1989 SA.lpSecurityDescriptor = NULL;
1991 /* Prepare the command string. */
1992 strcpy (full_command, command);
1993 strcat (full_command, " ");
1998 strcat (full_command, args[k]);
1999 strcat (full_command, " ");
2004 int wsize = csize * 2;
2005 TCHAR *wcommand = (TCHAR *) xmalloc (wsize);
2007 S2WSU (wcommand, full_command, wsize);
2009 free (full_command);
2011 result = CreateProcess
2012 (NULL, wcommand, &SA, NULL, TRUE,
2013 GetPriorityClass (GetCurrentProcess()), NULL, NULL, &SI, &PI);
2020 add_handle (PI.hProcess);
2021 CloseHandle (PI.hThread);
2022 return (int) PI.hProcess;
2029 win32_wait (int *status)
2038 if (plist_length == 0)
2044 hl = (HANDLE *) xmalloc (sizeof (HANDLE) * plist_length);
2049 /* -------------------- critical section -------------------- */
2056 /* -------------------- critical section -------------------- */
2060 res = WaitForMultipleObjects (plist_length, hl, FALSE, INFINITE);
2061 h = hl[res - WAIT_OBJECT_0];
2066 GetExitCodeProcess (h, &exitcode);
2069 *status = (int) exitcode;
2076 __gnat_portable_no_block_spawn (char *args[])
2080 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX)
2083 #elif defined (__EMX__) || defined (MSDOS)
2085 /* ??? For PC machines I (Franco) don't know the system calls to implement
2086 this routine. So I'll fake it as follows. This routine will behave
2087 exactly like the blocking portable_spawn and will systematically return
2088 a pid of 0 unless the spawned task did not complete successfully, in
2089 which case we return a pid of -1. To synchronize with this the
2090 portable_wait below systematically returns a pid of 0 and reports that
2091 the subprocess terminated successfully. */
2093 if (spawnvp (P_WAIT, args[0], args) != 0)
2096 #elif defined (_WIN32)
2098 pid = win32_no_block_spawn (args[0], args);
2107 if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
2109 return -1; /* execv is in parent context on VMS. */
2121 __gnat_portable_wait (int *process_status)
2126 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX)
2127 /* Not sure what to do here, so do same as __EMX__ case, i.e., nothing but
2130 #elif defined (_WIN32)
2132 pid = win32_wait (&status);
2134 #elif defined (__EMX__) || defined (MSDOS)
2135 /* ??? See corresponding comment in portable_no_block_spawn. */
2139 pid = waitpid (-1, &status, 0);
2140 status = status & 0xffff;
2143 *process_status = status;
2148 __gnat_os_exit (int status)
2153 /* Locate a regular file, give a Path value. */
2156 __gnat_locate_regular_file (char *file_name, char *path_val)
2159 char *file_path = (char *) alloca (strlen (file_name) + 1);
2162 /* Return immediately if file_name is empty */
2164 if (*file_name == '\0')
2167 /* Remove quotes around file_name if present */
2173 strcpy (file_path, ptr);
2175 ptr = file_path + strlen (file_path) - 1;
2180 /* Handle absolute pathnames. */
2182 absolute = __gnat_is_absolute_path (file_path, strlen (file_name));
2186 if (__gnat_is_regular_file (file_path))
2187 return xstrdup (file_path);
2192 /* If file_name include directory separator(s), try it first as
2193 a path name relative to the current directory */
2194 for (ptr = file_name; *ptr && *ptr != '/' && *ptr != DIR_SEPARATOR; ptr++)
2199 if (__gnat_is_regular_file (file_name))
2200 return xstrdup (file_name);
2207 /* The result has to be smaller than path_val + file_name. */
2208 char *file_path = (char *) alloca (strlen (path_val) + strlen (file_name) + 2);
2212 for (; *path_val == PATH_SEPARATOR; path_val++)
2218 /* Skip the starting quote */
2220 if (*path_val == '"')
2223 for (ptr = file_path; *path_val && *path_val != PATH_SEPARATOR; )
2224 *ptr++ = *path_val++;
2228 /* Skip the ending quote */
2233 if (*ptr != '/' && *ptr != DIR_SEPARATOR)
2234 *++ptr = DIR_SEPARATOR;
2236 strcpy (++ptr, file_name);
2238 if (__gnat_is_regular_file (file_path))
2239 return xstrdup (file_path);
2246 /* Locate an executable given a Path argument. This routine is only used by
2247 gnatbl and should not be used otherwise. Use locate_exec_on_path
2251 __gnat_locate_exec (char *exec_name, char *path_val)
2254 if (!strstr (exec_name, HOST_EXECUTABLE_SUFFIX))
2256 char *full_exec_name
2257 = (char *) alloca (strlen (exec_name) + strlen (HOST_EXECUTABLE_SUFFIX) + 1);
2259 strcpy (full_exec_name, exec_name);
2260 strcat (full_exec_name, HOST_EXECUTABLE_SUFFIX);
2261 ptr = __gnat_locate_regular_file (full_exec_name, path_val);
2264 return __gnat_locate_regular_file (exec_name, path_val);
2268 return __gnat_locate_regular_file (exec_name, path_val);
2271 /* Locate an executable using the Systems default PATH. */
2274 __gnat_locate_exec_on_path (char *exec_name)
2278 #if defined (_WIN32) && !defined (RTX)
2279 TCHAR *wpath_val = _tgetenv (_T("PATH"));
2281 /* In Win32 systems we expand the PATH as for XP environment
2282 variables are not automatically expanded. We also prepend the
2283 ".;" to the path to match normal NT path search semantics */
2285 #define EXPAND_BUFFER_SIZE 32767
2287 wapath_val = alloca (EXPAND_BUFFER_SIZE);
2289 wapath_val [0] = '.';
2290 wapath_val [1] = ';';
2292 DWORD res = ExpandEnvironmentStrings
2293 (wpath_val, &wapath_val[2], EXPAND_BUFFER_SIZE - 2);
2295 if (!res) wapath_val [0] = _T('\0');
2297 apath_val = alloca (EXPAND_BUFFER_SIZE);
2299 WS2SU (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
2300 return __gnat_locate_exec (exec_name, apath_val);
2305 char *path_val = "/VAXC$PATH";
2307 char *path_val = getenv ("PATH");
2309 if (path_val == NULL) return NULL;
2310 apath_val = (char *) alloca (strlen (path_val) + 1);
2311 strcpy (apath_val, path_val);
2312 return __gnat_locate_exec (exec_name, apath_val);
2318 /* These functions are used to translate to and from VMS and Unix syntax
2319 file, directory and path specifications. */
2322 #define MAXNAMES 256
2323 #define NEW_CANONICAL_FILELIST_INCREMENT 64
2325 static char new_canonical_dirspec [MAXPATH];
2326 static char new_canonical_filespec [MAXPATH];
2327 static char new_canonical_pathspec [MAXNAMES*MAXPATH];
2328 static unsigned new_canonical_filelist_index;
2329 static unsigned new_canonical_filelist_in_use;
2330 static unsigned new_canonical_filelist_allocated;
2331 static char **new_canonical_filelist;
2332 static char new_host_pathspec [MAXNAMES*MAXPATH];
2333 static char new_host_dirspec [MAXPATH];
2334 static char new_host_filespec [MAXPATH];
2336 /* Routine is called repeatedly by decc$from_vms via
2337 __gnat_to_canonical_file_list_init until it returns 0 or the expansion
2341 wildcard_translate_unix (char *name)
2344 char buff [MAXPATH];
2346 strncpy (buff, name, MAXPATH);
2347 buff [MAXPATH - 1] = (char) 0;
2348 ver = strrchr (buff, '.');
2350 /* Chop off the version. */
2354 /* Dynamically extend the allocation by the increment. */
2355 if (new_canonical_filelist_in_use == new_canonical_filelist_allocated)
2357 new_canonical_filelist_allocated += NEW_CANONICAL_FILELIST_INCREMENT;
2358 new_canonical_filelist = (char **) xrealloc
2359 (new_canonical_filelist,
2360 new_canonical_filelist_allocated * sizeof (char *));
2363 new_canonical_filelist[new_canonical_filelist_in_use++] = xstrdup (buff);
2368 /* Translate a wildcard VMS file spec into a list of Unix file specs. First do
2369 full translation and copy the results into a list (_init), then return them
2370 one at a time (_next). If onlydirs set, only expand directory files. */
2373 __gnat_to_canonical_file_list_init (char *filespec, int onlydirs)
2376 char buff [MAXPATH];
2378 len = strlen (filespec);
2379 strncpy (buff, filespec, MAXPATH);
2381 /* Only look for directories */
2382 if (onlydirs && !strstr (&buff [len-5], "*.dir"))
2383 strncat (buff, "*.dir", MAXPATH);
2385 buff [MAXPATH - 1] = (char) 0;
2387 decc$from_vms (buff, wildcard_translate_unix, 1);
2389 /* Remove the .dir extension. */
2395 for (i = 0; i < new_canonical_filelist_in_use; i++)
2397 ext = strstr (new_canonical_filelist[i], ".dir");
2403 return new_canonical_filelist_in_use;
2406 /* Return the next filespec in the list. */
2409 __gnat_to_canonical_file_list_next ()
2411 return new_canonical_filelist[new_canonical_filelist_index++];
2414 /* Free storage used in the wildcard expansion. */
2417 __gnat_to_canonical_file_list_free ()
2421 for (i = 0; i < new_canonical_filelist_in_use; i++)
2422 free (new_canonical_filelist[i]);
2424 free (new_canonical_filelist);
2426 new_canonical_filelist_in_use = 0;
2427 new_canonical_filelist_allocated = 0;
2428 new_canonical_filelist_index = 0;
2429 new_canonical_filelist = 0;
2432 /* The functional equivalent of decc$translate_vms routine.
2433 Designed to produce the same output, but is protected against
2434 malformed paths (original version ACCVIOs in this case) and
2435 does not require VMS-specific DECC RTL */
2437 #define NAM$C_MAXRSS 1024
2440 __gnat_translate_vms (char *src)
2442 static char retbuf [NAM$C_MAXRSS+1];
2443 char *srcendpos, *pos1, *pos2, *retpos;
2444 int disp, path_present = 0;
2446 if (!src) return NULL;
2448 srcendpos = strchr (src, '\0');
2451 /* Look for the node and/or device in front of the path */
2453 pos2 = strchr (pos1, ':');
2455 if (pos2 && (pos2 < srcendpos) && (*(pos2 + 1) == ':')) {
2456 /* There is a node name. "node_name::" becomes "node_name!" */
2458 strncpy (retbuf, pos1, disp);
2459 retpos [disp] = '!';
2460 retpos = retpos + disp + 1;
2462 pos2 = strchr (pos1, ':');
2466 /* There is a device name. "dev_name:" becomes "/dev_name/" */
2469 strncpy (retpos, pos1, disp);
2470 retpos = retpos + disp;
2475 /* No explicit device; we must look ahead and prepend /sys$disk/ if
2476 the path is absolute */
2477 if ((*pos1 == '[' || *pos1 == '<') && (pos1 < srcendpos)
2478 && !strchr (".-]>", *(pos1 + 1))) {
2479 strncpy (retpos, "/sys$disk/", 10);
2483 /* Process the path part */
2484 while (*pos1 == '[' || *pos1 == '<') {
2487 if (*pos1 == ']' || *pos1 == '>') {
2488 /* Special case, [] translates to '.' */
2493 /* '[000000' means root dir. It can be present in the middle of
2494 the path due to expansion of logical devices, in which case
2496 if (!strncmp (pos1, "000000", 6) && path_present > 1 &&
2497 (*(pos1 + 6) == ']' || *(pos1 + 6) == '>' || *(pos1 + 6) == '.')) {
2499 if (*pos1 == '.') pos1++;
2501 else if (*pos1 == '.') {
2506 /* There is a qualified path */
2507 while (*pos1 && *pos1 != ']' && *pos1 != '>') {
2510 /* '.' is used to separate directories. Replace it with '/' but
2511 only if there isn't already '/' just before */
2512 if (*(retpos - 1) != '/') *(retpos++) = '/';
2514 if (pos1 + 1 < srcendpos && *pos1 == '.' && *(pos1 + 1) == '.') {
2515 /* ellipsis refers to entire subtree; replace with '**' */
2516 *(retpos++) = '*'; *(retpos++) = '*'; *(retpos++) = '/';
2521 /* When after '.' '[' '<' is equivalent to Unix ".." but there
2522 may be several in a row */
2523 if (*(pos1 - 1) == '.' || *(pos1 - 1) == '[' ||
2524 *(pos1 - 1) == '<') {
2525 while (*pos1 == '-') {
2527 *(retpos++) = '.'; *(retpos++) = '.'; *(retpos++) = '/';
2532 /* otherwise fall through to default */
2534 *(retpos++) = *(pos1++);
2541 if (pos1 < srcendpos) {
2542 /* Now add the actual file name, until the version suffix if any */
2543 if (path_present) *(retpos++) = '/';
2544 pos2 = strchr (pos1, ';');
2545 disp = pos2? (pos2 - pos1) : (srcendpos - pos1);
2546 strncpy (retpos, pos1, disp);
2548 if (pos2 && pos2 < srcendpos) {
2549 /* There is a non-empty version suffix. ";<ver>" becomes ".<ver>" */
2551 disp = srcendpos - pos2 - 1;
2552 strncpy (retpos, pos2 + 1, disp);
2563 /* Translate a VMS syntax directory specification in to Unix syntax. If
2564 PREFIXFLAG is set, append an underscore "/". If no indicators of VMS syntax
2565 found, return input string. Also translate a dirname that contains no
2566 slashes, in case it's a logical name. */
2569 __gnat_to_canonical_dir_spec (char *dirspec, int prefixflag)
2573 strcpy (new_canonical_dirspec, "");
2574 if (strlen (dirspec))
2578 if (strchr (dirspec, ']') || strchr (dirspec, ':'))
2580 strncpy (new_canonical_dirspec,
2581 __gnat_translate_vms (dirspec),
2584 else if (!strchr (dirspec, '/') && (dirspec1 = getenv (dirspec)) != 0)
2586 strncpy (new_canonical_dirspec,
2587 __gnat_translate_vms (dirspec1),
2592 strncpy (new_canonical_dirspec, dirspec, MAXPATH);
2596 len = strlen (new_canonical_dirspec);
2597 if (prefixflag && new_canonical_dirspec [len-1] != '/')
2598 strncat (new_canonical_dirspec, "/", MAXPATH);
2600 new_canonical_dirspec [MAXPATH - 1] = (char) 0;
2602 return new_canonical_dirspec;
2606 /* Translate a VMS syntax file specification into Unix syntax.
2607 If no indicators of VMS syntax found, check if it's an uppercase
2608 alphanumeric_ name and if so try it out as an environment
2609 variable (logical name). If all else fails return the
2613 __gnat_to_canonical_file_spec (char *filespec)
2617 strncpy (new_canonical_filespec, "", MAXPATH);
2619 if (strchr (filespec, ']') || strchr (filespec, ':'))
2621 char *tspec = (char *) __gnat_translate_vms (filespec);
2623 if (tspec != (char *) -1)
2624 strncpy (new_canonical_filespec, tspec, MAXPATH);
2626 else if ((strlen (filespec) == strspn (filespec,
2627 "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"))
2628 && (filespec1 = getenv (filespec)))
2630 char *tspec = (char *) __gnat_translate_vms (filespec1);
2632 if (tspec != (char *) -1)
2633 strncpy (new_canonical_filespec, tspec, MAXPATH);
2637 strncpy (new_canonical_filespec, filespec, MAXPATH);
2640 new_canonical_filespec [MAXPATH - 1] = (char) 0;
2642 return new_canonical_filespec;
2645 /* Translate a VMS syntax path specification into Unix syntax.
2646 If no indicators of VMS syntax found, return input string. */
2649 __gnat_to_canonical_path_spec (char *pathspec)
2651 char *curr, *next, buff [MAXPATH];
2656 /* If there are /'s, assume it's a Unix path spec and return. */
2657 if (strchr (pathspec, '/'))
2660 new_canonical_pathspec[0] = 0;
2665 next = strchr (curr, ',');
2667 next = strchr (curr, 0);
2669 strncpy (buff, curr, next - curr);
2670 buff[next - curr] = 0;
2672 /* Check for wildcards and expand if present. */
2673 if (strchr (buff, '*') || strchr (buff, '%') || strstr (buff, "..."))
2677 dirs = __gnat_to_canonical_file_list_init (buff, 1);
2678 for (i = 0; i < dirs; i++)
2682 next_dir = __gnat_to_canonical_file_list_next ();
2683 strncat (new_canonical_pathspec, next_dir, MAXPATH);
2685 /* Don't append the separator after the last expansion. */
2687 strncat (new_canonical_pathspec, ":", MAXPATH);
2690 __gnat_to_canonical_file_list_free ();
2693 strncat (new_canonical_pathspec,
2694 __gnat_to_canonical_dir_spec (buff, 0), MAXPATH);
2699 strncat (new_canonical_pathspec, ":", MAXPATH);
2703 new_canonical_pathspec [MAXPATH - 1] = (char) 0;
2705 return new_canonical_pathspec;
2708 static char filename_buff [MAXPATH];
2711 translate_unix (char *name, int type)
2713 strncpy (filename_buff, name, MAXPATH);
2714 filename_buff [MAXPATH - 1] = (char) 0;
2718 /* Translate a Unix syntax path spec into a VMS style (comma separated list of
2722 to_host_path_spec (char *pathspec)
2724 char *curr, *next, buff [MAXPATH];
2729 /* Can't very well test for colons, since that's the Unix separator! */
2730 if (strchr (pathspec, ']') || strchr (pathspec, ','))
2733 new_host_pathspec[0] = 0;
2738 next = strchr (curr, ':');
2740 next = strchr (curr, 0);
2742 strncpy (buff, curr, next - curr);
2743 buff[next - curr] = 0;
2745 strncat (new_host_pathspec, __gnat_to_host_dir_spec (buff, 0), MAXPATH);
2748 strncat (new_host_pathspec, ",", MAXPATH);
2752 new_host_pathspec [MAXPATH - 1] = (char) 0;
2754 return new_host_pathspec;
2757 /* Translate a Unix syntax directory specification into VMS syntax. The
2758 PREFIXFLAG has no effect, but is kept for symmetry with
2759 to_canonical_dir_spec. If indicators of VMS syntax found, return input
2763 __gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
2765 int len = strlen (dirspec);
2767 strncpy (new_host_dirspec, dirspec, MAXPATH);
2768 new_host_dirspec [MAXPATH - 1] = (char) 0;
2770 if (strchr (new_host_dirspec, ']') || strchr (new_host_dirspec, ':'))
2771 return new_host_dirspec;
2773 while (len > 1 && new_host_dirspec[len - 1] == '/')
2775 new_host_dirspec[len - 1] = 0;
2779 decc$to_vms (new_host_dirspec, translate_unix, 1, 2);
2780 strncpy (new_host_dirspec, filename_buff, MAXPATH);
2781 new_host_dirspec [MAXPATH - 1] = (char) 0;
2783 return new_host_dirspec;
2786 /* Translate a Unix syntax file specification into VMS syntax.
2787 If indicators of VMS syntax found, return input string. */
2790 __gnat_to_host_file_spec (char *filespec)
2792 strncpy (new_host_filespec, "", MAXPATH);
2793 if (strchr (filespec, ']') || strchr (filespec, ':'))
2795 strncpy (new_host_filespec, filespec, MAXPATH);
2799 decc$to_vms (filespec, translate_unix, 1, 1);
2800 strncpy (new_host_filespec, filename_buff, MAXPATH);
2803 new_host_filespec [MAXPATH - 1] = (char) 0;
2805 return new_host_filespec;
2809 __gnat_adjust_os_resource_limits ()
2811 SYS$ADJWSL (131072, 0);
2816 /* Dummy functions for Osint import for non-VMS systems. */
2819 __gnat_to_canonical_file_list_init
2820 (char *dirspec ATTRIBUTE_UNUSED, int onlydirs ATTRIBUTE_UNUSED)
2826 __gnat_to_canonical_file_list_next (void)
2832 __gnat_to_canonical_file_list_free (void)
2837 __gnat_to_canonical_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
2843 __gnat_to_canonical_file_spec (char *filespec)
2849 __gnat_to_canonical_path_spec (char *pathspec)
2855 __gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
2861 __gnat_to_host_file_spec (char *filespec)
2867 __gnat_adjust_os_resource_limits (void)
2873 /* For EMX, we cannot include dummy in libgcc, since it is too difficult
2874 to coordinate this with the EMX distribution. Consequently, we put the
2875 definition of dummy which is used for exception handling, here. */
2877 #if defined (__EMX__)
2881 #if defined (__mips_vxworks)
2885 CACHE_USER_FLUSH (0, ENTIRE_CACHE);
2889 #if defined (CROSS_DIRECTORY_STRUCTURE) \
2890 || (! ((defined (sparc) || defined (i386)) && defined (sun) \
2891 && defined (__SVR4)) \
2892 && ! (defined (linux) && (defined (i386) || defined (__x86_64__))) \
2893 && ! (defined (linux) && defined (__ia64__)) \
2894 && ! (defined (linux) && defined (powerpc)) \
2895 && ! defined (__FreeBSD__) \
2896 && ! defined (__hpux__) \
2897 && ! defined (__APPLE__) \
2898 && ! defined (_AIX) \
2899 && ! (defined (__alpha__) && defined (__osf__)) \
2900 && ! defined (VMS) \
2901 && ! defined (__MINGW32__) \
2902 && ! (defined (__mips) && defined (__sgi)))
2904 /* Dummy function to satisfy g-trasym.o. See the preprocessor conditional
2905 just above for a list of native platforms that provide a non-dummy
2906 version of this procedure in libaddr2line.a. */
2909 convert_addresses (const char *file_name ATTRIBUTE_UNUSED,
2910 void *addrs ATTRIBUTE_UNUSED,
2911 int n_addr ATTRIBUTE_UNUSED,
2912 void *buf ATTRIBUTE_UNUSED,
2913 int *len ATTRIBUTE_UNUSED)
2919 #if defined (_WIN32)
2920 int __gnat_argument_needs_quote = 1;
2922 int __gnat_argument_needs_quote = 0;
2925 /* This option is used to enable/disable object files handling from the
2926 binder file by the GNAT Project module. For example, this is disabled on
2927 Windows (prior to GCC 3.4) as it is already done by the mdll module.
2928 Stating with GCC 3.4 the shared libraries are not based on mdll
2929 anymore as it uses the GCC's -shared option */
2930 #if defined (_WIN32) \
2931 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
2932 int __gnat_prj_add_obj_files = 0;
2934 int __gnat_prj_add_obj_files = 1;
2937 /* char used as prefix/suffix for environment variables */
2938 #if defined (_WIN32)
2939 char __gnat_environment_char = '%';
2941 char __gnat_environment_char = '$';
2944 /* This functions copy the file attributes from a source file to a
2947 mode = 0 : In this mode copy only the file time stamps (last access and
2948 last modification time stamps).
2950 mode = 1 : In this mode, time stamps and read/write/execute attributes are
2953 Returns 0 if operation was successful and -1 in case of error. */
2956 __gnat_copy_attribs (char *from, char *to, int mode)
2958 #if defined (VMS) || defined (__vxworks) || defined (__nucleus__)
2962 struct utimbuf tbuf;
2964 if (stat (from, &fbuf) == -1)
2969 tbuf.actime = fbuf.st_atime;
2970 tbuf.modtime = fbuf.st_mtime;
2972 if (utime (to, &tbuf) == -1)
2979 if (chmod (to, fbuf.st_mode) == -1)
2990 __gnat_lseek (int fd, long offset, int whence)
2992 return (int) lseek (fd, offset, whence);
2995 /* This function returns the major version number of GCC being used. */
2997 get_gcc_version (void)
3002 return (int) (version_string[0] - '0');
3007 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED,
3008 int close_on_exec_p ATTRIBUTE_UNUSED)
3010 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
3011 int flags = fcntl (fd, F_GETFD, 0);
3014 if (close_on_exec_p)
3015 flags |= FD_CLOEXEC;
3017 flags &= ~FD_CLOEXEC;
3018 return fcntl (fd, F_SETFD, flags | FD_CLOEXEC);
3021 /* For the Windows case, we should use SetHandleInformation to remove
3022 the HANDLE_INHERIT property from fd. This is not implemented yet,
3023 but for our purposes (support of GNAT.Expect) this does not matter,
3024 as by default handles are *not* inherited. */
3028 /* Indicates if platforms supports automatic initialization through the
3029 constructor mechanism */
3031 __gnat_binder_supports_auto_init ()
3040 /* Indicates that Stand-Alone Libraries are automatically initialized through
3041 the constructor mechanism */
3043 __gnat_sals_init_using_constructors ()
3045 #if defined (__vxworks) || defined (__Lynx__) || defined (VMS)
3054 /* In RTX mode, the procedure to get the time (as file time) is different
3055 in RTSS mode and Win32 mode. In order to avoid duplicating an Ada file,
3056 we introduce an intermediate procedure to link against the corresponding
3057 one in each situation. */
3059 extern void GetTimeAsFileTime(LPFILETIME pTime);
3061 void GetTimeAsFileTime(LPFILETIME pTime)
3064 RtGetRtssTimeAsFileTime (pTime); /* RTSS interface */
3066 GetSystemTimeAsFileTime (pTime); /* w32 interface */
3071 /* Add symbol that is required to link. It would otherwise be taken from
3072 libgcc.a and it would try to use the gcc constructors that are not
3073 supported by Microsoft linker. */
3075 extern void __main (void);
3077 void __main (void) {}
3081 #if defined (linux) || defined(__GLIBC__)
3082 /* pthread affinity support */
3084 int __gnat_pthread_setaffinity_np (pthread_t th,
3086 const void *cpuset);
3089 #include <pthread.h>
3091 __gnat_pthread_setaffinity_np (pthread_t th,
3093 const cpu_set_t *cpuset)
3095 return pthread_setaffinity_np (th, cpusetsize, cpuset);
3099 __gnat_pthread_setaffinity_np (pthread_t th ATTRIBUTE_UNUSED,
3100 size_t cpusetsize ATTRIBUTE_UNUSED,
3101 const void *cpuset ATTRIBUTE_UNUSED)