1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
9 * C Implementation File *
11 * Copyright (C) 1992-2002, Free Software Foundation, Inc. *
13 * GNAT is free software; you can redistribute it and/or modify it under *
14 * terms of the GNU General Public License as published by the Free Soft- *
15 * ware Foundation; either version 2, or (at your option) any later ver- *
16 * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
17 * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
18 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
19 * for more details. You should have received a copy of the GNU General *
20 * Public License distributed with GNAT; see file COPYING. If not, write *
21 * to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, *
22 * MA 02111-1307, USA. *
24 * As a special exception, if you link this file with other files to *
25 * produce an executable, this file does not by itself cause the resulting *
26 * executable to be covered by the GNU General Public License. This except- *
27 * ion does not however invalidate any other reasons why the executable *
28 * file might be covered by the GNU Public License. *
30 * GNAT was originally developed by the GNAT team at New York University. *
31 * It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). *
33 ****************************************************************************/
35 /* This file contains those routines named by Import pragmas in
36 packages in the GNAT hierarchy (especially GNAT.OS_Lib) and in
37 package Osint. Many of the subprograms in OS_Lib import standard
38 library calls directly. This file contains all other routines. */
42 /* No need to redefine exit here. */
45 /* We want to use the POSIX variants of include files. */
49 #if defined (__mips_vxworks)
51 #endif /* __mips_vxworks */
62 /* We don't have libiberty, so use malloc. */
63 #define xmalloc(S) malloc (S)
64 #define xrealloc(V,S) realloc (V,S)
71 #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
74 /* Header files and definitions for __gnat_set_file_time_name. */
86 /* Use native 64-bit arithmetic. */
87 #define unix_time_to_vms(X,Y) \
88 { unsigned long long reftime, tmptime = (X); \
89 $DESCRIPTOR (unixtime,"1-JAN-1970 0:00:00.00"); \
90 SYS$BINTIM (&unixtime, &reftime); \
91 Y = tmptime * 10000000 + reftime; }
93 /* descrip.h doesn't have everything ... */
94 struct dsc$descriptor_fib
96 unsigned long fib$l_len
;
97 struct fibdef
*fib$l_addr
;
100 /* I/O Status Block. */
103 unsigned short status
, count
;
104 unsigned long devdep
;
107 static char *tryfile
;
109 /* Variable length string. */
113 char string
[NAM$C_MAXRSS
+1];
120 #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
131 /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
132 defined in the current system. On DOS-like systems these flags control
133 whether the file is opened/created in text-translation mode (CR/LF in
134 external file mapped to LF in internal file), but in Unix-like systems,
135 no text translation is required, so these flags have no effect. */
137 #if defined (__EMX__)
153 #ifndef HOST_EXECUTABLE_SUFFIX
154 #define HOST_EXECUTABLE_SUFFIX ""
157 #ifndef HOST_OBJECT_SUFFIX
158 #define HOST_OBJECT_SUFFIX ".o"
161 #ifndef PATH_SEPARATOR
162 #define PATH_SEPARATOR ':'
165 #ifndef DIR_SEPARATOR
166 #define DIR_SEPARATOR '/'
169 char __gnat_dir_separator
= DIR_SEPARATOR
;
171 char __gnat_path_separator
= PATH_SEPARATOR
;
173 /* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
174 the base filenames that libraries specified with -lsomelib options
175 may have. This is used by GNATMAKE to check whether an executable
176 is up-to-date or not. The syntax is
178 library_template ::= { pattern ; } pattern NUL
179 pattern ::= [ prefix ] * [ postfix ]
181 These should only specify names of static libraries as it makes
182 no sense to determine at link time if dynamic-link libraries are
183 up to date or not. Any libraries that are not found are supposed
186 * if they are needed but not present, the link
189 * otherwise they are libraries in the system paths and so
190 they are considered part of the system and not checked
193 ??? This should be part of a GNAT host-specific compiler
194 file instead of being included in all user applications
195 as well. This is only a temporary work-around for 3.11b. */
197 #ifndef GNAT_LIBRARY_TEMPLATE
198 #if defined (__EMX__)
199 #define GNAT_LIBRARY_TEMPLATE "*.a"
201 #define GNAT_LIBRARY_TEMPLATE "*.olb"
203 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
207 const char *__gnat_library_template
= GNAT_LIBRARY_TEMPLATE
;
209 /* This variable is used in hostparm.ads to say whether the host is a VMS
212 const int __gnat_vmsp
= 1;
214 const int __gnat_vmsp
= 0;
217 /* The following macro HAVE_READDIR_R should be defined if the
218 system provides the routine readdir_r. */
219 #undef HAVE_READDIR_R
222 __gnat_to_gm_time (p_time
, p_year
, p_month
, p_day
, p_hours
, p_mins
, p_secs
)
223 int *p_time
, *p_year
, *p_month
, *p_day
, *p_hours
, *p_mins
, *p_secs
;
226 time_t time
= *p_time
;
229 /* On Windows systems, the time is sometimes rounded up to the nearest
230 even second, so if the number of seconds is odd, increment it. */
235 res
= gmtime (&time
);
239 *p_year
= res
->tm_year
;
240 *p_month
= res
->tm_mon
;
241 *p_day
= res
->tm_mday
;
242 *p_hours
= res
->tm_hour
;
243 *p_mins
= res
->tm_min
;
244 *p_secs
= res
->tm_sec
;
247 *p_year
= *p_month
= *p_day
= *p_hours
= *p_mins
= *p_secs
= 0;
250 /* Place the contents of the symbolic link named PATH in the buffer BUF,
251 which has size BUFSIZ. If PATH is a symbolic link, then return the number
252 of characters of its content in BUF. Otherwise, return -1. For Windows,
253 OS/2 and vxworks, always return -1. */
256 __gnat_readlink (path
, buf
, bufsiz
)
261 #if defined (MSDOS) || defined (_WIN32) || defined (__EMX__)
263 #elif defined (__INTERIX) || defined (VMS)
265 #elif defined (__vxworks)
268 return readlink (path
, buf
, bufsiz
);
272 /* Creates a symbolic link named NEWPATH which contains the string OLDPATH. If
273 NEWPATH exists it will NOT be overwritten. For Windows, OS/2, VxWorks,
274 Interix and VMS, always return -1. */
277 __gnat_symlink (oldpath
, newpath
)
281 #if defined (MSDOS) || defined (_WIN32) || defined (__EMX__)
283 #elif defined (__INTERIX) || defined (VMS)
285 #elif defined (__vxworks)
288 return symlink (oldpath
, newpath
);
292 /* Try to lock a file, return 1 if success. */
294 #if defined (__vxworks) || defined (MSDOS) || defined (_WIN32)
296 /* Version that does not use link. */
299 __gnat_try_lock (dir
, file
)
306 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
307 fd
= open (full_path
, O_CREAT
| O_EXCL
, 0600);
315 #elif defined (__EMX__) || defined (VMS)
317 /* More cases that do not use link; identical code, to solve too long
321 __gnat_try_lock (dir
, file
)
328 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
329 fd
= open (full_path
, O_CREAT
| O_EXCL
, 0600);
339 /* Version using link(), more secure over NFS. */
342 __gnat_try_lock (dir
, file
)
348 struct stat stat_result
;
351 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
352 sprintf (temp_file
, "%s-%d-%d", dir
, getpid(), getppid ());
354 /* Create the temporary file and write the process number. */
355 fd
= open (temp_file
, O_CREAT
| O_WRONLY
, 0600);
361 /* Link it with the new file. */
362 link (temp_file
, full_path
);
364 /* Count the references on the old one. If we have a count of two, then
365 the link did succeed. Remove the temporary file before returning. */
366 __gnat_stat (temp_file
, &stat_result
);
368 return stat_result
.st_nlink
== 2;
372 /* Return the maximum file name length. */
375 __gnat_get_maximum_file_name_length ()
380 if (getenv ("GNAT$EXTENDED_FILE_SPECIFICATIONS"))
389 /* Return nonzero if file names are case sensitive. */
392 __gnat_get_file_names_case_sensitive ()
394 #if defined (__EMX__) || defined (MSDOS) || defined (VMS) || defined (WINNT)
402 __gnat_get_default_identifier_character_set ()
404 #if defined (__EMX__) || defined (MSDOS)
411 /* Return the current working directory. */
414 __gnat_get_current_dir (dir
, length
)
419 /* Force Unix style, which is what GNAT uses internally. */
420 getcwd (dir
, *length
, 0);
422 getcwd (dir
, *length
);
425 *length
= strlen (dir
);
427 dir
[*length
] = DIR_SEPARATOR
;
432 /* Return the suffix for object files. */
435 __gnat_get_object_suffix_ptr (len
, value
)
439 *value
= HOST_OBJECT_SUFFIX
;
444 *len
= strlen (*value
);
449 /* Return the suffix for executable files. */
452 __gnat_get_executable_suffix_ptr (len
, value
)
456 *value
= HOST_EXECUTABLE_SUFFIX
;
460 *len
= strlen (*value
);
465 /* Return the suffix for debuggable files. Usually this is the same as the
466 executable extension. */
469 __gnat_get_debuggable_suffix_ptr (len
, value
)
474 *value
= HOST_EXECUTABLE_SUFFIX
;
476 /* On DOS, the extensionless COFF file is what gdb likes. */
483 *len
= strlen (*value
);
489 __gnat_open_read (path
, fmode
)
494 int o_fmode
= O_BINARY
;
500 /* Optional arguments mbc,deq,fop increase read performance. */
501 fd
= open (path
, O_RDONLY
| o_fmode
, 0444,
502 "mbc=16", "deq=64", "fop=tef");
503 #elif defined (__vxworks)
504 fd
= open (path
, O_RDONLY
| o_fmode
, 0444);
506 fd
= open (path
, O_RDONLY
| o_fmode
);
509 return fd
< 0 ? -1 : fd
;
512 #if defined (__EMX__)
513 #define PERM (S_IREAD | S_IWRITE)
515 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
519 __gnat_open_rw (path
, fmode
)
524 int o_fmode
= O_BINARY
;
530 fd
= open (path
, O_RDWR
| o_fmode
, PERM
,
531 "mbc=16", "deq=64", "fop=tef");
533 fd
= open (path
, O_RDWR
| o_fmode
, PERM
);
536 return fd
< 0 ? -1 : fd
;
540 __gnat_open_create (path
, fmode
)
545 int o_fmode
= O_BINARY
;
551 fd
= open (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
,
552 "mbc=16", "deq=64", "fop=tef");
554 fd
= open (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
557 return fd
< 0 ? -1 : fd
;
561 __gnat_open_append (path
, fmode
)
566 int o_fmode
= O_BINARY
;
572 fd
= open (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
,
573 "mbc=16", "deq=64", "fop=tef");
575 fd
= open (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
578 return fd
< 0 ? -1 : fd
;
581 /* Open a new file. Return error (-1) if the file already exists. */
584 __gnat_open_new (path
, fmode
)
589 int o_fmode
= O_BINARY
;
595 fd
= open (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
,
596 "mbc=16", "deq=64", "fop=tef");
598 fd
= open (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
601 return fd
< 0 ? -1 : fd
;
604 /* Open a new temp file. Return error (-1) if the file already exists.
605 Special options for VMS allow the file to be shared between parent and child
606 processes, however they really slow down output. Used in gnatchop. */
609 __gnat_open_new_temp (path
, fmode
)
614 int o_fmode
= O_BINARY
;
616 strcpy (path
, "GNAT-XXXXXX");
618 #if defined (linux) && !defined (__vxworks)
619 return mkstemp (path
);
620 #elif defined (__Lynx__)
623 if (mktemp (path
) == NULL
)
631 fd
= open (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
,
632 "rfm=stmlf", "ctx=rec", "rat=none", "shr=del,get,put,upd",
633 "mbc=16", "deq=64", "fop=tef");
635 fd
= open (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
638 return fd
< 0 ? -1 : fd
;
641 /* Return the number of bytes in the specified file. */
644 __gnat_file_length (fd
)
650 ret
= fstat (fd
, &statbuf
);
651 if (ret
|| !S_ISREG (statbuf
.st_mode
))
654 return (statbuf
.st_size
);
657 /* Create a temporary filename and put it in string pointed to by
661 __gnat_tmp_name (tmp_filename
)
668 /* tempnam tries to create a temporary file in directory pointed to by
669 TMP environment variable, in c:\temp if TMP is not set, and in
670 directory specified by P_tmpdir in stdio.h if c:\temp does not
671 exist. The filename will be created with the prefix "gnat-". */
673 pname
= (char *) tempnam ("c:\\temp", "gnat-");
675 /* If pname start with a back slash and not path information it means that
676 the filename is valid for the current working directory. */
678 if (pname
[0] == '\\')
680 strcpy (tmp_filename
, ".\\");
681 strcat (tmp_filename
, pname
+1);
684 strcpy (tmp_filename
, pname
);
689 #elif defined (linux)
690 char *tmpdir
= getenv ("TMPDIR");
693 strcpy (tmp_filename
, "/tmp/gnat-XXXXXX");
695 sprintf (tmp_filename
, "%s/gnat-XXXXXX", tmpdir
);
697 close (mkstemp(tmp_filename
));
699 tmpnam (tmp_filename
);
703 /* Read the next entry in a directory. The returned string points somewhere
707 __gnat_readdir (dirp
, buffer
)
711 /* If possible, try to use the thread-safe version. */
712 #ifdef HAVE_READDIR_R
713 if (readdir_r (dirp
, buffer
) != NULL
)
714 return ((struct dirent
*) buffer
)->d_name
;
719 struct dirent
*dirent
= readdir (dirp
);
723 strcpy (buffer
, dirent
->d_name
);
732 /* Returns 1 if readdir is thread safe, 0 otherwise. */
735 __gnat_readdir_is_thread_safe ()
737 #ifdef HAVE_READDIR_R
746 /* Returns the file modification timestamp using Win32 routines which are
747 immune against daylight saving time change. It is in fact not possible to
748 use fstat for this purpose as the DST modify the st_mtime field of the
759 unsigned long long timestamp
;
761 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
762 unsigned long long offset
= 11644473600;
764 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
765 since <Jan 1st 1601>. This function must return the number of seconds
766 since <Jan 1st 1970>. */
768 res
= GetFileTime (h
, &t_create
, &t_access
, &t_write
);
770 timestamp
= (((long long) t_write
.dwHighDateTime
<< 32)
771 + t_write
.dwLowDateTime
);
773 timestamp
= timestamp
/ 10000000 - offset
;
775 return (time_t) timestamp
;
779 /* Return a GNAT time stamp given a file name. */
782 __gnat_file_time_name (name
)
787 #if defined (__EMX__) || defined (MSDOS)
788 int fd
= open (name
, O_RDONLY
| O_BINARY
);
789 time_t ret
= __gnat_file_time_fd (fd
);
793 #elif defined (_WIN32)
794 HANDLE h
= CreateFile (name
, GENERIC_READ
, FILE_SHARE_READ
, 0,
795 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
, 0);
796 time_t ret
= win32_filetime (h
);
801 (void) __gnat_stat (name
, &statbuf
);
803 /* VMS has file versioning. */
804 return statbuf
.st_ctime
;
806 return statbuf
.st_mtime
;
811 /* Return a GNAT time stamp given a file descriptor. */
814 __gnat_file_time_fd (fd
)
817 /* The following workaround code is due to the fact that under EMX and
818 DJGPP fstat attempts to convert time values to GMT rather than keep the
819 actual OS timestamp of the file. By using the OS2/DOS functions directly
820 the GNAT timestamp are independent of this behavior, which is desired to
821 facilitate the distribution of GNAT compiled libraries. */
823 #if defined (__EMX__) || defined (MSDOS)
827 int ret
= DosQueryFileInfo (fd
, 1, (unsigned char *) &fs
,
828 sizeof (FILESTATUS
));
830 unsigned file_year
= fs
.fdateLastWrite
.year
;
831 unsigned file_month
= fs
.fdateLastWrite
.month
;
832 unsigned file_day
= fs
.fdateLastWrite
.day
;
833 unsigned file_hour
= fs
.ftimeLastWrite
.hours
;
834 unsigned file_min
= fs
.ftimeLastWrite
.minutes
;
835 unsigned file_tsec
= fs
.ftimeLastWrite
.twosecs
;
839 int ret
= getftime (fd
, &fs
);
841 unsigned file_year
= fs
.ft_year
;
842 unsigned file_month
= fs
.ft_month
;
843 unsigned file_day
= fs
.ft_day
;
844 unsigned file_hour
= fs
.ft_hour
;
845 unsigned file_min
= fs
.ft_min
;
846 unsigned file_tsec
= fs
.ft_tsec
;
849 /* Calculate the seconds since epoch from the time components. First count
850 the whole days passed. The value for years returned by the DOS and OS2
851 functions count years from 1980, so to compensate for the UNIX epoch which
852 begins in 1970 start with 10 years worth of days and add days for each
853 four year period since then. */
856 int cum_days
[12] = {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
857 int days_passed
= 3652 + (file_year
/ 4) * 1461;
858 int years_since_leap
= file_year
% 4;
860 if (years_since_leap
== 1)
862 else if (years_since_leap
== 2)
864 else if (years_since_leap
== 3)
870 days_passed
+= cum_days
[file_month
- 1];
871 if (years_since_leap
== 0 && file_year
!= 20 && file_month
> 2)
874 days_passed
+= file_day
- 1;
876 /* OK - have whole days. Multiply -- then add in other parts. */
878 tot_secs
= days_passed
* 86400;
879 tot_secs
+= file_hour
* 3600;
880 tot_secs
+= file_min
* 60;
881 tot_secs
+= file_tsec
* 2;
884 #elif defined (_WIN32)
885 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
886 time_t ret
= win32_filetime (h
);
892 (void) fstat (fd
, &statbuf
);
895 /* VMS has file versioning. */
896 return statbuf
.st_ctime
;
898 return statbuf
.st_mtime
;
903 /* Set the file time stamp. */
906 __gnat_set_file_time_name (name
, time_stamp
)
910 #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32) \
911 || defined (__vxworks)
913 /* Code to implement __gnat_set_file_time_name for these systems. */
921 unsigned long long backup
, create
, expire
, revise
;
925 unsigned short value
;
934 } Fat
= { 0, 0, 0, 0, 0, { 0 }};
938 { ATR$S_CREDATE
, ATR$C_CREDATE
, &Fat
.create
},
939 { ATR$S_REVDATE
, ATR$C_REVDATE
, &Fat
.revise
},
940 { ATR$S_EXPDATE
, ATR$C_EXPDATE
, &Fat
.expire
},
941 { ATR$S_BAKDATE
, ATR$C_BAKDATE
, &Fat
.backup
},
942 { ATR$S_FPRO
, ATR$C_FPRO
, &Fat
.prot
},
943 { ATR$S_UIC
, ATR$C_UIC
, &Fat
.uic
},
948 struct dsc$descriptor_fib fibdsc
= {sizeof (fib
), (void *) &fib
};
952 unsigned long long newtime
;
953 unsigned long long revtime
;
958 struct dsc$descriptor_s filedsc
959 = {NAM$C_MAXRSS
, DSC$K_DTYPE_T
, DSC$K_CLASS_S
, (void *) file
.string
};
960 struct vstring device
;
961 struct dsc$descriptor_s devicedsc
962 = {NAM$C_MAXRSS
, DSC$K_DTYPE_T
, DSC$K_CLASS_S
, (void *) device
.string
};
963 struct vstring timev
;
964 struct dsc$descriptor_s timedsc
965 = {NAM$C_MAXRSS
, DSC$K_DTYPE_T
, DSC$K_CLASS_S
, (void *) timev
.string
};
966 struct vstring result
;
967 struct dsc$descriptor_s resultdsc
968 = {NAM$C_MAXRSS
, DSC$K_DTYPE_VT
, DSC$K_CLASS_VS
, (void *) result
.string
};
970 tryfile
= (char *) __gnat_to_host_dir_spec (name
, 0);
972 /* Allocate and initialize a FAB and NAM structures. */
976 nam
.nam$l_esa
= file
.string
;
977 nam
.nam$b_ess
= NAM$C_MAXRSS
;
978 nam
.nam$l_rsa
= result
.string
;
979 nam
.nam$b_rss
= NAM$C_MAXRSS
;
980 fab
.fab$l_fna
= tryfile
;
981 fab
.fab$b_fns
= strlen (tryfile
);
982 fab
.fab$l_nam
= &nam
;
984 /* Validate filespec syntax and device existence. */
985 status
= SYS$
PARSE (&fab
, 0, 0);
986 if ((status
& 1) != 1)
989 file
.string
[nam
.nam$b_esl
] = 0;
991 /* Find matching filespec. */
992 status
= SYS$
SEARCH (&fab
, 0, 0);
993 if ((status
& 1) != 1)
996 file
.string
[nam
.nam$b_esl
] = 0;
997 result
.string
[result
.length
=nam
.nam$b_rsl
] = 0;
999 /* Get the device name and assign an IO channel. */
1000 strncpy (device
.string
, nam
.nam$l_dev
, nam
.nam$b_dev
);
1001 devicedsc
.dsc$w_length
= nam
.nam$b_dev
;
1003 status
= SYS$
ASSIGN (&devicedsc
, &chan
, 0, 0, 0);
1004 if ((status
& 1) != 1)
1005 LIB$
SIGNAL (status
);
1007 /* Initialize the FIB and fill in the directory id field. */
1008 memset (&fib
, 0, sizeof (fib
));
1009 fib
.fib$w_did
[0] = nam
.nam$w_did
[0];
1010 fib
.fib$w_did
[1] = nam
.nam$w_did
[1];
1011 fib
.fib$w_did
[2] = nam
.nam$w_did
[2];
1012 fib
.fib$l_acctl
= 0;
1014 strcpy (file
.string
, (strrchr (result
.string
, ']') + 1));
1015 filedsc
.dsc$w_length
= strlen (file
.string
);
1016 result
.string
[result
.length
= 0] = 0;
1018 /* Open and close the file to fill in the attributes. */
1020 = SYS$
QIOW (0, chan
, IO$_ACCESS
|IO$M_ACCESS
, &iosb
, 0, 0,
1021 &fibdsc
, &filedsc
, &result
.length
, &resultdsc
, &atrlst
, 0);
1022 if ((status
& 1) != 1)
1023 LIB$
SIGNAL (status
);
1024 if ((iosb
.status
& 1) != 1)
1025 LIB$
SIGNAL (iosb
.status
);
1027 result
.string
[result
.length
] = 0;
1028 status
= SYS$
QIOW (0, chan
, IO$_DEACCESS
, &iosb
, 0, 0, &fibdsc
, 0, 0, 0,
1030 if ((status
& 1) != 1)
1031 LIB$
SIGNAL (status
);
1032 if ((iosb
.status
& 1) != 1)
1033 LIB$
SIGNAL (iosb
.status
);
1039 ts
= localtime (&time_stamp
);
1041 /* Set creation time to requested time. */
1042 unix_time_to_vms (time_stamp
+ ts
->tm_gmtoff
, newtime
);
1044 t
= time ((time_t) 0);
1045 ts
= localtime (&t
);
1047 /* Set revision time to now in local time. */
1048 unix_time_to_vms (t
+ ts
->tm_gmtoff
, revtime
);
1051 /* Reopen the file, modify the times and then close. */
1052 fib
.fib$l_acctl
= FIB$M_WRITE
;
1054 = SYS$
QIOW (0, chan
, IO$_ACCESS
|IO$M_ACCESS
, &iosb
, 0, 0,
1055 &fibdsc
, &filedsc
, &result
.length
, &resultdsc
, &atrlst
, 0);
1056 if ((status
& 1) != 1)
1057 LIB$
SIGNAL (status
);
1058 if ((iosb
.status
& 1) != 1)
1059 LIB$
SIGNAL (iosb
.status
);
1061 Fat
.create
= newtime
;
1062 Fat
.revise
= revtime
;
1064 status
= SYS$
QIOW (0, chan
, IO$_DEACCESS
, &iosb
, 0, 0,
1065 &fibdsc
, 0, 0, 0, &atrlst
, 0);
1066 if ((status
& 1) != 1)
1067 LIB$
SIGNAL (status
);
1068 if ((iosb
.status
& 1) != 1)
1069 LIB$
SIGNAL (iosb
.status
);
1071 /* Deassign the channel and exit. */
1072 status
= SYS$
DASSGN (chan
);
1073 if ((status
& 1) != 1)
1074 LIB$
SIGNAL (status
);
1076 struct utimbuf utimbuf
;
1079 /* Set modification time to requested time. */
1080 utimbuf
.modtime
= time_stamp
;
1082 /* Set access time to now in local time. */
1083 t
= time ((time_t) 0);
1084 utimbuf
.actime
= mktime (localtime (&t
));
1086 utime (name
, &utimbuf
);
1091 __gnat_get_env_value_ptr (name
, len
, value
)
1096 *value
= getenv (name
);
1100 *len
= strlen (*value
);
1105 /* VMS specific declarations for set_env_value. */
1109 static char *to_host_path_spec
PARAMS ((char *));
1113 unsigned short len
, mbz
;
1117 typedef struct _ile3
1119 unsigned short len
, code
;
1121 unsigned short *retlen_adr
;
1127 __gnat_set_env_value (name
, value
)
1134 struct descriptor_s name_desc
;
1135 /* Put in JOB table for now, so that the project stuff at least works. */
1136 struct descriptor_s table_desc
= {7, 0, "LNM$JOB"};
1137 char *host_pathspec
= to_host_path_spec (value
);
1138 char *copy_pathspec
;
1139 int num_dirs_in_pathspec
= 1;
1142 if (*host_pathspec
== 0)
1145 name_desc
.len
= strlen (name
);
1147 name_desc
.adr
= name
;
1149 ptr
= host_pathspec
;
1152 num_dirs_in_pathspec
++;
1156 ile_s
*ile_array
= alloca (sizeof (ile_s
) * (num_dirs_in_pathspec
+ 1));
1157 char *copy_pathspec
= alloca (strlen (host_pathspec
) + 1);
1160 strcpy (copy_pathspec
, host_pathspec
);
1161 curr
= copy_pathspec
;
1162 for (i
= 0; i
< num_dirs_in_pathspec
; i
++)
1164 next
= strchr (curr
, ',');
1166 next
= strchr (curr
, 0);
1169 ile_array
[i
].len
= strlen (curr
);
1171 /* Code 2 from lnmdef.h means its a string. */
1172 ile_array
[i
].code
= 2;
1173 ile_array
[i
].adr
= curr
;
1175 /* retlen_adr is ignored. */
1176 ile_array
[i
].retlen_adr
= 0;
1180 /* Terminating item must be zero. */
1181 ile_array
[i
].len
= 0;
1182 ile_array
[i
].code
= 0;
1183 ile_array
[i
].adr
= 0;
1184 ile_array
[i
].retlen_adr
= 0;
1186 status
= LIB$
SET_LOGICAL (&name_desc
, 0, &table_desc
, 0, ile_array
);
1187 if ((status
& 1) != 1)
1188 LIB$
SIGNAL (status
);
1192 int size
= strlen (name
) + strlen (value
) + 2;
1195 expression
= (char *) xmalloc (size
* sizeof (char));
1197 sprintf (expression
, "%s=%s", name
, value
);
1198 putenv (expression
);
1203 #include <windows.h>
1206 /* Get the list of installed standard libraries from the
1207 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1211 __gnat_get_libraries_from_registry ()
1213 char *result
= (char *) "";
1215 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_COMPILE)
1218 DWORD name_size
, value_size
;
1225 /* First open the key. */
1226 res
= RegOpenKeyExA (HKEY_LOCAL_MACHINE
, "SOFTWARE", 0, KEY_READ
, ®_key
);
1228 if (res
== ERROR_SUCCESS
)
1229 res
= RegOpenKeyExA (reg_key
, "Ada Core Technologies", 0,
1230 KEY_READ
, ®_key
);
1232 if (res
== ERROR_SUCCESS
)
1233 res
= RegOpenKeyExA (reg_key
, "GNAT", 0, KEY_READ
, ®_key
);
1235 if (res
== ERROR_SUCCESS
)
1236 res
= RegOpenKeyExA (reg_key
, "Standard Libraries", 0, KEY_READ
, ®_key
);
1238 /* If the key exists, read out all the values in it and concatenate them
1240 for (index
= 0; res
== ERROR_SUCCESS
; index
++)
1242 value_size
= name_size
= 256;
1243 res
= RegEnumValue (reg_key
, index
, name
, &name_size
, 0,
1244 &type
, value
, &value_size
);
1246 if (res
== ERROR_SUCCESS
&& type
== REG_SZ
)
1248 char *old_result
= result
;
1250 result
= (char *) xmalloc (strlen (old_result
) + value_size
+ 2);
1251 strcpy (result
, old_result
);
1252 strcat (result
, value
);
1253 strcat (result
, ";");
1257 /* Remove the trailing ";". */
1259 result
[strlen (result
) - 1] = 0;
1266 __gnat_stat (name
, statbuf
)
1268 struct stat
*statbuf
;
1271 /* Under Windows the directory name for the stat function must not be
1272 terminated by a directory separator except if just after a drive name. */
1273 int name_len
= strlen (name
);
1274 char last_char
= name
[name_len
- 1];
1275 char win32_name
[4096];
1277 strcpy (win32_name
, name
);
1279 while (name_len
> 1 && (last_char
== '\\' || last_char
== '/'))
1281 win32_name
[name_len
- 1] = '\0';
1283 last_char
= win32_name
[name_len
- 1];
1286 if (name_len
== 2 && win32_name
[1] == ':')
1287 strcat (win32_name
, "\\");
1289 return stat (win32_name
, statbuf
);
1292 return stat (name
, statbuf
);
1297 __gnat_file_exists (name
)
1300 struct stat statbuf
;
1302 return !__gnat_stat (name
, &statbuf
);
1306 __gnat_is_absolute_path (name
)
1309 return (*name
== '/' || *name
== DIR_SEPARATOR
1310 #if defined (__EMX__) || defined (MSDOS) || defined (WINNT)
1311 || strlen (name
) > 1 && isalpha (name
[0]) && name
[1] == ':'
1317 __gnat_is_regular_file (name
)
1321 struct stat statbuf
;
1323 ret
= __gnat_stat (name
, &statbuf
);
1324 return (!ret
&& S_ISREG (statbuf
.st_mode
));
1328 __gnat_is_directory (name
)
1332 struct stat statbuf
;
1334 ret
= __gnat_stat (name
, &statbuf
);
1335 return (!ret
&& S_ISDIR (statbuf
.st_mode
));
1339 __gnat_is_writable_file (name
)
1344 struct stat statbuf
;
1346 ret
= __gnat_stat (name
, &statbuf
);
1347 mode
= statbuf
.st_mode
& S_IWUSR
;
1348 return (!ret
&& mode
);
1352 /* Defined in VMS header files. */
1353 #define fork() (decc$$alloc_vfork_blocks() >= 0 ? \
1354 LIB$GET_CURRENT_INVO_CONTEXT (decc$$get_vfork_jmpbuf()) : -1)
1357 #if defined (sun) && defined (__SVR4)
1358 /* Using fork on Solaris will duplicate all the threads. fork1, which
1359 duplicates only the active thread, must be used instead, or spawning
1360 subprocess from a program with tasking will lead into numerous problems. */
1365 __gnat_portable_spawn (args
)
1372 #if defined (MSDOS) || defined (_WIN32)
1373 status
= spawnvp (P_WAIT
, args
[0], args
);
1379 #elif defined (__vxworks)
1384 pid
= spawnvp (P_NOWAIT
, args
[0], args
);
1396 if (execv (args
[0], args
) != 0)
1398 return -1; /* execv is in parent context on VMS. */
1406 finished
= waitpid (pid
, &status
, 0);
1408 if (finished
!= pid
|| WIFEXITED (status
) == 0)
1411 return WEXITSTATUS (status
);
1417 /* WIN32 code to implement a wait call that wait for any child process. */
1421 /* Synchronization code, to be thread safe. */
1423 static CRITICAL_SECTION plist_cs
;
1426 __gnat_plist_init ()
1428 InitializeCriticalSection (&plist_cs
);
1434 EnterCriticalSection (&plist_cs
);
1440 LeaveCriticalSection (&plist_cs
);
1443 typedef struct _process_list
1446 struct _process_list
*next
;
1449 static Process_List
*PLIST
= NULL
;
1451 static int plist_length
= 0;
1459 pl
= (Process_List
*) xmalloc (sizeof (Process_List
));
1463 /* -------------------- critical section -------------------- */
1468 /* -------------------- critical section -------------------- */
1473 void remove_handle (h
)
1476 Process_List
*pl
, *prev
;
1480 /* -------------------- critical section -------------------- */
1489 prev
->next
= pl
->next
;
1501 /* -------------------- critical section -------------------- */
1507 win32_no_block_spawn (command
, args
)
1513 PROCESS_INFORMATION PI
;
1514 SECURITY_ATTRIBUTES SA
;
1519 /* compute the total command line length */
1523 csize
+= strlen (args
[k
]) + 1;
1527 full_command
= (char *) xmalloc (csize
);
1530 SI
.cb
= sizeof (STARTUPINFO
);
1531 SI
.lpReserved
= NULL
;
1532 SI
.lpReserved2
= NULL
;
1533 SI
.lpDesktop
= NULL
;
1537 SI
.wShowWindow
= SW_HIDE
;
1539 /* Security attributes. */
1540 SA
.nLength
= sizeof (SECURITY_ATTRIBUTES
);
1541 SA
.bInheritHandle
= TRUE
;
1542 SA
.lpSecurityDescriptor
= NULL
;
1544 /* Prepare the command string. */
1545 strcpy (full_command
, command
);
1546 strcat (full_command
, " ");
1551 strcat (full_command
, args
[k
]);
1552 strcat (full_command
, " ");
1556 result
= CreateProcess (NULL
, (char *) full_command
, &SA
, NULL
, TRUE
,
1557 NORMAL_PRIORITY_CLASS
, NULL
, NULL
, &SI
, &PI
);
1559 free (full_command
);
1563 add_handle (PI
.hProcess
);
1564 CloseHandle (PI
.hThread
);
1565 return (int) PI
.hProcess
;
1582 if (plist_length
== 0)
1588 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * plist_length
);
1593 /* -------------------- critical section -------------------- */
1600 /* -------------------- critical section -------------------- */
1604 res
= WaitForMultipleObjects (plist_length
, hl
, FALSE
, INFINITE
);
1605 h
= hl
[res
- WAIT_OBJECT_0
];
1610 GetExitCodeProcess (h
, &exitcode
);
1613 *status
= (int) exitcode
;
1620 __gnat_portable_no_block_spawn (args
)
1625 #if defined (__EMX__) || defined (MSDOS)
1627 /* ??? For PC machines I (Franco) don't know the system calls to implement
1628 this routine. So I'll fake it as follows. This routine will behave
1629 exactly like the blocking portable_spawn and will systematically return
1630 a pid of 0 unless the spawned task did not complete successfully, in
1631 which case we return a pid of -1. To synchronize with this the
1632 portable_wait below systematically returns a pid of 0 and reports that
1633 the subprocess terminated successfully. */
1635 if (spawnvp (P_WAIT
, args
[0], args
) != 0)
1638 #elif defined (_WIN32)
1640 pid
= win32_no_block_spawn (args
[0], args
);
1643 #elif defined (__vxworks)
1652 if (execv (args
[0], args
) != 0)
1654 return -1; /* execv is in parent context on VMS. */
1666 __gnat_portable_wait (process_status
)
1667 int *process_status
;
1672 #if defined (_WIN32)
1674 pid
= win32_wait (&status
);
1676 #elif defined (__EMX__) || defined (MSDOS)
1677 /* ??? See corresponding comment in portable_no_block_spawn. */
1679 #elif defined (__vxworks)
1680 /* Not sure what to do here, so do same as __EMX__ case, i.e., nothing but
1684 pid
= waitpid (-1, &status
, 0);
1685 status
= status
& 0xffff;
1688 *process_status
= status
;
1693 __gnat_waitpid (pid
)
1698 #if defined (_WIN32)
1699 cwait (&status
, pid
, _WAIT_CHILD
);
1700 #elif defined (__EMX__) || defined (MSDOS) || defined (__vxworks)
1701 /* Status is already zero, so nothing to do. */
1703 waitpid (pid
, &status
, 0);
1704 status
= WEXITSTATUS (status
);
1711 __gnat_os_exit (status
)
1715 /* Exit without changing 0 to 1. */
1716 __posix_exit (status
);
1722 /* Locate a regular file, give a Path value. */
1725 __gnat_locate_regular_file (file_name
, path_val
)
1731 /* Handle absolute pathnames. */
1732 for (ptr
= file_name
; *ptr
&& *ptr
!= '/' && *ptr
!= DIR_SEPARATOR
; ptr
++)
1736 #if defined (__EMX__) || defined (MSDOS) || defined (WINNT)
1737 || isalpha (file_name
[0]) && file_name
[1] == ':'
1741 if (__gnat_is_regular_file (file_name
))
1742 return xstrdup (file_name
);
1751 /* The result has to be smaller than path_val + file_name. */
1752 char *file_path
= alloca (strlen (path_val
) + strlen (file_name
) + 2);
1756 for (; *path_val
== PATH_SEPARATOR
; path_val
++)
1762 for (ptr
= file_path
; *path_val
&& *path_val
!= PATH_SEPARATOR
; )
1763 *ptr
++ = *path_val
++;
1766 if (*ptr
!= '/' && *ptr
!= DIR_SEPARATOR
)
1767 *++ptr
= DIR_SEPARATOR
;
1769 strcpy (++ptr
, file_name
);
1771 if (__gnat_is_regular_file (file_path
))
1772 return xstrdup (file_path
);
1779 /* Locate an executable given a Path argument. This routine is only used by
1780 gnatbl and should not be used otherwise. Use locate_exec_on_path
1784 __gnat_locate_exec (exec_name
, path_val
)
1788 if (!strstr (exec_name
, HOST_EXECUTABLE_SUFFIX
))
1790 char *full_exec_name
1791 = alloca (strlen (exec_name
) + strlen (HOST_EXECUTABLE_SUFFIX
) + 1);
1793 strcpy (full_exec_name
, exec_name
);
1794 strcat (full_exec_name
, HOST_EXECUTABLE_SUFFIX
);
1795 return __gnat_locate_regular_file (full_exec_name
, path_val
);
1798 return __gnat_locate_regular_file (exec_name
, path_val
);
1801 /* Locate an executable using the Systems default PATH. */
1804 __gnat_locate_exec_on_path (exec_name
)
1808 char *path_val
= "/VAXC$PATH";
1810 char *path_val
= getenv ("PATH");
1812 char *apath_val
= alloca (strlen (path_val
) + 1);
1814 strcpy (apath_val
, path_val
);
1815 return __gnat_locate_exec (exec_name
, apath_val
);
1820 /* These functions are used to translate to and from VMS and Unix syntax
1821 file, directory and path specifications. */
1823 #define MAXNAMES 256
1824 #define NEW_CANONICAL_FILELIST_INCREMENT 64
1826 static char new_canonical_dirspec
[255];
1827 static char new_canonical_filespec
[255];
1828 static char new_canonical_pathspec
[MAXNAMES
*255];
1829 static unsigned new_canonical_filelist_index
;
1830 static unsigned new_canonical_filelist_in_use
;
1831 static unsigned new_canonical_filelist_allocated
;
1832 static char **new_canonical_filelist
;
1833 static char new_host_pathspec
[MAXNAMES
*255];
1834 static char new_host_dirspec
[255];
1835 static char new_host_filespec
[255];
1837 /* Routine is called repeatedly by decc$from_vms via
1838 __gnat_to_canonical_file_list_init until it returns 0 or the expansion runs
1842 wildcard_translate_unix (name
)
1848 strcpy (buff
, name
);
1849 ver
= strrchr (buff
, '.');
1851 /* Chop off the version. */
1855 /* Dynamically extend the allocation by the increment. */
1856 if (new_canonical_filelist_in_use
== new_canonical_filelist_allocated
)
1858 new_canonical_filelist_allocated
+= NEW_CANONICAL_FILELIST_INCREMENT
;
1859 new_canonical_filelist
= (char **) xrealloc
1860 (new_canonical_filelist
,
1861 new_canonical_filelist_allocated
* sizeof (char *));
1864 new_canonical_filelist
[new_canonical_filelist_in_use
++] = xstrdup (buff
);
1869 /* Translate a wildcard VMS file spec into a list of Unix file specs. First do
1870 full translation and copy the results into a list (_init), then return them
1871 one at a time (_next). If onlydirs set, only expand directory files. */
1874 __gnat_to_canonical_file_list_init (filespec
, onlydirs
)
1881 len
= strlen (filespec
);
1882 strcpy (buff
, filespec
);
1884 /* Only look for directories. */
1885 if (onlydirs
&& !strstr (&buff
[len
- 5], "*.dir"))
1886 strcat (buff
, "*.dir");
1888 decc$
from_vms (buff
, wildcard_translate_unix
, 1);
1890 /* Remove the .dir extension. */
1896 for (i
= 0; i
< new_canonical_filelist_in_use
; i
++)
1898 ext
= strstr (new_canonical_filelist
[i
], ".dir");
1904 return new_canonical_filelist_in_use
;
1907 /* Return the next filespec in the list. */
1910 __gnat_to_canonical_file_list_next ()
1912 return new_canonical_filelist
[new_canonical_filelist_index
++];
1915 /* Free storage used in the wildcard expansion. */
1918 __gnat_to_canonical_file_list_free ()
1922 for (i
= 0; i
< new_canonical_filelist_in_use
; i
++)
1923 free (new_canonical_filelist
[i
]);
1925 free (new_canonical_filelist
);
1927 new_canonical_filelist_in_use
= 0;
1928 new_canonical_filelist_allocated
= 0;
1929 new_canonical_filelist_index
= 0;
1930 new_canonical_filelist
= 0;
1933 /* Translate a VMS syntax directory specification in to Unix syntax. If
1934 PREFIXFLAG is set, append an underscore "/". If no indicators of VMS syntax
1935 found, return input string. Also translate a dirname that contains no
1936 slashes, in case it's a logical name. */
1939 __gnat_to_canonical_dir_spec (dirspec
, prefixflag
)
1945 strcpy (new_canonical_dirspec
, "");
1946 if (strlen (dirspec
))
1950 if (strchr (dirspec
, ']') || strchr (dirspec
, ':'))
1951 strcpy (new_canonical_dirspec
, (char *) decc$
translate_vms (dirspec
));
1952 else if (!strchr (dirspec
, '/') && (dirspec1
= getenv (dirspec
)) != 0)
1953 strcpy (new_canonical_dirspec
, (char *) decc$
translate_vms (dirspec1
));
1955 strcpy (new_canonical_dirspec
, dirspec
);
1958 len
= strlen (new_canonical_dirspec
);
1959 if (prefixflag
&& new_canonical_dirspec
[len
- 1] != '/')
1960 strcat (new_canonical_dirspec
, "/");
1962 return new_canonical_dirspec
;
1966 /* Translate a VMS syntax file specification into Unix syntax.
1967 If no indicators of VMS syntax found, return input string. */
1970 __gnat_to_canonical_file_spec (filespec
)
1973 strcpy (new_canonical_filespec
, "");
1974 if (strchr (filespec
, ']') || strchr (filespec
, ':'))
1975 strcpy (new_canonical_filespec
, (char *) decc$
translate_vms (filespec
));
1977 strcpy (new_canonical_filespec
, filespec
);
1979 return new_canonical_filespec
;
1982 /* Translate a VMS syntax path specification into Unix syntax.
1983 If no indicators of VMS syntax found, return input string. */
1986 __gnat_to_canonical_path_spec (pathspec
)
1989 char *curr
, *next
, buff
[256];
1994 /* If there are /'s, assume it's a Unix path spec and return. */
1995 if (strchr (pathspec
, '/'))
1998 new_canonical_pathspec
[0] = 0;
2003 next
= strchr (curr
, ',');
2005 next
= strchr (curr
, 0);
2007 strncpy (buff
, curr
, next
- curr
);
2008 buff
[next
- curr
] = 0;
2010 /* Check for wildcards and expand if present. */
2011 if (strchr (buff
, '*') || strchr (buff
, '%') || strstr (buff
, "..."))
2015 dirs
= __gnat_to_canonical_file_list_init (buff
, 1);
2016 for (i
= 0; i
< dirs
; i
++)
2020 next_dir
= __gnat_to_canonical_file_list_next ();
2021 strcat (new_canonical_pathspec
, next_dir
);
2023 /* Don't append the separator after the last expansion. */
2025 strcat (new_canonical_pathspec
, ":");
2028 __gnat_to_canonical_file_list_free ();
2031 strcat (new_canonical_pathspec
,
2032 __gnat_to_canonical_dir_spec (buff
, 0));
2037 strcat (new_canonical_pathspec
, ":");
2041 return new_canonical_pathspec
;
2044 static char filename_buff
[256];
2047 translate_unix (name
, type
)
2051 strcpy (filename_buff
, name
);
2055 /* Translate a Unix syntax path spec into a VMS style (comma separated list of
2059 to_host_path_spec (pathspec
)
2062 char *curr
, *next
, buff
[256];
2067 /* Can't very well test for colons, since that's the Unix separator! */
2068 if (strchr (pathspec
, ']') || strchr (pathspec
, ','))
2071 new_host_pathspec
[0] = 0;
2076 next
= strchr (curr
, ':');
2078 next
= strchr (curr
, 0);
2080 strncpy (buff
, curr
, next
- curr
);
2081 buff
[next
- curr
] = 0;
2083 strcat (new_host_pathspec
, __gnat_to_host_dir_spec (buff
, 0));
2086 strcat (new_host_pathspec
, ",");
2090 return new_host_pathspec
;
2093 /* Translate a Unix syntax directory specification into VMS syntax. The
2094 PREFIXFLAG has no effect, but is kept for symmetry with
2095 to_canonical_dir_spec. If indicators of VMS syntax found, return input
2099 __gnat_to_host_dir_spec (dirspec
, prefixflag
)
2101 int prefixflag ATTRIBUTE_UNUSED
;
2103 int len
= strlen (dirspec
);
2105 strcpy (new_host_dirspec
, dirspec
);
2107 if (strchr (new_host_dirspec
, ']') || strchr (new_host_dirspec
, ':'))
2108 return new_host_dirspec
;
2110 while (len
> 1 && new_host_dirspec
[len
- 1] == '/')
2112 new_host_dirspec
[len
- 1] = 0;
2116 decc$
to_vms (new_host_dirspec
, translate_unix
, 1, 2);
2117 strcpy (new_host_dirspec
, filename_buff
);
2119 return new_host_dirspec
;
2123 /* Translate a Unix syntax file specification into VMS syntax.
2124 If indicators of VMS syntax found, return input string. */
2127 __gnat_to_host_file_spec (filespec
)
2130 strcpy (new_host_filespec
, "");
2131 if (strchr (filespec
, ']') || strchr (filespec
, ':'))
2132 strcpy (new_host_filespec
, filespec
);
2135 decc$
to_vms (filespec
, translate_unix
, 1, 1);
2136 strcpy (new_host_filespec
, filename_buff
);
2139 return new_host_filespec
;
2143 __gnat_adjust_os_resource_limits ()
2145 SYS$
ADJWSL (131072, 0);
2150 /* Dummy functions for Osint import for non-VMS systems. */
2153 __gnat_to_canonical_file_list_init (dirspec
, onlydirs
)
2154 char *dirspec ATTRIBUTE_UNUSED
;
2155 int onlydirs ATTRIBUTE_UNUSED
;
2161 __gnat_to_canonical_file_list_next ()
2167 __gnat_to_canonical_file_list_free ()
2172 __gnat_to_canonical_dir_spec (dirspec
, prefixflag
)
2174 int prefixflag ATTRIBUTE_UNUSED
;
2180 __gnat_to_canonical_file_spec (filespec
)
2187 __gnat_to_canonical_path_spec (pathspec
)
2194 __gnat_to_host_dir_spec (dirspec
, prefixflag
)
2196 int prefixflag ATTRIBUTE_UNUSED
;
2202 __gnat_to_host_file_spec (filespec
)
2209 __gnat_adjust_os_resource_limits ()
2215 /* For EMX, we cannot include dummy in libgcc, since it is too difficult
2216 to coordinate this with the EMX distribution. Consequently, we put the
2217 definition of dummy which is used for exception handling, here. */
2219 #if defined (__EMX__)
2223 #if defined (__mips_vxworks)
2226 CACHE_USER_FLUSH (0, ENTIRE_CACHE
);
2230 #if defined (CROSS_COMPILE) \
2231 || (! (defined (sparc) && defined (sun) && defined (__SVR4)) \
2232 && ! defined (linux) \
2233 && ! defined (hpux) \
2234 && ! (defined (__alpha__) && defined (__osf__)) \
2235 && ! defined (__MINGW32__))
2237 /* Dummy function to satisfy g-trasym.o. Currently Solaris sparc, HP/UX,
2238 GNU/Linux, Tru64 & Windows provide a non-dummy version of this procedure in
2242 convert_addresses (addrs
, n_addr
, buf
, len
)
2243 void *addrs ATTRIBUTE_UNUSED
;
2244 int n_addr ATTRIBUTE_UNUSED
;
2245 void *buf ATTRIBUTE_UNUSED
;
2252 #if defined (_WIN32)
2253 int __gnat_argument_needs_quote
= 1;
2255 int __gnat_argument_needs_quote
= 0;