1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
9 * Copyright (C) 1992-2004, 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, 59 Temple Place - Suite 330, Boston, *
20 * MA 02111-1307, 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 */
68 /* We don't have libiberty, so use malloc. */
69 #define xmalloc(S) malloc (S)
70 #define xrealloc(V,S) realloc (V,S)
78 #include <sys/utime.h>
94 #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
97 /* Header files and definitions for __gnat_set_file_time_name. */
109 /* Use native 64-bit arithmetic. */
110 #define unix_time_to_vms(X,Y) \
111 { unsigned long long reftime, tmptime = (X); \
112 $DESCRIPTOR (unixtime,"1-JAN-1970 0:00:00.00"); \
113 SYS$BINTIM (&unixtime, &reftime); \
114 Y = tmptime * 10000000 + reftime; }
116 /* descrip.h doesn't have everything ... */
117 struct dsc$descriptor_fib
119 unsigned long fib$l_len;
120 struct fibdef *fib$l_addr;
123 /* I/O Status Block. */
126 unsigned short status, count;
127 unsigned long devdep;
130 static char *tryfile;
132 /* Variable length string. */
136 char string[NAM$C_MAXRSS+1];
143 #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
151 #define DIR_SEPARATOR '\\'
156 /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
157 defined in the current system. On DOS-like systems these flags control
158 whether the file is opened/created in text-translation mode (CR/LF in
159 external file mapped to LF in internal file), but in Unix-like systems,
160 no text translation is required, so these flags have no effect. */
162 #if defined (__EMX__)
178 #ifndef HOST_EXECUTABLE_SUFFIX
179 #define HOST_EXECUTABLE_SUFFIX ""
182 #ifndef HOST_OBJECT_SUFFIX
183 #define HOST_OBJECT_SUFFIX ".o"
186 #ifndef PATH_SEPARATOR
187 #define PATH_SEPARATOR ':'
190 #ifndef DIR_SEPARATOR
191 #define DIR_SEPARATOR '/'
194 char __gnat_dir_separator = DIR_SEPARATOR;
196 char __gnat_path_separator = PATH_SEPARATOR;
198 /* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
199 the base filenames that libraries specified with -lsomelib options
200 may have. This is used by GNATMAKE to check whether an executable
201 is up-to-date or not. The syntax is
203 library_template ::= { pattern ; } pattern NUL
204 pattern ::= [ prefix ] * [ postfix ]
206 These should only specify names of static libraries as it makes
207 no sense to determine at link time if dynamic-link libraries are
208 up to date or not. Any libraries that are not found are supposed
211 * if they are needed but not present, the link
214 * otherwise they are libraries in the system paths and so
215 they are considered part of the system and not checked
218 ??? This should be part of a GNAT host-specific compiler
219 file instead of being included in all user applications
220 as well. This is only a temporary work-around for 3.11b. */
222 #ifndef GNAT_LIBRARY_TEMPLATE
223 #if defined (__EMX__)
224 #define GNAT_LIBRARY_TEMPLATE "*.a"
226 #define GNAT_LIBRARY_TEMPLATE "*.olb"
228 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
232 const char *__gnat_library_template = GNAT_LIBRARY_TEMPLATE;
234 /* This variable is used in hostparm.ads to say whether the host is a VMS
237 const int __gnat_vmsp = 1;
239 const int __gnat_vmsp = 0;
243 #define GNAT_MAX_PATH_LEN MAX_PATH
246 #define GNAT_MAX_PATH_LEN 256 /* PATH_MAX */
248 #elif defined (__vxworks) || defined (__OPENNT)
249 #define GNAT_MAX_PATH_LEN PATH_MAX
253 #if defined (__MINGW32__)
257 #include <sys/param.h>
261 #include <sys/param.h>
264 #define GNAT_MAX_PATH_LEN MAXPATHLEN
268 /* The __gnat_max_path_len variable is used to export the maximum
269 length of a path name to Ada code. max_path_len is also provided
270 for compatibility with older GNAT versions, please do not use
273 int __gnat_max_path_len = GNAT_MAX_PATH_LEN;
274 int max_path_len = GNAT_MAX_PATH_LEN;
276 /* The following macro HAVE_READDIR_R should be defined if the
277 system provides the routine readdir_r. */
278 #undef HAVE_READDIR_R
291 time_t time = (time_t) *p_time;
294 /* On Windows systems, the time is sometimes rounded up to the nearest
295 even second, so if the number of seconds is odd, increment it. */
301 res = localtime (&time);
303 res = gmtime (&time);
308 *p_year = res->tm_year;
309 *p_month = res->tm_mon;
310 *p_day = res->tm_mday;
311 *p_hours = res->tm_hour;
312 *p_mins = res->tm_min;
313 *p_secs = res->tm_sec;
316 *p_year = *p_month = *p_day = *p_hours = *p_mins = *p_secs = 0;
319 /* Place the contents of the symbolic link named PATH in the buffer BUF,
320 which has size BUFSIZ. If PATH is a symbolic link, then return the number
321 of characters of its content in BUF. Otherwise, return -1. For Windows,
322 OS/2 and vxworks, always return -1. */
325 __gnat_readlink (char *path ATTRIBUTE_UNUSED,
326 char *buf ATTRIBUTE_UNUSED,
327 size_t bufsiz ATTRIBUTE_UNUSED)
329 #if defined (MSDOS) || defined (_WIN32) || defined (__EMX__)
331 #elif defined (__INTERIX) || defined (VMS)
333 #elif defined (__vxworks)
336 return readlink (path, buf, bufsiz);
340 /* Creates a symbolic link named NEWPATH which contains the string OLDPATH. If
341 NEWPATH exists it will NOT be overwritten. For Windows, OS/2, VxWorks,
342 Interix and VMS, always return -1. */
345 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED,
346 char *newpath ATTRIBUTE_UNUSED)
348 #if defined (MSDOS) || defined (_WIN32) || defined (__EMX__)
350 #elif defined (__INTERIX) || defined (VMS)
352 #elif defined (__vxworks)
355 return symlink (oldpath, newpath);
359 /* Try to lock a file, return 1 if success. */
361 #if defined (__vxworks) || defined (MSDOS) || defined (_WIN32)
363 /* Version that does not use link. */
366 __gnat_try_lock (char *dir, char *file)
371 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
372 fd = open (full_path, O_CREAT | O_EXCL, 0600);
380 #elif defined (__EMX__) || defined (VMS)
382 /* More cases that do not use link; identical code, to solve too long
386 __gnat_try_lock (char *dir, char *file)
391 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
392 fd = open (full_path, O_CREAT | O_EXCL, 0600);
402 /* Version using link(), more secure over NFS. */
403 /* See TN 6913-016 for discussion ??? */
406 __gnat_try_lock (char *dir, char *file)
410 struct stat stat_result;
413 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
414 sprintf (temp_file, "%s-%ld-%ld", dir, (long) getpid(), (long) getppid ());
416 /* Create the temporary file and write the process number. */
417 fd = open (temp_file, O_CREAT | O_WRONLY, 0600);
423 /* Link it with the new file. */
424 link (temp_file, full_path);
426 /* Count the references on the old one. If we have a count of two, then
427 the link did succeed. Remove the temporary file before returning. */
428 __gnat_stat (temp_file, &stat_result);
430 return stat_result.st_nlink == 2;
434 /* Return the maximum file name length. */
437 __gnat_get_maximum_file_name_length (void)
442 if (getenv ("GNAT$EXTENDED_FILE_SPECIFICATIONS"))
451 /* Return nonzero if file names are case sensitive. */
454 __gnat_get_file_names_case_sensitive (void)
456 #if defined (__EMX__) || defined (MSDOS) || defined (VMS) || defined (WINNT)
464 __gnat_get_default_identifier_character_set (void)
466 #if defined (__EMX__) || defined (MSDOS)
473 /* Return the current working directory. */
476 __gnat_get_current_dir (char *dir, int *length)
479 /* Force Unix style, which is what GNAT uses internally. */
480 getcwd (dir, *length, 0);
482 getcwd (dir, *length);
485 *length = strlen (dir);
487 if (dir [*length - 1] != DIR_SEPARATOR)
489 dir [*length] = DIR_SEPARATOR;
495 /* Return the suffix for object files. */
498 __gnat_get_object_suffix_ptr (int *len, const char **value)
500 *value = HOST_OBJECT_SUFFIX;
505 *len = strlen (*value);
510 /* Return the suffix for executable files. */
513 __gnat_get_executable_suffix_ptr (int *len, const char **value)
515 *value = HOST_EXECUTABLE_SUFFIX;
519 *len = strlen (*value);
524 /* Return the suffix for debuggable files. Usually this is the same as the
525 executable extension. */
528 __gnat_get_debuggable_suffix_ptr (int *len, const char **value)
531 *value = HOST_EXECUTABLE_SUFFIX;
533 /* On DOS, the extensionless COFF file is what gdb likes. */
540 *len = strlen (*value);
546 __gnat_open_read (char *path, int fmode)
549 int o_fmode = O_BINARY;
555 /* Optional arguments mbc,deq,fop increase read performance. */
556 fd = open (path, O_RDONLY | o_fmode, 0444,
557 "mbc=16", "deq=64", "fop=tef");
558 #elif defined (__vxworks)
559 fd = open (path, O_RDONLY | o_fmode, 0444);
561 fd = open (path, O_RDONLY | o_fmode);
564 return fd < 0 ? -1 : fd;
567 #if defined (__EMX__) || defined (__MINGW32__)
568 #define PERM (S_IREAD | S_IWRITE)
570 /* Excerpt from DECC C RTL Reference Manual:
571 To create files with OpenVMS RMS default protections using the UNIX
572 system-call functions umask, mkdir, creat, and open, call mkdir, creat,
573 and open with a file-protection mode argument of 0777 in a program
574 that never specifically calls umask. These default protections include
575 correctly establishing protections based on ACLs, previous versions of
579 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
583 __gnat_open_rw (char *path, int fmode)
586 int o_fmode = O_BINARY;
592 fd = open (path, O_RDWR | o_fmode, PERM,
593 "mbc=16", "deq=64", "fop=tef");
595 fd = open (path, O_RDWR | o_fmode, PERM);
598 return fd < 0 ? -1 : fd;
602 __gnat_open_create (char *path, int fmode)
605 int o_fmode = O_BINARY;
611 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM,
612 "mbc=16", "deq=64", "fop=tef");
614 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
617 return fd < 0 ? -1 : fd;
621 __gnat_create_output_file (char *path)
625 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM,
626 "rfm=stmlf", "ctx=rec", "rat=none", "rop=nlk",
627 "shr=del,get,put,upd");
629 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
632 return fd < 0 ? -1 : fd;
636 __gnat_open_append (char *path, int fmode)
639 int o_fmode = O_BINARY;
645 fd = open (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM,
646 "mbc=16", "deq=64", "fop=tef");
648 fd = open (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
651 return fd < 0 ? -1 : fd;
654 /* Open a new file. Return error (-1) if the file already exists. */
657 __gnat_open_new (char *path, int fmode)
660 int o_fmode = O_BINARY;
666 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM,
667 "mbc=16", "deq=64", "fop=tef");
669 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
672 return fd < 0 ? -1 : fd;
675 /* Open a new temp file. Return error (-1) if the file already exists.
676 Special options for VMS allow the file to be shared between parent and child
677 processes, however they really slow down output. Used in gnatchop. */
680 __gnat_open_new_temp (char *path, int fmode)
683 int o_fmode = O_BINARY;
685 strcpy (path, "GNAT-XXXXXX");
687 #if (defined (__FreeBSD__) || defined (linux)) && !defined (__vxworks)
688 return mkstemp (path);
689 #elif defined (__Lynx__)
692 if (mktemp (path) == NULL)
700 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM,
701 "rfm=stmlf", "ctx=rec", "rat=none", "shr=del,get,put,upd",
702 "mbc=16", "deq=64", "fop=tef");
704 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
707 return fd < 0 ? -1 : fd;
710 /* Return the number of bytes in the specified file. */
713 __gnat_file_length (int fd)
718 ret = fstat (fd, &statbuf);
719 if (ret || !S_ISREG (statbuf.st_mode))
722 return (statbuf.st_size);
725 /* Return the number of bytes in the specified named file. */
728 __gnat_named_file_length (char *name)
733 ret = __gnat_stat (name, &statbuf);
734 if (ret || !S_ISREG (statbuf.st_mode))
737 return (statbuf.st_size);
740 /* Create a temporary filename and put it in string pointed to by
744 __gnat_tmp_name (char *tmp_filename)
750 /* tempnam tries to create a temporary file in directory pointed to by
751 TMP environment variable, in c:\temp if TMP is not set, and in
752 directory specified by P_tmpdir in stdio.h if c:\temp does not
753 exist. The filename will be created with the prefix "gnat-". */
755 pname = (char *) tempnam ("c:\\temp", "gnat-");
757 /* if pname is NULL, the file was not created properly, the disk is full
758 or there is no more free temporary files */
761 *tmp_filename = '\0';
763 /* If pname start with a back slash and not path information it means that
764 the filename is valid for the current working directory. */
766 else if (pname[0] == '\\')
768 strcpy (tmp_filename, ".\\");
769 strcat (tmp_filename, pname+1);
772 strcpy (tmp_filename, pname);
777 #elif defined (linux) || defined (__FreeBSD__)
778 #define MAX_SAFE_PATH 1000
779 char *tmpdir = getenv ("TMPDIR");
781 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
782 a buffer overflow. */
783 if (tmpdir == NULL || strlen (tmpdir) > MAX_SAFE_PATH)
784 strcpy (tmp_filename, "/tmp/gnat-XXXXXX");
786 sprintf (tmp_filename, "%s/gnat-XXXXXX", tmpdir);
788 close (mkstemp(tmp_filename));
790 tmpnam (tmp_filename);
794 /* Read the next entry in a directory. The returned string points somewhere
798 __gnat_readdir (DIR *dirp, char *buffer)
800 /* If possible, try to use the thread-safe version. */
801 #ifdef HAVE_READDIR_R
802 if (readdir_r (dirp, buffer) != NULL)
803 return ((struct dirent*) buffer)->d_name;
808 struct dirent *dirent = readdir (dirp);
812 strcpy (buffer, dirent->d_name);
821 /* Returns 1 if readdir is thread safe, 0 otherwise. */
824 __gnat_readdir_is_thread_safe (void)
826 #ifdef HAVE_READDIR_R
834 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
835 static const unsigned long long w32_epoch_offset = 11644473600ULL;
837 /* Returns the file modification timestamp using Win32 routines which are
838 immune against daylight saving time change. It is in fact not possible to
839 use fstat for this purpose as the DST modify the st_mtime field of the
843 win32_filetime (HANDLE h)
848 unsigned long long ull_time;
851 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
852 since <Jan 1st 1601>. This function must return the number of seconds
853 since <Jan 1st 1970>. */
855 if (GetFileTime (h, NULL, NULL, &t_write.ft_time))
856 return (time_t) (t_write.ull_time / 10000000ULL
862 /* Return a GNAT time stamp given a file name. */
865 __gnat_file_time_name (char *name)
868 #if defined (__EMX__) || defined (MSDOS)
869 int fd = open (name, O_RDONLY | O_BINARY);
870 time_t ret = __gnat_file_time_fd (fd);
874 #elif defined (_WIN32)
876 HANDLE h = CreateFile (name, GENERIC_READ, FILE_SHARE_READ, 0,
877 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
879 if (h != INVALID_HANDLE_VALUE)
881 ret = win32_filetime (h);
887 (void) __gnat_stat (name, &statbuf);
889 /* VMS has file versioning. */
890 return statbuf.st_ctime;
892 return statbuf.st_mtime;
897 /* Return a GNAT time stamp given a file descriptor. */
900 __gnat_file_time_fd (int fd)
902 /* The following workaround code is due to the fact that under EMX and
903 DJGPP fstat attempts to convert time values to GMT rather than keep the
904 actual OS timestamp of the file. By using the OS2/DOS functions directly
905 the GNAT timestamp are independent of this behavior, which is desired to
906 facilitate the distribution of GNAT compiled libraries. */
908 #if defined (__EMX__) || defined (MSDOS)
912 int ret = DosQueryFileInfo (fd, 1, (unsigned char *) &fs,
913 sizeof (FILESTATUS));
915 unsigned file_year = fs.fdateLastWrite.year;
916 unsigned file_month = fs.fdateLastWrite.month;
917 unsigned file_day = fs.fdateLastWrite.day;
918 unsigned file_hour = fs.ftimeLastWrite.hours;
919 unsigned file_min = fs.ftimeLastWrite.minutes;
920 unsigned file_tsec = fs.ftimeLastWrite.twosecs;
924 int ret = getftime (fd, &fs);
926 unsigned file_year = fs.ft_year;
927 unsigned file_month = fs.ft_month;
928 unsigned file_day = fs.ft_day;
929 unsigned file_hour = fs.ft_hour;
930 unsigned file_min = fs.ft_min;
931 unsigned file_tsec = fs.ft_tsec;
934 /* Calculate the seconds since epoch from the time components. First count
935 the whole days passed. The value for years returned by the DOS and OS2
936 functions count years from 1980, so to compensate for the UNIX epoch which
937 begins in 1970 start with 10 years worth of days and add days for each
938 four year period since then. */
941 int cum_days[12] = {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
942 int days_passed = 3652 + (file_year / 4) * 1461;
943 int years_since_leap = file_year % 4;
945 if (years_since_leap == 1)
947 else if (years_since_leap == 2)
949 else if (years_since_leap == 3)
955 days_passed += cum_days[file_month - 1];
956 if (years_since_leap == 0 && file_year != 20 && file_month > 2)
959 days_passed += file_day - 1;
961 /* OK - have whole days. Multiply -- then add in other parts. */
963 tot_secs = days_passed * 86400;
964 tot_secs += file_hour * 3600;
965 tot_secs += file_min * 60;
966 tot_secs += file_tsec * 2;
969 #elif defined (_WIN32)
970 HANDLE h = (HANDLE) _get_osfhandle (fd);
971 time_t ret = win32_filetime (h);
977 (void) fstat (fd, &statbuf);
980 /* VMS has file versioning. */
981 return statbuf.st_ctime;
983 return statbuf.st_mtime;
988 /* Set the file time stamp. */
991 __gnat_set_file_time_name (char *name, time_t time_stamp)
993 #if defined (__EMX__) || defined (MSDOS) || defined (__vxworks)
995 /* Code to implement __gnat_set_file_time_name for these systems. */
997 #elif defined (_WIN32)
1001 unsigned long long ull_time;
1004 HANDLE h = CreateFile (name, GENERIC_WRITE, FILE_SHARE_WRITE, NULL,
1005 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS,
1007 if (h == INVALID_HANDLE_VALUE)
1009 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1010 t_write.ull_time = ((unsigned long long)time_stamp + w32_epoch_offset);
1011 /* Convert to 100 nanosecond units */
1012 t_write.ull_time *= 10000000ULL;
1014 SetFileTime(h, NULL, NULL, &t_write.ft_time);
1024 unsigned long long backup, create, expire, revise;
1028 unsigned short value;
1031 unsigned system : 4;
1037 } Fat = { 0, 0, 0, 0, 0, { 0 }};
1041 { ATR$S_CREDATE, ATR$C_CREDATE, &Fat.create },
1042 { ATR$S_REVDATE, ATR$C_REVDATE, &Fat.revise },
1043 { ATR$S_EXPDATE, ATR$C_EXPDATE, &Fat.expire },
1044 { ATR$S_BAKDATE, ATR$C_BAKDATE, &Fat.backup },
1045 { ATR$S_FPRO, ATR$C_FPRO, &Fat.prot },
1046 { ATR$S_UIC, ATR$C_UIC, &Fat.uic },
1051 struct dsc$descriptor_fib fibdsc = {sizeof (fib), (void *) &fib};
1055 unsigned long long newtime;
1056 unsigned long long revtime;
1060 struct vstring file;
1061 struct dsc$descriptor_s filedsc
1062 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) file.string};
1063 struct vstring device;
1064 struct dsc$descriptor_s devicedsc
1065 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) device.string};
1066 struct vstring timev;
1067 struct dsc$descriptor_s timedsc
1068 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) timev.string};
1069 struct vstring result;
1070 struct dsc$descriptor_s resultdsc
1071 = {NAM$C_MAXRSS, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, (void *) result.string};
1073 tryfile = (char *) __gnat_to_host_dir_spec (name, 0);
1075 /* Allocate and initialize a FAB and NAM structures. */
1079 nam.nam$l_esa = file.string;
1080 nam.nam$b_ess = NAM$C_MAXRSS;
1081 nam.nam$l_rsa = result.string;
1082 nam.nam$b_rss = NAM$C_MAXRSS;
1083 fab.fab$l_fna = tryfile;
1084 fab.fab$b_fns = strlen (tryfile);
1085 fab.fab$l_nam = &nam;
1087 /* Validate filespec syntax and device existence. */
1088 status = SYS$PARSE (&fab, 0, 0);
1089 if ((status & 1) != 1)
1090 LIB$SIGNAL (status);
1092 file.string[nam.nam$b_esl] = 0;
1094 /* Find matching filespec. */
1095 status = SYS$SEARCH (&fab, 0, 0);
1096 if ((status & 1) != 1)
1097 LIB$SIGNAL (status);
1099 file.string[nam.nam$b_esl] = 0;
1100 result.string[result.length=nam.nam$b_rsl] = 0;
1102 /* Get the device name and assign an IO channel. */
1103 strncpy (device.string, nam.nam$l_dev, nam.nam$b_dev);
1104 devicedsc.dsc$w_length = nam.nam$b_dev;
1106 status = SYS$ASSIGN (&devicedsc, &chan, 0, 0, 0);
1107 if ((status & 1) != 1)
1108 LIB$SIGNAL (status);
1110 /* Initialize the FIB and fill in the directory id field. */
1111 memset (&fib, 0, sizeof (fib));
1112 fib.fib$w_did[0] = nam.nam$w_did[0];
1113 fib.fib$w_did[1] = nam.nam$w_did[1];
1114 fib.fib$w_did[2] = nam.nam$w_did[2];
1115 fib.fib$l_acctl = 0;
1117 strcpy (file.string, (strrchr (result.string, ']') + 1));
1118 filedsc.dsc$w_length = strlen (file.string);
1119 result.string[result.length = 0] = 0;
1121 /* Open and close the file to fill in the attributes. */
1123 = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
1124 &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
1125 if ((status & 1) != 1)
1126 LIB$SIGNAL (status);
1127 if ((iosb.status & 1) != 1)
1128 LIB$SIGNAL (iosb.status);
1130 result.string[result.length] = 0;
1131 status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0, &fibdsc, 0, 0, 0,
1133 if ((status & 1) != 1)
1134 LIB$SIGNAL (status);
1135 if ((iosb.status & 1) != 1)
1136 LIB$SIGNAL (iosb.status);
1141 /* Set creation time to requested time. */
1142 unix_time_to_vms (time_stamp, newtime);
1144 t = time ((time_t) 0);
1146 /* Set revision time to now in local time. */
1147 unix_time_to_vms (t, revtime);
1150 /* Reopen the file, modify the times and then close. */
1151 fib.fib$l_acctl = FIB$M_WRITE;
1153 = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
1154 &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
1155 if ((status & 1) != 1)
1156 LIB$SIGNAL (status);
1157 if ((iosb.status & 1) != 1)
1158 LIB$SIGNAL (iosb.status);
1160 Fat.create = newtime;
1161 Fat.revise = revtime;
1163 status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0,
1164 &fibdsc, 0, 0, 0, &atrlst, 0);
1165 if ((status & 1) != 1)
1166 LIB$SIGNAL (status);
1167 if ((iosb.status & 1) != 1)
1168 LIB$SIGNAL (iosb.status);
1170 /* Deassign the channel and exit. */
1171 status = SYS$DASSGN (chan);
1172 if ((status & 1) != 1)
1173 LIB$SIGNAL (status);
1175 struct utimbuf utimbuf;
1178 /* Set modification time to requested time. */
1179 utimbuf.modtime = time_stamp;
1181 /* Set access time to now in local time. */
1182 t = time ((time_t) 0);
1183 utimbuf.actime = mktime (localtime (&t));
1185 utime (name, &utimbuf);
1190 __gnat_get_env_value_ptr (char *name, int *len, char **value)
1192 *value = getenv (name);
1196 *len = strlen (*value);
1201 /* VMS specific declarations for set_env_value. */
1205 static char *to_host_path_spec (char *);
1209 unsigned short len, mbz;
1213 typedef struct _ile3
1215 unsigned short len, code;
1217 unsigned short *retlen_adr;
1223 __gnat_set_env_value (char *name, char *value)
1228 struct descriptor_s name_desc;
1229 /* Put in JOB table for now, so that the project stuff at least works. */
1230 struct descriptor_s table_desc = {7, 0, "LNM$JOB"};
1231 char *host_pathspec = value;
1232 char *copy_pathspec;
1233 int num_dirs_in_pathspec = 1;
1237 name_desc.len = strlen (name);
1239 name_desc.adr = name;
1241 if (*host_pathspec == 0)
1244 status = LIB$DELETE_LOGICAL (&name_desc, &table_desc);
1245 /* no need to check status; if the logical name is not
1246 defined, that's fine. */
1250 ptr = host_pathspec;
1253 num_dirs_in_pathspec++;
1257 ile_s *ile_array = alloca (sizeof (ile_s) * (num_dirs_in_pathspec + 1));
1258 char *copy_pathspec = alloca (strlen (host_pathspec) + 1);
1261 strcpy (copy_pathspec, host_pathspec);
1262 curr = copy_pathspec;
1263 for (i = 0; i < num_dirs_in_pathspec; i++)
1265 next = strchr (curr, ',');
1267 next = strchr (curr, 0);
1270 ile_array[i].len = strlen (curr);
1272 /* Code 2 from lnmdef.h means its a string. */
1273 ile_array[i].code = 2;
1274 ile_array[i].adr = curr;
1276 /* retlen_adr is ignored. */
1277 ile_array[i].retlen_adr = 0;
1281 /* Terminating item must be zero. */
1282 ile_array[i].len = 0;
1283 ile_array[i].code = 0;
1284 ile_array[i].adr = 0;
1285 ile_array[i].retlen_adr = 0;
1287 status = LIB$SET_LOGICAL (&name_desc, 0, &table_desc, 0, ile_array);
1288 if ((status & 1) != 1)
1289 LIB$SIGNAL (status);
1293 int size = strlen (name) + strlen (value) + 2;
1296 expression = (char *) xmalloc (size * sizeof (char));
1298 sprintf (expression, "%s=%s", name, value);
1299 putenv (expression);
1304 #include <windows.h>
1307 /* Get the list of installed standard libraries from the
1308 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1312 __gnat_get_libraries_from_registry (void)
1314 char *result = (char *) "";
1316 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_COMPILE)
1319 DWORD name_size, value_size;
1326 /* First open the key. */
1327 res = RegOpenKeyExA (HKEY_LOCAL_MACHINE, "SOFTWARE", 0, KEY_READ, ®_key);
1329 if (res == ERROR_SUCCESS)
1330 res = RegOpenKeyExA (reg_key, "Ada Core Technologies", 0,
1331 KEY_READ, ®_key);
1333 if (res == ERROR_SUCCESS)
1334 res = RegOpenKeyExA (reg_key, "GNAT", 0, KEY_READ, ®_key);
1336 if (res == ERROR_SUCCESS)
1337 res = RegOpenKeyExA (reg_key, "Standard Libraries", 0, KEY_READ, ®_key);
1339 /* If the key exists, read out all the values in it and concatenate them
1341 for (index = 0; res == ERROR_SUCCESS; index++)
1343 value_size = name_size = 256;
1344 res = RegEnumValue (reg_key, index, name, &name_size, 0,
1345 &type, value, &value_size);
1347 if (res == ERROR_SUCCESS && type == REG_SZ)
1349 char *old_result = result;
1351 result = (char *) xmalloc (strlen (old_result) + value_size + 2);
1352 strcpy (result, old_result);
1353 strcat (result, value);
1354 strcat (result, ";");
1358 /* Remove the trailing ";". */
1360 result[strlen (result) - 1] = 0;
1367 __gnat_stat (char *name, struct stat *statbuf)
1370 /* Under Windows the directory name for the stat function must not be
1371 terminated by a directory separator except if just after a drive name. */
1372 int name_len = strlen (name);
1373 char last_char = name[name_len - 1];
1374 char win32_name[GNAT_MAX_PATH_LEN + 2];
1376 if (name_len > GNAT_MAX_PATH_LEN)
1379 strcpy (win32_name, name);
1381 while (name_len > 1 && (last_char == '\\' || last_char == '/'))
1383 win32_name[name_len - 1] = '\0';
1385 last_char = win32_name[name_len - 1];
1388 if (name_len == 2 && win32_name[1] == ':')
1389 strcat (win32_name, "\\");
1391 return stat (win32_name, statbuf);
1394 return stat (name, statbuf);
1399 __gnat_file_exists (char *name)
1401 struct stat statbuf;
1403 return !__gnat_stat (name, &statbuf);
1407 __gnat_is_absolute_path (char *name)
1409 return (*name == '/' || *name == DIR_SEPARATOR
1410 #if defined (__EMX__) || defined (MSDOS) || defined (WINNT)
1411 || (strlen (name) > 1 && isalpha (name[0]) && name[1] == ':')
1417 __gnat_is_regular_file (char *name)
1420 struct stat statbuf;
1422 ret = __gnat_stat (name, &statbuf);
1423 return (!ret && S_ISREG (statbuf.st_mode));
1427 __gnat_is_directory (char *name)
1430 struct stat statbuf;
1432 ret = __gnat_stat (name, &statbuf);
1433 return (!ret && S_ISDIR (statbuf.st_mode));
1437 __gnat_is_readable_file (char *name)
1441 struct stat statbuf;
1443 ret = __gnat_stat (name, &statbuf);
1444 mode = statbuf.st_mode & S_IRUSR;
1445 return (!ret && mode);
1449 __gnat_is_writable_file (char *name)
1453 struct stat statbuf;
1455 ret = __gnat_stat (name, &statbuf);
1456 mode = statbuf.st_mode & S_IWUSR;
1457 return (!ret && mode);
1461 __gnat_set_writable (char *name)
1464 struct stat statbuf;
1466 if (stat (name, &statbuf) == 0)
1468 statbuf.st_mode = statbuf.st_mode | S_IWUSR;
1469 chmod (name, statbuf.st_mode);
1475 __gnat_set_readonly (char *name)
1478 struct stat statbuf;
1480 if (stat (name, &statbuf) == 0)
1482 statbuf.st_mode = statbuf.st_mode & 07577;
1483 chmod (name, statbuf.st_mode);
1489 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
1491 #if defined (__vxworks)
1494 #elif defined (_AIX) || defined (unix)
1496 struct stat statbuf;
1498 ret = lstat (name, &statbuf);
1499 return (!ret && S_ISLNK (statbuf.st_mode));
1507 /* Defined in VMS header files. */
1508 #if defined (__ALPHA)
1509 #define fork() (decc$$alloc_vfork_blocks() >= 0 ? \
1510 LIB$GET_CURRENT_INVO_CONTEXT (decc$$get_vfork_jmpbuf()) : -1)
1511 #elif defined (__IA64)
1512 #define fork() (decc$$alloc_vfork_blocks() >= 0 ? \
1513 LIB$I64_GET_CURR_INVO_CONTEXT(decc$$get_vfork_jmpbuf()) : -1)
1517 #if defined (sun) && defined (__SVR4)
1518 /* Using fork on Solaris will duplicate all the threads. fork1, which
1519 duplicates only the active thread, must be used instead, or spawning
1520 subprocess from a program with tasking will lead into numerous problems. */
1525 __gnat_portable_spawn (char *args[])
1528 int finished ATTRIBUTE_UNUSED;
1529 int pid ATTRIBUTE_UNUSED;
1531 #if defined (MSDOS) || defined (_WIN32)
1532 status = spawnvp (P_WAIT, args[0],(const char* const*)args);
1538 #elif defined (__vxworks)
1543 pid = spawnvp (P_NOWAIT, args[0], args);
1555 if (execv (args[0], args) != 0)
1557 return -1; /* execv is in parent context on VMS. */
1565 finished = waitpid (pid, &status, 0);
1567 if (finished != pid || WIFEXITED (status) == 0)
1570 return WEXITSTATUS (status);
1576 /* WIN32 code to implement a wait call that wait for any child process. */
1580 /* Synchronization code, to be thread safe. */
1582 static CRITICAL_SECTION plist_cs;
1585 __gnat_plist_init (void)
1587 InitializeCriticalSection (&plist_cs);
1593 EnterCriticalSection (&plist_cs);
1599 LeaveCriticalSection (&plist_cs);
1602 typedef struct _process_list
1605 struct _process_list *next;
1608 static Process_List *PLIST = NULL;
1610 static int plist_length = 0;
1613 add_handle (HANDLE h)
1617 pl = (Process_List *) xmalloc (sizeof (Process_List));
1621 /* -------------------- critical section -------------------- */
1626 /* -------------------- critical section -------------------- */
1632 remove_handle (HANDLE h)
1635 Process_List *prev = NULL;
1639 /* -------------------- critical section -------------------- */
1648 prev->next = pl->next;
1660 /* -------------------- critical section -------------------- */
1666 win32_no_block_spawn (char *command, char *args[])
1670 PROCESS_INFORMATION PI;
1671 SECURITY_ATTRIBUTES SA;
1676 /* compute the total command line length */
1680 csize += strlen (args[k]) + 1;
1684 full_command = (char *) xmalloc (csize);
1687 SI.cb = sizeof (STARTUPINFO);
1688 SI.lpReserved = NULL;
1689 SI.lpReserved2 = NULL;
1690 SI.lpDesktop = NULL;
1694 SI.wShowWindow = SW_HIDE;
1696 /* Security attributes. */
1697 SA.nLength = sizeof (SECURITY_ATTRIBUTES);
1698 SA.bInheritHandle = TRUE;
1699 SA.lpSecurityDescriptor = NULL;
1701 /* Prepare the command string. */
1702 strcpy (full_command, command);
1703 strcat (full_command, " ");
1708 strcat (full_command, args[k]);
1709 strcat (full_command, " ");
1713 result = CreateProcess (NULL, (char *) full_command, &SA, NULL, TRUE,
1714 NORMAL_PRIORITY_CLASS, NULL, NULL, &SI, &PI);
1716 free (full_command);
1720 add_handle (PI.hProcess);
1721 CloseHandle (PI.hThread);
1722 return (int) PI.hProcess;
1729 win32_wait (int *status)
1738 if (plist_length == 0)
1744 hl = (HANDLE *) xmalloc (sizeof (HANDLE) * plist_length);
1749 /* -------------------- critical section -------------------- */
1756 /* -------------------- critical section -------------------- */
1760 res = WaitForMultipleObjects (plist_length, hl, FALSE, INFINITE);
1761 h = hl[res - WAIT_OBJECT_0];
1766 GetExitCodeProcess (h, &exitcode);
1769 *status = (int) exitcode;
1776 __gnat_portable_no_block_spawn (char *args[])
1780 #if defined (__EMX__) || defined (MSDOS)
1782 /* ??? For PC machines I (Franco) don't know the system calls to implement
1783 this routine. So I'll fake it as follows. This routine will behave
1784 exactly like the blocking portable_spawn and will systematically return
1785 a pid of 0 unless the spawned task did not complete successfully, in
1786 which case we return a pid of -1. To synchronize with this the
1787 portable_wait below systematically returns a pid of 0 and reports that
1788 the subprocess terminated successfully. */
1790 if (spawnvp (P_WAIT, args[0], args) != 0)
1793 #elif defined (_WIN32)
1795 pid = win32_no_block_spawn (args[0], args);
1798 #elif defined (__vxworks)
1807 if (execv (args[0], args) != 0)
1809 return -1; /* execv is in parent context on VMS. */
1821 __gnat_portable_wait (int *process_status)
1826 #if defined (_WIN32)
1828 pid = win32_wait (&status);
1830 #elif defined (__EMX__) || defined (MSDOS)
1831 /* ??? See corresponding comment in portable_no_block_spawn. */
1833 #elif defined (__vxworks)
1834 /* Not sure what to do here, so do same as __EMX__ case, i.e., nothing but
1838 pid = waitpid (-1, &status, 0);
1839 status = status & 0xffff;
1842 *process_status = status;
1847 __gnat_waitpid (int pid)
1851 #if defined (_WIN32)
1852 cwait (&status, pid, _WAIT_CHILD);
1853 #elif defined (__EMX__) || defined (MSDOS) || defined (__vxworks)
1854 /* Status is already zero, so nothing to do. */
1856 waitpid (pid, &status, 0);
1857 status = WEXITSTATUS (status);
1864 __gnat_os_exit (int status)
1869 /* Locate a regular file, give a Path value. */
1872 __gnat_locate_regular_file (char *file_name, char *path_val)
1875 int absolute = __gnat_is_absolute_path (file_name);
1877 /* Handle absolute pathnames. */
1880 if (__gnat_is_regular_file (file_name))
1881 return xstrdup (file_name);
1886 /* If file_name include directory separator(s), try it first as
1887 a path name relative to the current directory */
1888 for (ptr = file_name; *ptr && *ptr != '/' && *ptr != DIR_SEPARATOR; ptr++)
1893 if (__gnat_is_regular_file (file_name))
1894 return xstrdup (file_name);
1901 /* The result has to be smaller than path_val + file_name. */
1902 char *file_path = alloca (strlen (path_val) + strlen (file_name) + 2);
1906 for (; *path_val == PATH_SEPARATOR; path_val++)
1912 for (ptr = file_path; *path_val && *path_val != PATH_SEPARATOR; )
1913 *ptr++ = *path_val++;
1916 if (*ptr != '/' && *ptr != DIR_SEPARATOR)
1917 *++ptr = DIR_SEPARATOR;
1919 strcpy (++ptr, file_name);
1921 if (__gnat_is_regular_file (file_path))
1922 return xstrdup (file_path);
1929 /* Locate an executable given a Path argument. This routine is only used by
1930 gnatbl and should not be used otherwise. Use locate_exec_on_path
1934 __gnat_locate_exec (char *exec_name, char *path_val)
1936 if (!strstr (exec_name, HOST_EXECUTABLE_SUFFIX))
1938 char *full_exec_name
1939 = alloca (strlen (exec_name) + strlen (HOST_EXECUTABLE_SUFFIX) + 1);
1941 strcpy (full_exec_name, exec_name);
1942 strcat (full_exec_name, HOST_EXECUTABLE_SUFFIX);
1943 return __gnat_locate_regular_file (full_exec_name, path_val);
1946 return __gnat_locate_regular_file (exec_name, path_val);
1949 /* Locate an executable using the Systems default PATH. */
1952 __gnat_locate_exec_on_path (char *exec_name)
1956 char *path_val = "/VAXC$PATH";
1958 char *path_val = getenv ("PATH");
1961 /* In Win32 systems we expand the PATH as for XP environment
1962 variables are not automatically expanded. */
1963 int len = strlen (path_val) * 3;
1964 char *expanded_path_val = alloca (len + 1);
1966 DWORD res = ExpandEnvironmentStrings (path_val, expanded_path_val, len);
1970 path_val = expanded_path_val;
1974 apath_val = alloca (strlen (path_val) + 1);
1975 strcpy (apath_val, path_val);
1977 return __gnat_locate_exec (exec_name, apath_val);
1982 /* These functions are used to translate to and from VMS and Unix syntax
1983 file, directory and path specifications. */
1986 #define MAXNAMES 256
1987 #define NEW_CANONICAL_FILELIST_INCREMENT 64
1989 static char new_canonical_dirspec [MAXPATH];
1990 static char new_canonical_filespec [MAXPATH];
1991 static char new_canonical_pathspec [MAXNAMES*MAXPATH];
1992 static unsigned new_canonical_filelist_index;
1993 static unsigned new_canonical_filelist_in_use;
1994 static unsigned new_canonical_filelist_allocated;
1995 static char **new_canonical_filelist;
1996 static char new_host_pathspec [MAXNAMES*MAXPATH];
1997 static char new_host_dirspec [MAXPATH];
1998 static char new_host_filespec [MAXPATH];
2000 /* Routine is called repeatedly by decc$from_vms via
2001 __gnat_to_canonical_file_list_init until it returns 0 or the expansion
2005 wildcard_translate_unix (char *name)
2008 char buff [MAXPATH];
2010 strncpy (buff, name, MAXPATH);
2011 buff [MAXPATH - 1] = (char) 0;
2012 ver = strrchr (buff, '.');
2014 /* Chop off the version. */
2018 /* Dynamically extend the allocation by the increment. */
2019 if (new_canonical_filelist_in_use == new_canonical_filelist_allocated)
2021 new_canonical_filelist_allocated += NEW_CANONICAL_FILELIST_INCREMENT;
2022 new_canonical_filelist = (char **) xrealloc
2023 (new_canonical_filelist,
2024 new_canonical_filelist_allocated * sizeof (char *));
2027 new_canonical_filelist[new_canonical_filelist_in_use++] = xstrdup (buff);
2032 /* Translate a wildcard VMS file spec into a list of Unix file specs. First do
2033 full translation and copy the results into a list (_init), then return them
2034 one at a time (_next). If onlydirs set, only expand directory files. */
2037 __gnat_to_canonical_file_list_init (char *filespec, int onlydirs)
2040 char buff [MAXPATH];
2042 len = strlen (filespec);
2043 strncpy (buff, filespec, MAXPATH);
2045 /* Only look for directories */
2046 if (onlydirs && !strstr (&buff [len-5], "*.dir"))
2047 strncat (buff, "*.dir", MAXPATH);
2049 buff [MAXPATH - 1] = (char) 0;
2051 decc$from_vms (buff, wildcard_translate_unix, 1);
2053 /* Remove the .dir extension. */
2059 for (i = 0; i < new_canonical_filelist_in_use; i++)
2061 ext = strstr (new_canonical_filelist[i], ".dir");
2067 return new_canonical_filelist_in_use;
2070 /* Return the next filespec in the list. */
2073 __gnat_to_canonical_file_list_next ()
2075 return new_canonical_filelist[new_canonical_filelist_index++];
2078 /* Free storage used in the wildcard expansion. */
2081 __gnat_to_canonical_file_list_free ()
2085 for (i = 0; i < new_canonical_filelist_in_use; i++)
2086 free (new_canonical_filelist[i]);
2088 free (new_canonical_filelist);
2090 new_canonical_filelist_in_use = 0;
2091 new_canonical_filelist_allocated = 0;
2092 new_canonical_filelist_index = 0;
2093 new_canonical_filelist = 0;
2096 /* Translate a VMS syntax directory specification in to Unix syntax. If
2097 PREFIXFLAG is set, append an underscore "/". If no indicators of VMS syntax
2098 found, return input string. Also translate a dirname that contains no
2099 slashes, in case it's a logical name. */
2102 __gnat_to_canonical_dir_spec (char *dirspec, int prefixflag)
2106 strcpy (new_canonical_dirspec, "");
2107 if (strlen (dirspec))
2111 if (strchr (dirspec, ']') || strchr (dirspec, ':'))
2113 strncpy (new_canonical_dirspec,
2114 (char *) decc$translate_vms (dirspec),
2117 else if (!strchr (dirspec, '/') && (dirspec1 = getenv (dirspec)) != 0)
2119 strncpy (new_canonical_dirspec,
2120 (char *) decc$translate_vms (dirspec1),
2125 strncpy (new_canonical_dirspec, dirspec, MAXPATH);
2129 len = strlen (new_canonical_dirspec);
2130 if (prefixflag && new_canonical_dirspec [len-1] != '/')
2131 strncat (new_canonical_dirspec, "/", MAXPATH);
2133 new_canonical_dirspec [MAXPATH - 1] = (char) 0;
2135 return new_canonical_dirspec;
2139 /* Translate a VMS syntax file specification into Unix syntax.
2140 If no indicators of VMS syntax found, return input string. */
2143 __gnat_to_canonical_file_spec (char *filespec)
2145 strncpy (new_canonical_filespec, "", MAXPATH);
2147 if (strchr (filespec, ']') || strchr (filespec, ':'))
2149 strncpy (new_canonical_filespec,
2150 (char *) decc$translate_vms (filespec),
2155 strncpy (new_canonical_filespec, filespec, MAXPATH);
2158 new_canonical_filespec [MAXPATH - 1] = (char) 0;
2160 return new_canonical_filespec;
2163 /* Translate a VMS syntax path specification into Unix syntax.
2164 If no indicators of VMS syntax found, return input string. */
2167 __gnat_to_canonical_path_spec (char *pathspec)
2169 char *curr, *next, buff [MAXPATH];
2174 /* If there are /'s, assume it's a Unix path spec and return. */
2175 if (strchr (pathspec, '/'))
2178 new_canonical_pathspec[0] = 0;
2183 next = strchr (curr, ',');
2185 next = strchr (curr, 0);
2187 strncpy (buff, curr, next - curr);
2188 buff[next - curr] = 0;
2190 /* Check for wildcards and expand if present. */
2191 if (strchr (buff, '*') || strchr (buff, '%') || strstr (buff, "..."))
2195 dirs = __gnat_to_canonical_file_list_init (buff, 1);
2196 for (i = 0; i < dirs; i++)
2200 next_dir = __gnat_to_canonical_file_list_next ();
2201 strncat (new_canonical_pathspec, next_dir, MAXPATH);
2203 /* Don't append the separator after the last expansion. */
2205 strncat (new_canonical_pathspec, ":", MAXPATH);
2208 __gnat_to_canonical_file_list_free ();
2211 strncat (new_canonical_pathspec,
2212 __gnat_to_canonical_dir_spec (buff, 0), MAXPATH);
2217 strncat (new_canonical_pathspec, ":", MAXPATH);
2221 new_canonical_pathspec [MAXPATH - 1] = (char) 0;
2223 return new_canonical_pathspec;
2226 static char filename_buff [MAXPATH];
2229 translate_unix (char *name, int type)
2231 strncpy (filename_buff, name, MAXPATH);
2232 filename_buff [MAXPATH - 1] = (char) 0;
2236 /* Translate a Unix syntax path spec into a VMS style (comma separated list of
2240 to_host_path_spec (char *pathspec)
2242 char *curr, *next, buff [MAXPATH];
2247 /* Can't very well test for colons, since that's the Unix separator! */
2248 if (strchr (pathspec, ']') || strchr (pathspec, ','))
2251 new_host_pathspec[0] = 0;
2256 next = strchr (curr, ':');
2258 next = strchr (curr, 0);
2260 strncpy (buff, curr, next - curr);
2261 buff[next - curr] = 0;
2263 strncat (new_host_pathspec, __gnat_to_host_dir_spec (buff, 0), MAXPATH);
2266 strncat (new_host_pathspec, ",", MAXPATH);
2270 new_host_pathspec [MAXPATH - 1] = (char) 0;
2272 return new_host_pathspec;
2275 /* Translate a Unix syntax directory specification into VMS syntax. The
2276 PREFIXFLAG has no effect, but is kept for symmetry with
2277 to_canonical_dir_spec. If indicators of VMS syntax found, return input
2281 __gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
2283 int len = strlen (dirspec);
2285 strncpy (new_host_dirspec, dirspec, MAXPATH);
2286 new_host_dirspec [MAXPATH - 1] = (char) 0;
2288 if (strchr (new_host_dirspec, ']') || strchr (new_host_dirspec, ':'))
2289 return new_host_dirspec;
2291 while (len > 1 && new_host_dirspec[len - 1] == '/')
2293 new_host_dirspec[len - 1] = 0;
2297 decc$to_vms (new_host_dirspec, translate_unix, 1, 2);
2298 strncpy (new_host_dirspec, filename_buff, MAXPATH);
2299 new_host_dirspec [MAXPATH - 1] = (char) 0;
2301 return new_host_dirspec;
2304 /* Translate a Unix syntax file specification into VMS syntax.
2305 If indicators of VMS syntax found, return input string. */
2308 __gnat_to_host_file_spec (char *filespec)
2310 strncpy (new_host_filespec, "", MAXPATH);
2311 if (strchr (filespec, ']') || strchr (filespec, ':'))
2313 strncpy (new_host_filespec, filespec, MAXPATH);
2317 decc$to_vms (filespec, translate_unix, 1, 1);
2318 strncpy (new_host_filespec, filename_buff, MAXPATH);
2321 new_host_filespec [MAXPATH - 1] = (char) 0;
2323 return new_host_filespec;
2327 __gnat_adjust_os_resource_limits ()
2329 SYS$ADJWSL (131072, 0);
2334 /* Dummy functions for Osint import for non-VMS systems. */
2337 __gnat_to_canonical_file_list_init
2338 (char *dirspec ATTRIBUTE_UNUSED, int onlydirs ATTRIBUTE_UNUSED)
2344 __gnat_to_canonical_file_list_next (void)
2350 __gnat_to_canonical_file_list_free (void)
2355 __gnat_to_canonical_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
2361 __gnat_to_canonical_file_spec (char *filespec)
2367 __gnat_to_canonical_path_spec (char *pathspec)
2373 __gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
2379 __gnat_to_host_file_spec (char *filespec)
2385 __gnat_adjust_os_resource_limits (void)
2391 /* For EMX, we cannot include dummy in libgcc, since it is too difficult
2392 to coordinate this with the EMX distribution. Consequently, we put the
2393 definition of dummy which is used for exception handling, here. */
2395 #if defined (__EMX__)
2399 #if defined (__mips_vxworks)
2403 CACHE_USER_FLUSH (0, ENTIRE_CACHE);
2407 #if defined (CROSS_COMPILE) \
2408 || (! (defined (sparc) && defined (sun) && defined (__SVR4)) \
2409 && ! (defined (linux) && defined (i386)) \
2410 && ! defined (__FreeBSD__) \
2411 && ! defined (hpux) \
2412 && ! defined (_AIX) \
2413 && ! (defined (__alpha__) && defined (__osf__)) \
2414 && ! defined (__MINGW32__))
2416 /* Dummy function to satisfy g-trasym.o. Currently Solaris sparc, HP/UX,
2417 GNU/Linux x86, Tru64 & Windows provide a non-dummy version of this
2418 procedure in libaddr2line.a. */
2421 convert_addresses (void *addrs ATTRIBUTE_UNUSED,
2422 int n_addr ATTRIBUTE_UNUSED,
2423 void *buf ATTRIBUTE_UNUSED,
2424 int *len ATTRIBUTE_UNUSED)
2430 #if defined (_WIN32)
2431 int __gnat_argument_needs_quote = 1;
2433 int __gnat_argument_needs_quote = 0;
2436 /* This option is used to enable/disable object files handling from the
2437 binder file by the GNAT Project module. For example, this is disabled on
2438 Windows as it is already done by the mdll module. */
2439 #if defined (_WIN32)
2440 int __gnat_prj_add_obj_files = 0;
2442 int __gnat_prj_add_obj_files = 1;
2445 /* char used as prefix/suffix for environment variables */
2446 #if defined (_WIN32)
2447 char __gnat_environment_char = '%';
2449 char __gnat_environment_char = '$';
2452 /* This functions copy the file attributes from a source file to a
2455 mode = 0 : In this mode copy only the file time stamps (last access and
2456 last modification time stamps).
2458 mode = 1 : In this mode, time stamps and read/write/execute attributes are
2461 Returns 0 if operation was successful and -1 in case of error. */
2464 __gnat_copy_attribs (char *from, char *to, int mode)
2466 #if defined (VMS) || defined (__vxworks)
2470 struct utimbuf tbuf;
2472 if (stat (from, &fbuf) == -1)
2477 tbuf.actime = fbuf.st_atime;
2478 tbuf.modtime = fbuf.st_mtime;
2480 if (utime (to, &tbuf) == -1)
2487 if (chmod (to, fbuf.st_mode) == -1)
2497 /* This function is installed in libgcc.a. */
2498 extern void __gnat_install_locks (void (*) (void), void (*) (void));
2500 /* This function offers a hook for libgnarl to set the
2501 locking subprograms for libgcc_eh.
2502 This is only needed on OpenVMS, since other platforms use standard
2503 --enable-threads=posix option, or similar. */
2506 __gnatlib_install_locks (void (*lock) (void) ATTRIBUTE_UNUSED,
2507 void (*unlock) (void) ATTRIBUTE_UNUSED)
2509 #if defined (IN_RTS) && defined (VMS)
2510 __gnat_install_locks (lock, unlock);
2511 /* There is a bootstrap path issue if adaint is build with this
2512 symbol unresolved for the stage1 compiler. Since the compiler
2513 does not use tasking, we simply make __gnatlib_install_locks
2514 a no-op in this case. */
2519 __gnat_lseek (int fd, long offset, int whence)
2521 return (int) lseek (fd, offset, whence);
2524 /* This function returns the version of GCC being used. Here it's GCC 3. */
2526 get_gcc_version (void)