1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
9 * Copyright (C) 1992-2003, 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 */
61 /* We don't have libiberty, so use malloc. */
62 #define xmalloc(S) malloc (S)
63 #define xrealloc(V,S) realloc (V,S)
71 #include <sys/utime.h>
87 #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
90 /* Header files and definitions for __gnat_set_file_time_name. */
102 /* Use native 64-bit arithmetic. */
103 #define unix_time_to_vms(X,Y) \
104 { unsigned long long reftime, tmptime = (X); \
105 $DESCRIPTOR (unixtime,"1-JAN-1970 0:00:00.00"); \
106 SYS$BINTIM (&unixtime, &reftime); \
107 Y = tmptime * 10000000 + reftime; }
109 /* descrip.h doesn't have everything ... */
110 struct dsc$descriptor_fib
112 unsigned long fib$l_len;
113 struct fibdef *fib$l_addr;
116 /* I/O Status Block. */
119 unsigned short status, count;
120 unsigned long devdep;
123 static char *tryfile;
125 /* Variable length string. */
129 char string[NAM$C_MAXRSS+1];
136 #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
147 /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
148 defined in the current system. On DOS-like systems these flags control
149 whether the file is opened/created in text-translation mode (CR/LF in
150 external file mapped to LF in internal file), but in Unix-like systems,
151 no text translation is required, so these flags have no effect. */
153 #if defined (__EMX__)
169 #ifndef HOST_EXECUTABLE_SUFFIX
170 #define HOST_EXECUTABLE_SUFFIX ""
173 #ifndef HOST_OBJECT_SUFFIX
174 #define HOST_OBJECT_SUFFIX ".o"
177 #ifndef PATH_SEPARATOR
178 #define PATH_SEPARATOR ':'
181 #ifndef DIR_SEPARATOR
182 #define DIR_SEPARATOR '/'
185 char __gnat_dir_separator = DIR_SEPARATOR;
187 char __gnat_path_separator = PATH_SEPARATOR;
189 /* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
190 the base filenames that libraries specified with -lsomelib options
191 may have. This is used by GNATMAKE to check whether an executable
192 is up-to-date or not. The syntax is
194 library_template ::= { pattern ; } pattern NUL
195 pattern ::= [ prefix ] * [ postfix ]
197 These should only specify names of static libraries as it makes
198 no sense to determine at link time if dynamic-link libraries are
199 up to date or not. Any libraries that are not found are supposed
202 * if they are needed but not present, the link
205 * otherwise they are libraries in the system paths and so
206 they are considered part of the system and not checked
209 ??? This should be part of a GNAT host-specific compiler
210 file instead of being included in all user applications
211 as well. This is only a temporary work-around for 3.11b. */
213 #ifndef GNAT_LIBRARY_TEMPLATE
214 #if defined (__EMX__)
215 #define GNAT_LIBRARY_TEMPLATE "*.a"
217 #define GNAT_LIBRARY_TEMPLATE "*.olb"
219 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
223 const char *__gnat_library_template = GNAT_LIBRARY_TEMPLATE;
225 /* This variable is used in hostparm.ads to say whether the host is a VMS
228 const int __gnat_vmsp = 1;
230 const int __gnat_vmsp = 0;
234 #define GNAT_MAX_PATH_LEN MAX_PATH
237 #define GNAT_MAX_PATH_LEN 256 /* PATH_MAX */
239 #elif defined (__vxworks) || defined (__OPENNT)
240 #define GNAT_MAX_PATH_LEN PATH_MAX
244 #if defined (__MINGW32__)
248 #include <sys/param.h>
252 #include <sys/param.h>
255 #define GNAT_MAX_PATH_LEN MAXPATHLEN
259 /* The __gnat_max_path_len variable is used to export the maximum
260 length of a path name to Ada code. max_path_len is also provided
261 for compatibility with older GNAT versions, please do not use
264 int __gnat_max_path_len = GNAT_MAX_PATH_LEN;
265 int max_path_len = GNAT_MAX_PATH_LEN;
267 /* The following macro HAVE_READDIR_R should be defined if the
268 system provides the routine readdir_r. */
269 #undef HAVE_READDIR_R
282 time_t time = (time_t) *p_time;
285 /* On Windows systems, the time is sometimes rounded up to the nearest
286 even second, so if the number of seconds is odd, increment it. */
292 res = localtime (&time);
294 res = gmtime (&time);
299 *p_year = res->tm_year;
300 *p_month = res->tm_mon;
301 *p_day = res->tm_mday;
302 *p_hours = res->tm_hour;
303 *p_mins = res->tm_min;
304 *p_secs = res->tm_sec;
307 *p_year = *p_month = *p_day = *p_hours = *p_mins = *p_secs = 0;
310 /* Place the contents of the symbolic link named PATH in the buffer BUF,
311 which has size BUFSIZ. If PATH is a symbolic link, then return the number
312 of characters of its content in BUF. Otherwise, return -1. For Windows,
313 OS/2 and vxworks, always return -1. */
316 __gnat_readlink (char *path ATTRIBUTE_UNUSED,
317 char *buf ATTRIBUTE_UNUSED,
318 size_t bufsiz ATTRIBUTE_UNUSED)
320 #if defined (MSDOS) || defined (_WIN32) || defined (__EMX__)
322 #elif defined (__INTERIX) || defined (VMS)
324 #elif defined (__vxworks)
327 return readlink (path, buf, bufsiz);
331 /* Creates a symbolic link named NEWPATH which contains the string OLDPATH. If
332 NEWPATH exists it will NOT be overwritten. For Windows, OS/2, VxWorks,
333 Interix and VMS, always return -1. */
336 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED,
337 char *newpath ATTRIBUTE_UNUSED)
339 #if defined (MSDOS) || defined (_WIN32) || defined (__EMX__)
341 #elif defined (__INTERIX) || defined (VMS)
343 #elif defined (__vxworks)
346 return symlink (oldpath, newpath);
350 /* Try to lock a file, return 1 if success. */
352 #if defined (__vxworks) || defined (MSDOS) || defined (_WIN32)
354 /* Version that does not use link. */
357 __gnat_try_lock (char *dir, char *file)
362 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
363 fd = open (full_path, O_CREAT | O_EXCL, 0600);
371 #elif defined (__EMX__) || defined (VMS)
373 /* More cases that do not use link; identical code, to solve too long
377 __gnat_try_lock (char *dir, char *file)
382 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
383 fd = open (full_path, O_CREAT | O_EXCL, 0600);
393 /* Version using link(), more secure over NFS. */
394 /* See TN 6913-016 for discussion ??? */
397 __gnat_try_lock (char *dir, char *file)
401 struct stat stat_result;
404 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
405 sprintf (temp_file, "%s-%ld-%ld", dir, (long) getpid(), (long) getppid ());
407 /* Create the temporary file and write the process number. */
408 fd = open (temp_file, O_CREAT | O_WRONLY, 0600);
414 /* Link it with the new file. */
415 link (temp_file, full_path);
417 /* Count the references on the old one. If we have a count of two, then
418 the link did succeed. Remove the temporary file before returning. */
419 __gnat_stat (temp_file, &stat_result);
421 return stat_result.st_nlink == 2;
425 /* Return the maximum file name length. */
428 __gnat_get_maximum_file_name_length (void)
433 if (getenv ("GNAT$EXTENDED_FILE_SPECIFICATIONS"))
442 /* Return nonzero if file names are case sensitive. */
445 __gnat_get_file_names_case_sensitive (void)
447 #if defined (__EMX__) || defined (MSDOS) || defined (VMS) || defined (WINNT)
455 __gnat_get_default_identifier_character_set (void)
457 #if defined (__EMX__) || defined (MSDOS)
464 /* Return the current working directory. */
467 __gnat_get_current_dir (char *dir, int *length)
470 /* Force Unix style, which is what GNAT uses internally. */
471 getcwd (dir, *length, 0);
473 getcwd (dir, *length);
476 *length = strlen (dir);
478 if (dir [*length - 1] != DIR_SEPARATOR)
480 dir [*length] = DIR_SEPARATOR;
486 /* Return the suffix for object files. */
489 __gnat_get_object_suffix_ptr (int *len, const char **value)
491 *value = HOST_OBJECT_SUFFIX;
496 *len = strlen (*value);
501 /* Return the suffix for executable files. */
504 __gnat_get_executable_suffix_ptr (int *len, const char **value)
506 *value = HOST_EXECUTABLE_SUFFIX;
510 *len = strlen (*value);
515 /* Return the suffix for debuggable files. Usually this is the same as the
516 executable extension. */
519 __gnat_get_debuggable_suffix_ptr (int *len, const char **value)
522 *value = HOST_EXECUTABLE_SUFFIX;
524 /* On DOS, the extensionless COFF file is what gdb likes. */
531 *len = strlen (*value);
537 __gnat_open_read (char *path, int fmode)
540 int o_fmode = O_BINARY;
546 /* Optional arguments mbc,deq,fop increase read performance. */
547 fd = open (path, O_RDONLY | o_fmode, 0444,
548 "mbc=16", "deq=64", "fop=tef");
549 #elif defined (__vxworks)
550 fd = open (path, O_RDONLY | o_fmode, 0444);
552 fd = open (path, O_RDONLY | o_fmode);
555 return fd < 0 ? -1 : fd;
558 #if defined (__EMX__) || defined (__MINGW32__)
559 #define PERM (S_IREAD | S_IWRITE)
561 /* Excerpt from DECC C RTL Reference Manual:
562 To create files with OpenVMS RMS default protections using the UNIX
563 system-call functions umask, mkdir, creat, and open, call mkdir, creat,
564 and open with a file-protection mode argument of 0777 in a program
565 that never specifically calls umask. These default protections include
566 correctly establishing protections based on ACLs, previous versions of
570 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
574 __gnat_open_rw (char *path, int fmode)
577 int o_fmode = O_BINARY;
583 fd = open (path, O_RDWR | o_fmode, PERM,
584 "mbc=16", "deq=64", "fop=tef");
586 fd = open (path, O_RDWR | o_fmode, PERM);
589 return fd < 0 ? -1 : fd;
593 __gnat_open_create (char *path, int fmode)
596 int o_fmode = O_BINARY;
602 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM,
603 "mbc=16", "deq=64", "fop=tef");
605 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
608 return fd < 0 ? -1 : fd;
612 __gnat_open_append (char *path, int fmode)
615 int o_fmode = O_BINARY;
621 fd = open (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM,
622 "mbc=16", "deq=64", "fop=tef");
624 fd = open (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
627 return fd < 0 ? -1 : fd;
630 /* Open a new file. Return error (-1) if the file already exists. */
633 __gnat_open_new (char *path, int fmode)
636 int o_fmode = O_BINARY;
642 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM,
643 "mbc=16", "deq=64", "fop=tef");
645 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
648 return fd < 0 ? -1 : fd;
651 /* Open a new temp file. Return error (-1) if the file already exists.
652 Special options for VMS allow the file to be shared between parent and child
653 processes, however they really slow down output. Used in gnatchop. */
656 __gnat_open_new_temp (char *path, int fmode)
659 int o_fmode = O_BINARY;
661 strcpy (path, "GNAT-XXXXXX");
663 #if defined (linux) && !defined (__vxworks)
664 return mkstemp (path);
665 #elif defined (__Lynx__)
668 if (mktemp (path) == NULL)
676 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM,
677 "rfm=stmlf", "ctx=rec", "rat=none", "shr=del,get,put,upd",
678 "mbc=16", "deq=64", "fop=tef");
680 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
683 return fd < 0 ? -1 : fd;
686 /* Return the number of bytes in the specified file. */
689 __gnat_file_length (int fd)
694 ret = fstat (fd, &statbuf);
695 if (ret || !S_ISREG (statbuf.st_mode))
698 return (statbuf.st_size);
701 /* Create a temporary filename and put it in string pointed to by
705 __gnat_tmp_name (char *tmp_filename)
711 /* tempnam tries to create a temporary file in directory pointed to by
712 TMP environment variable, in c:\temp if TMP is not set, and in
713 directory specified by P_tmpdir in stdio.h if c:\temp does not
714 exist. The filename will be created with the prefix "gnat-". */
716 pname = (char *) tempnam ("c:\\temp", "gnat-");
718 /* if pname is NULL, the file was not created properly, the disk is full
719 or there is no more free temporary files */
722 *tmp_filename = '\0';
724 /* If pname start with a back slash and not path information it means that
725 the filename is valid for the current working directory. */
727 else if (pname[0] == '\\')
729 strcpy (tmp_filename, ".\\");
730 strcat (tmp_filename, pname+1);
733 strcpy (tmp_filename, pname);
738 #elif defined (linux)
739 #define MAX_SAFE_PATH 1000
740 char *tmpdir = getenv ("TMPDIR");
742 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
743 a buffer overflow. */
744 if (tmpdir == NULL || strlen (tmpdir) > MAX_SAFE_PATH)
745 strcpy (tmp_filename, "/tmp/gnat-XXXXXX");
747 sprintf (tmp_filename, "%s/gnat-XXXXXX", tmpdir);
749 close (mkstemp(tmp_filename));
751 tmpnam (tmp_filename);
755 /* Read the next entry in a directory. The returned string points somewhere
759 __gnat_readdir (DIR *dirp, char *buffer)
761 /* If possible, try to use the thread-safe version. */
762 #ifdef HAVE_READDIR_R
763 if (readdir_r (dirp, buffer) != NULL)
764 return ((struct dirent*) buffer)->d_name;
769 struct dirent *dirent = readdir (dirp);
773 strcpy (buffer, dirent->d_name);
782 /* Returns 1 if readdir is thread safe, 0 otherwise. */
785 __gnat_readdir_is_thread_safe (void)
787 #ifdef HAVE_READDIR_R
795 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
796 static const unsigned long long w32_epoch_offset = 11644473600ULL;
798 /* Returns the file modification timestamp using Win32 routines which are
799 immune against daylight saving time change. It is in fact not possible to
800 use fstat for this purpose as the DST modify the st_mtime field of the
804 win32_filetime (HANDLE h)
809 unsigned long long ull_time;
812 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
813 since <Jan 1st 1601>. This function must return the number of seconds
814 since <Jan 1st 1970>. */
816 if (GetFileTime (h, NULL, NULL, &t_write.ft_time))
817 return (time_t) (t_write.ull_time / 10000000ULL
823 /* Return a GNAT time stamp given a file name. */
826 __gnat_file_time_name (char *name)
829 #if defined (__EMX__) || defined (MSDOS)
830 int fd = open (name, O_RDONLY | O_BINARY);
831 time_t ret = __gnat_file_time_fd (fd);
835 #elif defined (_WIN32)
837 HANDLE h = CreateFile (name, GENERIC_READ, FILE_SHARE_READ, 0,
838 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
840 if (h != INVALID_HANDLE_VALUE)
842 ret = win32_filetime (h);
848 (void) __gnat_stat (name, &statbuf);
850 /* VMS has file versioning. */
851 return statbuf.st_ctime;
853 return statbuf.st_mtime;
858 /* Return a GNAT time stamp given a file descriptor. */
861 __gnat_file_time_fd (int fd)
863 /* The following workaround code is due to the fact that under EMX and
864 DJGPP fstat attempts to convert time values to GMT rather than keep the
865 actual OS timestamp of the file. By using the OS2/DOS functions directly
866 the GNAT timestamp are independent of this behavior, which is desired to
867 facilitate the distribution of GNAT compiled libraries. */
869 #if defined (__EMX__) || defined (MSDOS)
873 int ret = DosQueryFileInfo (fd, 1, (unsigned char *) &fs,
874 sizeof (FILESTATUS));
876 unsigned file_year = fs.fdateLastWrite.year;
877 unsigned file_month = fs.fdateLastWrite.month;
878 unsigned file_day = fs.fdateLastWrite.day;
879 unsigned file_hour = fs.ftimeLastWrite.hours;
880 unsigned file_min = fs.ftimeLastWrite.minutes;
881 unsigned file_tsec = fs.ftimeLastWrite.twosecs;
885 int ret = getftime (fd, &fs);
887 unsigned file_year = fs.ft_year;
888 unsigned file_month = fs.ft_month;
889 unsigned file_day = fs.ft_day;
890 unsigned file_hour = fs.ft_hour;
891 unsigned file_min = fs.ft_min;
892 unsigned file_tsec = fs.ft_tsec;
895 /* Calculate the seconds since epoch from the time components. First count
896 the whole days passed. The value for years returned by the DOS and OS2
897 functions count years from 1980, so to compensate for the UNIX epoch which
898 begins in 1970 start with 10 years worth of days and add days for each
899 four year period since then. */
902 int cum_days[12] = {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
903 int days_passed = 3652 + (file_year / 4) * 1461;
904 int years_since_leap = file_year % 4;
906 if (years_since_leap == 1)
908 else if (years_since_leap == 2)
910 else if (years_since_leap == 3)
916 days_passed += cum_days[file_month - 1];
917 if (years_since_leap == 0 && file_year != 20 && file_month > 2)
920 days_passed += file_day - 1;
922 /* OK - have whole days. Multiply -- then add in other parts. */
924 tot_secs = days_passed * 86400;
925 tot_secs += file_hour * 3600;
926 tot_secs += file_min * 60;
927 tot_secs += file_tsec * 2;
930 #elif defined (_WIN32)
931 HANDLE h = (HANDLE) _get_osfhandle (fd);
932 time_t ret = win32_filetime (h);
938 (void) fstat (fd, &statbuf);
941 /* VMS has file versioning. */
942 return statbuf.st_ctime;
944 return statbuf.st_mtime;
949 /* Set the file time stamp. */
952 __gnat_set_file_time_name (char *name, time_t time_stamp)
954 #if defined (__EMX__) || defined (MSDOS) || defined (__vxworks)
956 /* Code to implement __gnat_set_file_time_name for these systems. */
958 #elif defined (_WIN32)
962 unsigned long long ull_time;
965 HANDLE h = CreateFile (name, GENERIC_WRITE, FILE_SHARE_WRITE, NULL,
966 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS,
968 if (h == INVALID_HANDLE_VALUE)
970 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
971 t_write.ull_time = ((unsigned long long)time_stamp + w32_epoch_offset);
972 /* Convert to 100 nanosecond units */
973 t_write.ull_time *= 10000000ULL;
975 SetFileTime(h, NULL, NULL, &t_write.ft_time);
985 unsigned long long backup, create, expire, revise;
989 unsigned short value;
998 } Fat = { 0, 0, 0, 0, 0, { 0 }};
1002 { ATR$S_CREDATE, ATR$C_CREDATE, &Fat.create },
1003 { ATR$S_REVDATE, ATR$C_REVDATE, &Fat.revise },
1004 { ATR$S_EXPDATE, ATR$C_EXPDATE, &Fat.expire },
1005 { ATR$S_BAKDATE, ATR$C_BAKDATE, &Fat.backup },
1006 { ATR$S_FPRO, ATR$C_FPRO, &Fat.prot },
1007 { ATR$S_UIC, ATR$C_UIC, &Fat.uic },
1012 struct dsc$descriptor_fib fibdsc = {sizeof (fib), (void *) &fib};
1016 unsigned long long newtime;
1017 unsigned long long revtime;
1021 struct vstring file;
1022 struct dsc$descriptor_s filedsc
1023 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) file.string};
1024 struct vstring device;
1025 struct dsc$descriptor_s devicedsc
1026 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) device.string};
1027 struct vstring timev;
1028 struct dsc$descriptor_s timedsc
1029 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) timev.string};
1030 struct vstring result;
1031 struct dsc$descriptor_s resultdsc
1032 = {NAM$C_MAXRSS, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, (void *) result.string};
1034 tryfile = (char *) __gnat_to_host_dir_spec (name, 0);
1036 /* Allocate and initialize a FAB and NAM structures. */
1040 nam.nam$l_esa = file.string;
1041 nam.nam$b_ess = NAM$C_MAXRSS;
1042 nam.nam$l_rsa = result.string;
1043 nam.nam$b_rss = NAM$C_MAXRSS;
1044 fab.fab$l_fna = tryfile;
1045 fab.fab$b_fns = strlen (tryfile);
1046 fab.fab$l_nam = &nam;
1048 /* Validate filespec syntax and device existence. */
1049 status = SYS$PARSE (&fab, 0, 0);
1050 if ((status & 1) != 1)
1051 LIB$SIGNAL (status);
1053 file.string[nam.nam$b_esl] = 0;
1055 /* Find matching filespec. */
1056 status = SYS$SEARCH (&fab, 0, 0);
1057 if ((status & 1) != 1)
1058 LIB$SIGNAL (status);
1060 file.string[nam.nam$b_esl] = 0;
1061 result.string[result.length=nam.nam$b_rsl] = 0;
1063 /* Get the device name and assign an IO channel. */
1064 strncpy (device.string, nam.nam$l_dev, nam.nam$b_dev);
1065 devicedsc.dsc$w_length = nam.nam$b_dev;
1067 status = SYS$ASSIGN (&devicedsc, &chan, 0, 0, 0);
1068 if ((status & 1) != 1)
1069 LIB$SIGNAL (status);
1071 /* Initialize the FIB and fill in the directory id field. */
1072 memset (&fib, 0, sizeof (fib));
1073 fib.fib$w_did[0] = nam.nam$w_did[0];
1074 fib.fib$w_did[1] = nam.nam$w_did[1];
1075 fib.fib$w_did[2] = nam.nam$w_did[2];
1076 fib.fib$l_acctl = 0;
1078 strcpy (file.string, (strrchr (result.string, ']') + 1));
1079 filedsc.dsc$w_length = strlen (file.string);
1080 result.string[result.length = 0] = 0;
1082 /* Open and close the file to fill in the attributes. */
1084 = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
1085 &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
1086 if ((status & 1) != 1)
1087 LIB$SIGNAL (status);
1088 if ((iosb.status & 1) != 1)
1089 LIB$SIGNAL (iosb.status);
1091 result.string[result.length] = 0;
1092 status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0, &fibdsc, 0, 0, 0,
1094 if ((status & 1) != 1)
1095 LIB$SIGNAL (status);
1096 if ((iosb.status & 1) != 1)
1097 LIB$SIGNAL (iosb.status);
1102 /* Set creation time to requested time. */
1103 unix_time_to_vms (time_stamp, newtime);
1105 t = time ((time_t) 0);
1107 /* Set revision time to now in local time. */
1108 unix_time_to_vms (t, revtime);
1111 /* Reopen the file, modify the times and then close. */
1112 fib.fib$l_acctl = FIB$M_WRITE;
1114 = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
1115 &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
1116 if ((status & 1) != 1)
1117 LIB$SIGNAL (status);
1118 if ((iosb.status & 1) != 1)
1119 LIB$SIGNAL (iosb.status);
1121 Fat.create = newtime;
1122 Fat.revise = revtime;
1124 status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0,
1125 &fibdsc, 0, 0, 0, &atrlst, 0);
1126 if ((status & 1) != 1)
1127 LIB$SIGNAL (status);
1128 if ((iosb.status & 1) != 1)
1129 LIB$SIGNAL (iosb.status);
1131 /* Deassign the channel and exit. */
1132 status = SYS$DASSGN (chan);
1133 if ((status & 1) != 1)
1134 LIB$SIGNAL (status);
1136 struct utimbuf utimbuf;
1139 /* Set modification time to requested time. */
1140 utimbuf.modtime = time_stamp;
1142 /* Set access time to now in local time. */
1143 t = time ((time_t) 0);
1144 utimbuf.actime = mktime (localtime (&t));
1146 utime (name, &utimbuf);
1151 __gnat_get_env_value_ptr (char *name, int *len, char **value)
1153 *value = getenv (name);
1157 *len = strlen (*value);
1162 /* VMS specific declarations for set_env_value. */
1166 static char *to_host_path_spec (char *);
1170 unsigned short len, mbz;
1174 typedef struct _ile3
1176 unsigned short len, code;
1178 unsigned short *retlen_adr;
1184 __gnat_set_env_value (char *name, char *value)
1189 struct descriptor_s name_desc;
1190 /* Put in JOB table for now, so that the project stuff at least works. */
1191 struct descriptor_s table_desc = {7, 0, "LNM$JOB"};
1192 char *host_pathspec = value;
1193 char *copy_pathspec;
1194 int num_dirs_in_pathspec = 1;
1198 name_desc.len = strlen (name);
1200 name_desc.adr = name;
1202 if (*host_pathspec == 0)
1205 status = LIB$DELETE_LOGICAL (&name_desc, &table_desc);
1206 /* no need to check status; if the logical name is not
1207 defined, that's fine. */
1211 ptr = host_pathspec;
1214 num_dirs_in_pathspec++;
1218 ile_s *ile_array = alloca (sizeof (ile_s) * (num_dirs_in_pathspec + 1));
1219 char *copy_pathspec = alloca (strlen (host_pathspec) + 1);
1222 strcpy (copy_pathspec, host_pathspec);
1223 curr = copy_pathspec;
1224 for (i = 0; i < num_dirs_in_pathspec; i++)
1226 next = strchr (curr, ',');
1228 next = strchr (curr, 0);
1231 ile_array[i].len = strlen (curr);
1233 /* Code 2 from lnmdef.h means its a string. */
1234 ile_array[i].code = 2;
1235 ile_array[i].adr = curr;
1237 /* retlen_adr is ignored. */
1238 ile_array[i].retlen_adr = 0;
1242 /* Terminating item must be zero. */
1243 ile_array[i].len = 0;
1244 ile_array[i].code = 0;
1245 ile_array[i].adr = 0;
1246 ile_array[i].retlen_adr = 0;
1248 status = LIB$SET_LOGICAL (&name_desc, 0, &table_desc, 0, ile_array);
1249 if ((status & 1) != 1)
1250 LIB$SIGNAL (status);
1254 int size = strlen (name) + strlen (value) + 2;
1257 expression = (char *) xmalloc (size * sizeof (char));
1259 sprintf (expression, "%s=%s", name, value);
1260 putenv (expression);
1265 #include <windows.h>
1268 /* Get the list of installed standard libraries from the
1269 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1273 __gnat_get_libraries_from_registry (void)
1275 char *result = (char *) "";
1277 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_COMPILE)
1280 DWORD name_size, value_size;
1287 /* First open the key. */
1288 res = RegOpenKeyExA (HKEY_LOCAL_MACHINE, "SOFTWARE", 0, KEY_READ, ®_key);
1290 if (res == ERROR_SUCCESS)
1291 res = RegOpenKeyExA (reg_key, "Ada Core Technologies", 0,
1292 KEY_READ, ®_key);
1294 if (res == ERROR_SUCCESS)
1295 res = RegOpenKeyExA (reg_key, "GNAT", 0, KEY_READ, ®_key);
1297 if (res == ERROR_SUCCESS)
1298 res = RegOpenKeyExA (reg_key, "Standard Libraries", 0, KEY_READ, ®_key);
1300 /* If the key exists, read out all the values in it and concatenate them
1302 for (index = 0; res == ERROR_SUCCESS; index++)
1304 value_size = name_size = 256;
1305 res = RegEnumValue (reg_key, index, name, &name_size, 0,
1306 &type, value, &value_size);
1308 if (res == ERROR_SUCCESS && type == REG_SZ)
1310 char *old_result = result;
1312 result = (char *) xmalloc (strlen (old_result) + value_size + 2);
1313 strcpy (result, old_result);
1314 strcat (result, value);
1315 strcat (result, ";");
1319 /* Remove the trailing ";". */
1321 result[strlen (result) - 1] = 0;
1328 __gnat_stat (char *name, struct stat *statbuf)
1331 /* Under Windows the directory name for the stat function must not be
1332 terminated by a directory separator except if just after a drive name. */
1333 int name_len = strlen (name);
1334 char last_char = name[name_len - 1];
1335 char win32_name[4096];
1337 strcpy (win32_name, name);
1339 while (name_len > 1 && (last_char == '\\' || last_char == '/'))
1341 win32_name[name_len - 1] = '\0';
1343 last_char = win32_name[name_len - 1];
1346 if (name_len == 2 && win32_name[1] == ':')
1347 strcat (win32_name, "\\");
1349 return stat (win32_name, statbuf);
1352 return stat (name, statbuf);
1357 __gnat_file_exists (char *name)
1359 struct stat statbuf;
1361 return !__gnat_stat (name, &statbuf);
1365 __gnat_is_absolute_path (char *name)
1367 return (*name == '/' || *name == DIR_SEPARATOR
1368 #if defined (__EMX__) || defined (MSDOS) || defined (WINNT)
1369 || (strlen (name) > 1 && isalpha (name[0]) && name[1] == ':')
1375 __gnat_is_regular_file (char *name)
1378 struct stat statbuf;
1380 ret = __gnat_stat (name, &statbuf);
1381 return (!ret && S_ISREG (statbuf.st_mode));
1385 __gnat_is_directory (char *name)
1388 struct stat statbuf;
1390 ret = __gnat_stat (name, &statbuf);
1391 return (!ret && S_ISDIR (statbuf.st_mode));
1395 __gnat_is_readable_file (char *name)
1399 struct stat statbuf;
1401 ret = __gnat_stat (name, &statbuf);
1402 mode = statbuf.st_mode & S_IRUSR;
1403 return (!ret && mode);
1407 __gnat_is_writable_file (char *name)
1411 struct stat statbuf;
1413 ret = __gnat_stat (name, &statbuf);
1414 mode = statbuf.st_mode & S_IWUSR;
1415 return (!ret && mode);
1419 __gnat_set_writable (char *name)
1422 struct stat statbuf;
1424 if (stat (name, &statbuf) == 0)
1426 statbuf.st_mode = statbuf.st_mode | S_IWUSR;
1427 chmod (name, statbuf.st_mode);
1433 __gnat_set_readonly (char *name)
1436 struct stat statbuf;
1438 if (stat (name, &statbuf) == 0)
1440 statbuf.st_mode = statbuf.st_mode & 07577;
1441 chmod (name, statbuf.st_mode);
1447 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
1449 #if defined (__vxworks)
1452 #elif defined (_AIX) || defined (unix)
1454 struct stat statbuf;
1456 ret = lstat (name, &statbuf);
1457 return (!ret && S_ISLNK (statbuf.st_mode));
1465 /* Defined in VMS header files. */
1466 #define fork() (decc$$alloc_vfork_blocks() >= 0 ? \
1467 LIB$GET_CURRENT_INVO_CONTEXT (decc$$get_vfork_jmpbuf()) : -1)
1470 #if defined (sun) && defined (__SVR4)
1471 /* Using fork on Solaris will duplicate all the threads. fork1, which
1472 duplicates only the active thread, must be used instead, or spawning
1473 subprocess from a program with tasking will lead into numerous problems. */
1478 __gnat_portable_spawn (char *args[])
1481 int finished ATTRIBUTE_UNUSED;
1482 int pid ATTRIBUTE_UNUSED;
1484 #if defined (MSDOS) || defined (_WIN32)
1485 status = spawnvp (P_WAIT, args[0],(const char* const*)args);
1491 #elif defined (__vxworks)
1496 pid = spawnvp (P_NOWAIT, args[0], args);
1508 if (execv (args[0], args) != 0)
1510 return -1; /* execv is in parent context on VMS. */
1518 finished = waitpid (pid, &status, 0);
1520 if (finished != pid || WIFEXITED (status) == 0)
1523 return WEXITSTATUS (status);
1529 /* WIN32 code to implement a wait call that wait for any child process. */
1533 /* Synchronization code, to be thread safe. */
1535 static CRITICAL_SECTION plist_cs;
1538 __gnat_plist_init (void)
1540 InitializeCriticalSection (&plist_cs);
1546 EnterCriticalSection (&plist_cs);
1552 LeaveCriticalSection (&plist_cs);
1555 typedef struct _process_list
1558 struct _process_list *next;
1561 static Process_List *PLIST = NULL;
1563 static int plist_length = 0;
1566 add_handle (HANDLE h)
1570 pl = (Process_List *) xmalloc (sizeof (Process_List));
1574 /* -------------------- critical section -------------------- */
1579 /* -------------------- critical section -------------------- */
1585 remove_handle (HANDLE h)
1588 Process_List *prev = NULL;
1592 /* -------------------- critical section -------------------- */
1601 prev->next = pl->next;
1613 /* -------------------- critical section -------------------- */
1619 win32_no_block_spawn (char *command, char *args[])
1623 PROCESS_INFORMATION PI;
1624 SECURITY_ATTRIBUTES SA;
1629 /* compute the total command line length */
1633 csize += strlen (args[k]) + 1;
1637 full_command = (char *) xmalloc (csize);
1640 SI.cb = sizeof (STARTUPINFO);
1641 SI.lpReserved = NULL;
1642 SI.lpReserved2 = NULL;
1643 SI.lpDesktop = NULL;
1647 SI.wShowWindow = SW_HIDE;
1649 /* Security attributes. */
1650 SA.nLength = sizeof (SECURITY_ATTRIBUTES);
1651 SA.bInheritHandle = TRUE;
1652 SA.lpSecurityDescriptor = NULL;
1654 /* Prepare the command string. */
1655 strcpy (full_command, command);
1656 strcat (full_command, " ");
1661 strcat (full_command, args[k]);
1662 strcat (full_command, " ");
1666 result = CreateProcess (NULL, (char *) full_command, &SA, NULL, TRUE,
1667 NORMAL_PRIORITY_CLASS, NULL, NULL, &SI, &PI);
1669 free (full_command);
1673 add_handle (PI.hProcess);
1674 CloseHandle (PI.hThread);
1675 return (int) PI.hProcess;
1682 win32_wait (int *status)
1691 if (plist_length == 0)
1697 hl = (HANDLE *) xmalloc (sizeof (HANDLE) * plist_length);
1702 /* -------------------- critical section -------------------- */
1709 /* -------------------- critical section -------------------- */
1713 res = WaitForMultipleObjects (plist_length, hl, FALSE, INFINITE);
1714 h = hl[res - WAIT_OBJECT_0];
1719 GetExitCodeProcess (h, &exitcode);
1722 *status = (int) exitcode;
1729 __gnat_portable_no_block_spawn (char *args[])
1733 #if defined (__EMX__) || defined (MSDOS)
1735 /* ??? For PC machines I (Franco) don't know the system calls to implement
1736 this routine. So I'll fake it as follows. This routine will behave
1737 exactly like the blocking portable_spawn and will systematically return
1738 a pid of 0 unless the spawned task did not complete successfully, in
1739 which case we return a pid of -1. To synchronize with this the
1740 portable_wait below systematically returns a pid of 0 and reports that
1741 the subprocess terminated successfully. */
1743 if (spawnvp (P_WAIT, args[0], args) != 0)
1746 #elif defined (_WIN32)
1748 pid = win32_no_block_spawn (args[0], args);
1751 #elif defined (__vxworks)
1760 if (execv (args[0], args) != 0)
1762 return -1; /* execv is in parent context on VMS. */
1774 __gnat_portable_wait (int *process_status)
1779 #if defined (_WIN32)
1781 pid = win32_wait (&status);
1783 #elif defined (__EMX__) || defined (MSDOS)
1784 /* ??? See corresponding comment in portable_no_block_spawn. */
1786 #elif defined (__vxworks)
1787 /* Not sure what to do here, so do same as __EMX__ case, i.e., nothing but
1791 pid = waitpid (-1, &status, 0);
1792 status = status & 0xffff;
1795 *process_status = status;
1800 __gnat_waitpid (int pid)
1804 #if defined (_WIN32)
1805 cwait (&status, pid, _WAIT_CHILD);
1806 #elif defined (__EMX__) || defined (MSDOS) || defined (__vxworks)
1807 /* Status is already zero, so nothing to do. */
1809 waitpid (pid, &status, 0);
1810 status = WEXITSTATUS (status);
1817 __gnat_os_exit (int status)
1820 /* Exit without changing 0 to 1. */
1821 __posix_exit (status);
1827 /* Locate a regular file, give a Path value. */
1830 __gnat_locate_regular_file (char *file_name, char *path_val)
1833 int absolute = __gnat_is_absolute_path (file_name);
1835 /* Handle absolute pathnames. */
1838 if (__gnat_is_regular_file (file_name))
1839 return xstrdup (file_name);
1844 /* If file_name include directory separator(s), try it first as
1845 a path name relative to the current directory */
1846 for (ptr = file_name; *ptr && *ptr != '/' && *ptr != DIR_SEPARATOR; ptr++)
1851 if (__gnat_is_regular_file (file_name))
1852 return xstrdup (file_name);
1859 /* The result has to be smaller than path_val + file_name. */
1860 char *file_path = alloca (strlen (path_val) + strlen (file_name) + 2);
1864 for (; *path_val == PATH_SEPARATOR; path_val++)
1870 for (ptr = file_path; *path_val && *path_val != PATH_SEPARATOR; )
1871 *ptr++ = *path_val++;
1874 if (*ptr != '/' && *ptr != DIR_SEPARATOR)
1875 *++ptr = DIR_SEPARATOR;
1877 strcpy (++ptr, file_name);
1879 if (__gnat_is_regular_file (file_path))
1880 return xstrdup (file_path);
1887 /* Locate an executable given a Path argument. This routine is only used by
1888 gnatbl and should not be used otherwise. Use locate_exec_on_path
1892 __gnat_locate_exec (char *exec_name, char *path_val)
1894 if (!strstr (exec_name, HOST_EXECUTABLE_SUFFIX))
1896 char *full_exec_name
1897 = alloca (strlen (exec_name) + strlen (HOST_EXECUTABLE_SUFFIX) + 1);
1899 strcpy (full_exec_name, exec_name);
1900 strcat (full_exec_name, HOST_EXECUTABLE_SUFFIX);
1901 return __gnat_locate_regular_file (full_exec_name, path_val);
1904 return __gnat_locate_regular_file (exec_name, path_val);
1907 /* Locate an executable using the Systems default PATH. */
1910 __gnat_locate_exec_on_path (char *exec_name)
1914 char *path_val = "/VAXC$PATH";
1916 char *path_val = getenv ("PATH");
1919 /* In Win32 systems we expand the PATH as for XP environment
1920 variables are not automatically expanded. */
1921 int len = strlen (path_val) * 3;
1922 char *expanded_path_val = alloca (len + 1);
1924 DWORD res = ExpandEnvironmentStrings (path_val, expanded_path_val, len);
1928 path_val = expanded_path_val;
1932 apath_val = alloca (strlen (path_val) + 1);
1933 strcpy (apath_val, path_val);
1935 return __gnat_locate_exec (exec_name, apath_val);
1940 /* These functions are used to translate to and from VMS and Unix syntax
1941 file, directory and path specifications. */
1944 #define MAXNAMES 256
1945 #define NEW_CANONICAL_FILELIST_INCREMENT 64
1947 static char new_canonical_dirspec [MAXPATH];
1948 static char new_canonical_filespec [MAXPATH];
1949 static char new_canonical_pathspec [MAXNAMES*MAXPATH];
1950 static unsigned new_canonical_filelist_index;
1951 static unsigned new_canonical_filelist_in_use;
1952 static unsigned new_canonical_filelist_allocated;
1953 static char **new_canonical_filelist;
1954 static char new_host_pathspec [MAXNAMES*MAXPATH];
1955 static char new_host_dirspec [MAXPATH];
1956 static char new_host_filespec [MAXPATH];
1958 /* Routine is called repeatedly by decc$from_vms via
1959 __gnat_to_canonical_file_list_init until it returns 0 or the expansion
1963 wildcard_translate_unix (char *name)
1966 char buff [MAXPATH];
1968 strncpy (buff, name, MAXPATH);
1969 buff [MAXPATH - 1] = (char) 0;
1970 ver = strrchr (buff, '.');
1972 /* Chop off the version. */
1976 /* Dynamically extend the allocation by the increment. */
1977 if (new_canonical_filelist_in_use == new_canonical_filelist_allocated)
1979 new_canonical_filelist_allocated += NEW_CANONICAL_FILELIST_INCREMENT;
1980 new_canonical_filelist = (char **) xrealloc
1981 (new_canonical_filelist,
1982 new_canonical_filelist_allocated * sizeof (char *));
1985 new_canonical_filelist[new_canonical_filelist_in_use++] = xstrdup (buff);
1990 /* Translate a wildcard VMS file spec into a list of Unix file specs. First do
1991 full translation and copy the results into a list (_init), then return them
1992 one at a time (_next). If onlydirs set, only expand directory files. */
1995 __gnat_to_canonical_file_list_init (char *filespec, int onlydirs)
1998 char buff [MAXPATH];
2000 len = strlen (filespec);
2001 strncpy (buff, filespec, MAXPATH);
2003 /* Only look for directories */
2004 if (onlydirs && !strstr (&buff [len-5], "*.dir"))
2005 strncat (buff, "*.dir", MAXPATH);
2007 buff [MAXPATH - 1] = (char) 0;
2009 decc$from_vms (buff, wildcard_translate_unix, 1);
2011 /* Remove the .dir extension. */
2017 for (i = 0; i < new_canonical_filelist_in_use; i++)
2019 ext = strstr (new_canonical_filelist[i], ".dir");
2025 return new_canonical_filelist_in_use;
2028 /* Return the next filespec in the list. */
2031 __gnat_to_canonical_file_list_next ()
2033 return new_canonical_filelist[new_canonical_filelist_index++];
2036 /* Free storage used in the wildcard expansion. */
2039 __gnat_to_canonical_file_list_free ()
2043 for (i = 0; i < new_canonical_filelist_in_use; i++)
2044 free (new_canonical_filelist[i]);
2046 free (new_canonical_filelist);
2048 new_canonical_filelist_in_use = 0;
2049 new_canonical_filelist_allocated = 0;
2050 new_canonical_filelist_index = 0;
2051 new_canonical_filelist = 0;
2054 /* Translate a VMS syntax directory specification in to Unix syntax. If
2055 PREFIXFLAG is set, append an underscore "/". If no indicators of VMS syntax
2056 found, return input string. Also translate a dirname that contains no
2057 slashes, in case it's a logical name. */
2060 __gnat_to_canonical_dir_spec (char *dirspec, int prefixflag)
2064 strcpy (new_canonical_dirspec, "");
2065 if (strlen (dirspec))
2069 if (strchr (dirspec, ']') || strchr (dirspec, ':'))
2071 strncpy (new_canonical_dirspec,
2072 (char *) decc$translate_vms (dirspec),
2075 else if (!strchr (dirspec, '/') && (dirspec1 = getenv (dirspec)) != 0)
2077 strncpy (new_canonical_dirspec,
2078 (char *) decc$translate_vms (dirspec1),
2083 strncpy (new_canonical_dirspec, dirspec, MAXPATH);
2087 len = strlen (new_canonical_dirspec);
2088 if (prefixflag && new_canonical_dirspec [len-1] != '/')
2089 strncat (new_canonical_dirspec, "/", MAXPATH);
2091 new_canonical_dirspec [MAXPATH - 1] = (char) 0;
2093 return new_canonical_dirspec;
2097 /* Translate a VMS syntax file specification into Unix syntax.
2098 If no indicators of VMS syntax found, return input string. */
2101 __gnat_to_canonical_file_spec (char *filespec)
2103 strncpy (new_canonical_filespec, "", MAXPATH);
2105 if (strchr (filespec, ']') || strchr (filespec, ':'))
2107 strncpy (new_canonical_filespec,
2108 (char *) decc$translate_vms (filespec),
2113 strncpy (new_canonical_filespec, filespec, MAXPATH);
2116 new_canonical_filespec [MAXPATH - 1] = (char) 0;
2118 return new_canonical_filespec;
2121 /* Translate a VMS syntax path specification into Unix syntax.
2122 If no indicators of VMS syntax found, return input string. */
2125 __gnat_to_canonical_path_spec (char *pathspec)
2127 char *curr, *next, buff [MAXPATH];
2132 /* If there are /'s, assume it's a Unix path spec and return. */
2133 if (strchr (pathspec, '/'))
2136 new_canonical_pathspec[0] = 0;
2141 next = strchr (curr, ',');
2143 next = strchr (curr, 0);
2145 strncpy (buff, curr, next - curr);
2146 buff[next - curr] = 0;
2148 /* Check for wildcards and expand if present. */
2149 if (strchr (buff, '*') || strchr (buff, '%') || strstr (buff, "..."))
2153 dirs = __gnat_to_canonical_file_list_init (buff, 1);
2154 for (i = 0; i < dirs; i++)
2158 next_dir = __gnat_to_canonical_file_list_next ();
2159 strncat (new_canonical_pathspec, next_dir, MAXPATH);
2161 /* Don't append the separator after the last expansion. */
2163 strncat (new_canonical_pathspec, ":", MAXPATH);
2166 __gnat_to_canonical_file_list_free ();
2169 strncat (new_canonical_pathspec,
2170 __gnat_to_canonical_dir_spec (buff, 0), MAXPATH);
2175 strncat (new_canonical_pathspec, ":", MAXPATH);
2179 new_canonical_pathspec [MAXPATH - 1] = (char) 0;
2181 return new_canonical_pathspec;
2184 static char filename_buff [MAXPATH];
2187 translate_unix (char *name, int type)
2189 strncpy (filename_buff, name, MAXPATH);
2190 filename_buff [MAXPATH - 1] = (char) 0;
2194 /* Translate a Unix syntax path spec into a VMS style (comma separated list of
2198 to_host_path_spec (char *pathspec)
2200 char *curr, *next, buff [MAXPATH];
2205 /* Can't very well test for colons, since that's the Unix separator! */
2206 if (strchr (pathspec, ']') || strchr (pathspec, ','))
2209 new_host_pathspec[0] = 0;
2214 next = strchr (curr, ':');
2216 next = strchr (curr, 0);
2218 strncpy (buff, curr, next - curr);
2219 buff[next - curr] = 0;
2221 strncat (new_host_pathspec, __gnat_to_host_dir_spec (buff, 0), MAXPATH);
2224 strncat (new_host_pathspec, ",", MAXPATH);
2228 new_host_pathspec [MAXPATH - 1] = (char) 0;
2230 return new_host_pathspec;
2233 /* Translate a Unix syntax directory specification into VMS syntax. The
2234 PREFIXFLAG has no effect, but is kept for symmetry with
2235 to_canonical_dir_spec. If indicators of VMS syntax found, return input
2239 __gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
2241 int len = strlen (dirspec);
2243 strncpy (new_host_dirspec, dirspec, MAXPATH);
2244 new_host_dirspec [MAXPATH - 1] = (char) 0;
2246 if (strchr (new_host_dirspec, ']') || strchr (new_host_dirspec, ':'))
2247 return new_host_dirspec;
2249 while (len > 1 && new_host_dirspec[len - 1] == '/')
2251 new_host_dirspec[len - 1] = 0;
2255 decc$to_vms (new_host_dirspec, translate_unix, 1, 2);
2256 strncpy (new_host_dirspec, filename_buff, MAXPATH);
2257 new_host_dirspec [MAXPATH - 1] = (char) 0;
2259 return new_host_dirspec;
2262 /* Translate a Unix syntax file specification into VMS syntax.
2263 If indicators of VMS syntax found, return input string. */
2266 __gnat_to_host_file_spec (char *filespec)
2268 strncpy (new_host_filespec, "", MAXPATH);
2269 if (strchr (filespec, ']') || strchr (filespec, ':'))
2271 strncpy (new_host_filespec, filespec, MAXPATH);
2275 decc$to_vms (filespec, translate_unix, 1, 1);
2276 strncpy (new_host_filespec, filename_buff, MAXPATH);
2279 new_host_filespec [MAXPATH - 1] = (char) 0;
2281 return new_host_filespec;
2285 __gnat_adjust_os_resource_limits ()
2287 SYS$ADJWSL (131072, 0);
2292 /* Dummy functions for Osint import for non-VMS systems. */
2295 __gnat_to_canonical_file_list_init
2296 (char *dirspec ATTRIBUTE_UNUSED, int onlydirs ATTRIBUTE_UNUSED)
2302 __gnat_to_canonical_file_list_next (void)
2308 __gnat_to_canonical_file_list_free (void)
2313 __gnat_to_canonical_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
2319 __gnat_to_canonical_file_spec (char *filespec)
2325 __gnat_to_canonical_path_spec (char *pathspec)
2331 __gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
2337 __gnat_to_host_file_spec (char *filespec)
2343 __gnat_adjust_os_resource_limits (void)
2349 /* For EMX, we cannot include dummy in libgcc, since it is too difficult
2350 to coordinate this with the EMX distribution. Consequently, we put the
2351 definition of dummy which is used for exception handling, here. */
2353 #if defined (__EMX__)
2357 #if defined (__mips_vxworks)
2361 CACHE_USER_FLUSH (0, ENTIRE_CACHE);
2365 #if defined (CROSS_COMPILE) \
2366 || (! (defined (sparc) && defined (sun) && defined (__SVR4)) \
2367 && ! (defined (linux) && defined (i386)) \
2368 && ! defined (hpux) \
2369 && ! defined (_AIX) \
2370 && ! (defined (__alpha__) && defined (__osf__)) \
2371 && ! defined (__MINGW32__))
2373 /* Dummy function to satisfy g-trasym.o. Currently Solaris sparc, HP/UX,
2374 GNU/Linux x86, Tru64 & Windows provide a non-dummy version of this
2375 procedure in libaddr2line.a. */
2378 convert_addresses (void *addrs ATTRIBUTE_UNUSED,
2379 int n_addr ATTRIBUTE_UNUSED,
2380 void *buf ATTRIBUTE_UNUSED,
2381 int *len ATTRIBUTE_UNUSED)
2387 #if defined (_WIN32)
2388 int __gnat_argument_needs_quote = 1;
2390 int __gnat_argument_needs_quote = 0;
2393 /* This option is used to enable/disable object files handling from the
2394 binder file by the GNAT Project module. For example, this is disabled on
2395 Windows as it is already done by the mdll module. */
2396 #if defined (_WIN32)
2397 int __gnat_prj_add_obj_files = 0;
2399 int __gnat_prj_add_obj_files = 1;
2402 /* char used as prefix/suffix for environment variables */
2403 #if defined (_WIN32)
2404 char __gnat_environment_char = '%';
2406 char __gnat_environment_char = '$';
2409 /* This functions copy the file attributes from a source file to a
2412 mode = 0 : In this mode copy only the file time stamps (last access and
2413 last modification time stamps).
2415 mode = 1 : In this mode, time stamps and read/write/execute attributes are
2418 Returns 0 if operation was successful and -1 in case of error. */
2421 __gnat_copy_attribs (char *from, char *to, int mode)
2423 #if defined (VMS) || defined (__vxworks)
2427 struct utimbuf tbuf;
2429 if (stat (from, &fbuf) == -1)
2434 tbuf.actime = fbuf.st_atime;
2435 tbuf.modtime = fbuf.st_mtime;
2437 if (utime (to, &tbuf) == -1)
2444 if (chmod (to, fbuf.st_mode) == -1)
2454 /* This function is installed in libgcc.a. */
2455 extern void __gnat_install_locks (void (*) (void), void (*) (void));
2457 /* This function offers a hook for libgnarl to set the
2458 locking subprograms for libgcc_eh. */
2461 __gnatlib_install_locks (void (*lock) (void) ATTRIBUTE_UNUSED,
2462 void (*unlock) (void) ATTRIBUTE_UNUSED)
2465 __gnat_install_locks (lock, unlock);
2466 /* There is a bootstrap path issue if adaint is build with this
2467 symbol unresolved for the stage1 compiler. Since the compiler
2468 does not use tasking, we simply make __gnatlib_install_locks
2469 a no-op in this case. */