1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
8 * C Implementation File *
10 * Copyright (C) 1992-2002, Free Software Foundation, Inc. *
12 * GNAT is free software; you can redistribute it and/or modify it under *
13 * terms of the GNU General Public License as published by the Free Soft- *
14 * ware Foundation; either version 2, or (at your option) any later ver- *
15 * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
16 * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
17 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
18 * for more details. You should have received a copy of the GNU General *
19 * Public License distributed with GNAT; see file COPYING. If not, write *
20 * to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, *
21 * MA 02111-1307, USA. *
23 * As a special exception, if you link this file with other files to *
24 * produce an executable, this file does not by itself cause the resulting *
25 * executable to be covered by the GNU General Public License. This except- *
26 * ion does not however invalidate any other reasons why the executable *
27 * file might be covered by the GNU Public License. *
29 * GNAT was originally developed by the GNAT team at New York University. *
30 * Extensive contributions were provided by Ada Core Technologies Inc. *
32 ****************************************************************************/
34 /* This file contains those routines named by Import pragmas in
35 packages in the GNAT hierarchy (especially GNAT.OS_Lib) and in
36 package Osint. Many of the subprograms in OS_Lib import standard
37 library calls directly. This file contains all other routines. */
41 /* No need to redefine exit here. */
44 /* We want to use the POSIX variants of include files. */
48 #if defined (__mips_vxworks)
50 #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)
70 #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
73 /* Header files and definitions for __gnat_set_file_time_name. */
85 /* Use native 64-bit arithmetic. */
86 #define unix_time_to_vms(X,Y) \
87 { unsigned long long reftime, tmptime = (X); \
88 $DESCRIPTOR (unixtime,"1-JAN-1970 0:00:00.00"); \
89 SYS$BINTIM (&unixtime, &reftime); \
90 Y = tmptime * 10000000 + reftime; }
92 /* descrip.h doesn't have everything ... */
93 struct dsc$descriptor_fib
95 unsigned long fib$l_len
;
96 struct fibdef
*fib$l_addr
;
99 /* I/O Status Block. */
102 unsigned short status
, count
;
103 unsigned long devdep
;
106 static char *tryfile
;
108 /* Variable length string. */
112 char string
[NAM$C_MAXRSS
+1];
119 #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
130 /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
131 defined in the current system. On DOS-like systems these flags control
132 whether the file is opened/created in text-translation mode (CR/LF in
133 external file mapped to LF in internal file), but in Unix-like systems,
134 no text translation is required, so these flags have no effect. */
136 #if defined (__EMX__)
152 #ifndef HOST_EXECUTABLE_SUFFIX
153 #define HOST_EXECUTABLE_SUFFIX ""
156 #ifndef HOST_OBJECT_SUFFIX
157 #define HOST_OBJECT_SUFFIX ".o"
160 #ifndef PATH_SEPARATOR
161 #define PATH_SEPARATOR ':'
164 #ifndef DIR_SEPARATOR
165 #define DIR_SEPARATOR '/'
168 char __gnat_dir_separator
= DIR_SEPARATOR
;
170 char __gnat_path_separator
= PATH_SEPARATOR
;
172 /* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
173 the base filenames that libraries specified with -lsomelib options
174 may have. This is used by GNATMAKE to check whether an executable
175 is up-to-date or not. The syntax is
177 library_template ::= { pattern ; } pattern NUL
178 pattern ::= [ prefix ] * [ postfix ]
180 These should only specify names of static libraries as it makes
181 no sense to determine at link time if dynamic-link libraries are
182 up to date or not. Any libraries that are not found are supposed
185 * if they are needed but not present, the link
188 * otherwise they are libraries in the system paths and so
189 they are considered part of the system and not checked
192 ??? This should be part of a GNAT host-specific compiler
193 file instead of being included in all user applications
194 as well. This is only a temporary work-around for 3.11b. */
196 #ifndef GNAT_LIBRARY_TEMPLATE
197 #if defined (__EMX__)
198 #define GNAT_LIBRARY_TEMPLATE "*.a"
200 #define GNAT_LIBRARY_TEMPLATE "*.olb"
202 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
206 const char *__gnat_library_template
= GNAT_LIBRARY_TEMPLATE
;
208 /* This variable is used in hostparm.ads to say whether the host is a VMS
211 const int __gnat_vmsp
= 1;
213 const int __gnat_vmsp
= 0;
216 /* This variable is used to export the maximum length of a path name to
220 int __gnat_max_path_len
= _MAX_PATH
;
223 int __gnat_max_path_len
= 4096; /* PATH_MAX */
225 #elif defined (__vxworks) || defined (__OPENNT)
226 int __gnat_max_path_len
= PATH_MAX
;
229 #include <sys/param.h>
230 int __gnat_max_path_len
= MAXPATHLEN
;
234 /* The following macro HAVE_READDIR_R should be defined if the
235 system provides the routine readdir_r. */
236 #undef HAVE_READDIR_R
239 __gnat_to_gm_time (p_time
, p_year
, p_month
, p_day
, p_hours
, p_mins
, p_secs
)
240 int *p_time
, *p_year
, *p_month
, *p_day
, *p_hours
, *p_mins
, *p_secs
;
243 time_t time
= *p_time
;
246 /* On Windows systems, the time is sometimes rounded up to the nearest
247 even second, so if the number of seconds is odd, increment it. */
252 res
= gmtime (&time
);
256 *p_year
= res
->tm_year
;
257 *p_month
= res
->tm_mon
;
258 *p_day
= res
->tm_mday
;
259 *p_hours
= res
->tm_hour
;
260 *p_mins
= res
->tm_min
;
261 *p_secs
= res
->tm_sec
;
264 *p_year
= *p_month
= *p_day
= *p_hours
= *p_mins
= *p_secs
= 0;
267 /* Place the contents of the symbolic link named PATH in the buffer BUF,
268 which has size BUFSIZ. If PATH is a symbolic link, then return the number
269 of characters of its content in BUF. Otherwise, return -1. For Windows,
270 OS/2 and vxworks, always return -1. */
273 __gnat_readlink (path
, buf
, bufsiz
)
278 #if defined (MSDOS) || defined (_WIN32) || defined (__EMX__)
280 #elif defined (__INTERIX) || defined (VMS)
282 #elif defined (__vxworks)
285 return readlink (path
, buf
, bufsiz
);
289 /* Creates a symbolic link named NEWPATH which contains the string OLDPATH. If
290 NEWPATH exists it will NOT be overwritten. For Windows, OS/2, VxWorks,
291 Interix and VMS, always return -1. */
294 __gnat_symlink (oldpath
, newpath
)
298 #if defined (MSDOS) || defined (_WIN32) || defined (__EMX__)
300 #elif defined (__INTERIX) || defined (VMS)
302 #elif defined (__vxworks)
305 return symlink (oldpath
, newpath
);
309 /* Try to lock a file, return 1 if success. */
311 #if defined (__vxworks) || defined (MSDOS) || defined (_WIN32)
313 /* Version that does not use link. */
316 __gnat_try_lock (dir
, file
)
323 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
324 fd
= open (full_path
, O_CREAT
| O_EXCL
, 0600);
332 #elif defined (__EMX__) || defined (VMS)
334 /* More cases that do not use link; identical code, to solve too long
338 __gnat_try_lock (dir
, file
)
345 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
346 fd
= open (full_path
, O_CREAT
| O_EXCL
, 0600);
356 /* Version using link(), more secure over NFS. */
359 __gnat_try_lock (dir
, file
)
365 struct stat stat_result
;
368 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
369 sprintf (temp_file
, "%s-%d-%d", dir
, getpid(), getppid ());
371 /* Create the temporary file and write the process number. */
372 fd
= open (temp_file
, O_CREAT
| O_WRONLY
, 0600);
378 /* Link it with the new file. */
379 link (temp_file
, full_path
);
381 /* Count the references on the old one. If we have a count of two, then
382 the link did succeed. Remove the temporary file before returning. */
383 __gnat_stat (temp_file
, &stat_result
);
385 return stat_result
.st_nlink
== 2;
389 /* Return the maximum file name length. */
392 __gnat_get_maximum_file_name_length ()
397 if (getenv ("GNAT$EXTENDED_FILE_SPECIFICATIONS"))
406 /* Return nonzero if file names are case sensitive. */
409 __gnat_get_file_names_case_sensitive ()
411 #if defined (__EMX__) || defined (MSDOS) || defined (VMS) || defined (WINNT)
419 __gnat_get_default_identifier_character_set ()
421 #if defined (__EMX__) || defined (MSDOS)
428 /* Return the current working directory. */
431 __gnat_get_current_dir (dir
, length
)
436 /* Force Unix style, which is what GNAT uses internally. */
437 getcwd (dir
, *length
, 0);
439 getcwd (dir
, *length
);
442 *length
= strlen (dir
);
444 dir
[*length
] = DIR_SEPARATOR
;
449 /* Return the suffix for object files. */
452 __gnat_get_object_suffix_ptr (len
, value
)
456 *value
= HOST_OBJECT_SUFFIX
;
461 *len
= strlen (*value
);
466 /* Return the suffix for executable files. */
469 __gnat_get_executable_suffix_ptr (len
, value
)
473 *value
= HOST_EXECUTABLE_SUFFIX
;
477 *len
= strlen (*value
);
482 /* Return the suffix for debuggable files. Usually this is the same as the
483 executable extension. */
486 __gnat_get_debuggable_suffix_ptr (len
, value
)
491 *value
= HOST_EXECUTABLE_SUFFIX
;
493 /* On DOS, the extensionless COFF file is what gdb likes. */
500 *len
= strlen (*value
);
506 __gnat_open_read (path
, fmode
)
511 int o_fmode
= O_BINARY
;
517 /* Optional arguments mbc,deq,fop increase read performance. */
518 fd
= open (path
, O_RDONLY
| o_fmode
, 0444,
519 "mbc=16", "deq=64", "fop=tef");
520 #elif defined (__vxworks)
521 fd
= open (path
, O_RDONLY
| o_fmode
, 0444);
523 fd
= open (path
, O_RDONLY
| o_fmode
);
526 return fd
< 0 ? -1 : fd
;
529 #if defined (__EMX__)
530 #define PERM (S_IREAD | S_IWRITE)
532 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
536 __gnat_open_rw (path
, fmode
)
541 int o_fmode
= O_BINARY
;
547 fd
= open (path
, O_RDWR
| o_fmode
, PERM
,
548 "mbc=16", "deq=64", "fop=tef");
550 fd
= open (path
, O_RDWR
| o_fmode
, PERM
);
553 return fd
< 0 ? -1 : fd
;
557 __gnat_open_create (path
, fmode
)
562 int o_fmode
= O_BINARY
;
568 fd
= open (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
,
569 "mbc=16", "deq=64", "fop=tef");
571 fd
= open (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
574 return fd
< 0 ? -1 : fd
;
578 __gnat_open_append (path
, fmode
)
583 int o_fmode
= O_BINARY
;
589 fd
= open (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
,
590 "mbc=16", "deq=64", "fop=tef");
592 fd
= open (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
595 return fd
< 0 ? -1 : fd
;
598 /* Open a new file. Return error (-1) if the file already exists. */
601 __gnat_open_new (path
, fmode
)
606 int o_fmode
= O_BINARY
;
612 fd
= open (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
,
613 "mbc=16", "deq=64", "fop=tef");
615 fd
= open (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
618 return fd
< 0 ? -1 : fd
;
621 /* Open a new temp file. Return error (-1) if the file already exists.
622 Special options for VMS allow the file to be shared between parent and child
623 processes, however they really slow down output. Used in gnatchop. */
626 __gnat_open_new_temp (path
, fmode
)
631 int o_fmode
= O_BINARY
;
633 strcpy (path
, "GNAT-XXXXXX");
635 #if defined (linux) && !defined (__vxworks)
636 return mkstemp (path
);
637 #elif defined (__Lynx__)
640 if (mktemp (path
) == NULL
)
648 fd
= open (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
,
649 "rfm=stmlf", "ctx=rec", "rat=none", "shr=del,get,put,upd",
650 "mbc=16", "deq=64", "fop=tef");
652 fd
= open (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
655 return fd
< 0 ? -1 : fd
;
658 /* Return the number of bytes in the specified file. */
661 __gnat_file_length (fd
)
667 ret
= fstat (fd
, &statbuf
);
668 if (ret
|| !S_ISREG (statbuf
.st_mode
))
671 return (statbuf
.st_size
);
674 /* Create a temporary filename and put it in string pointed to by
678 __gnat_tmp_name (tmp_filename
)
685 /* tempnam tries to create a temporary file in directory pointed to by
686 TMP environment variable, in c:\temp if TMP is not set, and in
687 directory specified by P_tmpdir in stdio.h if c:\temp does not
688 exist. The filename will be created with the prefix "gnat-". */
690 pname
= (char *) tempnam ("c:\\temp", "gnat-");
692 /* If pname start with a back slash and not path information it means that
693 the filename is valid for the current working directory. */
695 if (pname
[0] == '\\')
697 strcpy (tmp_filename
, ".\\");
698 strcat (tmp_filename
, pname
+1);
701 strcpy (tmp_filename
, pname
);
706 #elif defined (linux)
707 char *tmpdir
= getenv ("TMPDIR");
710 strcpy (tmp_filename
, "/tmp/gnat-XXXXXX");
712 sprintf (tmp_filename
, "%200s/gnat-XXXXXX", tmpdir
);
714 close (mkstemp(tmp_filename
));
716 tmpnam (tmp_filename
);
720 /* Read the next entry in a directory. The returned string points somewhere
724 __gnat_readdir (dirp
, buffer
)
728 /* If possible, try to use the thread-safe version. */
729 #ifdef HAVE_READDIR_R
730 if (readdir_r (dirp
, buffer
) != NULL
)
731 return ((struct dirent
*) buffer
)->d_name
;
736 struct dirent
*dirent
= readdir (dirp
);
740 strcpy (buffer
, dirent
->d_name
);
749 /* Returns 1 if readdir is thread safe, 0 otherwise. */
752 __gnat_readdir_is_thread_safe ()
754 #ifdef HAVE_READDIR_R
763 /* Returns the file modification timestamp using Win32 routines which are
764 immune against daylight saving time change. It is in fact not possible to
765 use fstat for this purpose as the DST modify the st_mtime field of the
776 unsigned long long timestamp
;
778 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
779 unsigned long long offset
= 11644473600;
781 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
782 since <Jan 1st 1601>. This function must return the number of seconds
783 since <Jan 1st 1970>. */
785 res
= GetFileTime (h
, &t_create
, &t_access
, &t_write
);
787 timestamp
= (((long long) t_write
.dwHighDateTime
<< 32)
788 + t_write
.dwLowDateTime
);
790 timestamp
= timestamp
/ 10000000 - offset
;
792 return (time_t) timestamp
;
796 /* Return a GNAT time stamp given a file name. */
799 __gnat_file_time_name (name
)
804 #if defined (__EMX__) || defined (MSDOS)
805 int fd
= open (name
, O_RDONLY
| O_BINARY
);
806 time_t ret
= __gnat_file_time_fd (fd
);
810 #elif defined (_WIN32)
811 HANDLE h
= CreateFile (name
, GENERIC_READ
, FILE_SHARE_READ
, 0,
812 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
, 0);
813 time_t ret
= win32_filetime (h
);
818 (void) __gnat_stat (name
, &statbuf
);
820 /* VMS has file versioning. */
821 return statbuf
.st_ctime
;
823 return statbuf
.st_mtime
;
828 /* Return a GNAT time stamp given a file descriptor. */
831 __gnat_file_time_fd (fd
)
834 /* The following workaround code is due to the fact that under EMX and
835 DJGPP fstat attempts to convert time values to GMT rather than keep the
836 actual OS timestamp of the file. By using the OS2/DOS functions directly
837 the GNAT timestamp are independent of this behavior, which is desired to
838 facilitate the distribution of GNAT compiled libraries. */
840 #if defined (__EMX__) || defined (MSDOS)
844 int ret
= DosQueryFileInfo (fd
, 1, (unsigned char *) &fs
,
845 sizeof (FILESTATUS
));
847 unsigned file_year
= fs
.fdateLastWrite
.year
;
848 unsigned file_month
= fs
.fdateLastWrite
.month
;
849 unsigned file_day
= fs
.fdateLastWrite
.day
;
850 unsigned file_hour
= fs
.ftimeLastWrite
.hours
;
851 unsigned file_min
= fs
.ftimeLastWrite
.minutes
;
852 unsigned file_tsec
= fs
.ftimeLastWrite
.twosecs
;
856 int ret
= getftime (fd
, &fs
);
858 unsigned file_year
= fs
.ft_year
;
859 unsigned file_month
= fs
.ft_month
;
860 unsigned file_day
= fs
.ft_day
;
861 unsigned file_hour
= fs
.ft_hour
;
862 unsigned file_min
= fs
.ft_min
;
863 unsigned file_tsec
= fs
.ft_tsec
;
866 /* Calculate the seconds since epoch from the time components. First count
867 the whole days passed. The value for years returned by the DOS and OS2
868 functions count years from 1980, so to compensate for the UNIX epoch which
869 begins in 1970 start with 10 years worth of days and add days for each
870 four year period since then. */
873 int cum_days
[12] = {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
874 int days_passed
= 3652 + (file_year
/ 4) * 1461;
875 int years_since_leap
= file_year
% 4;
877 if (years_since_leap
== 1)
879 else if (years_since_leap
== 2)
881 else if (years_since_leap
== 3)
887 days_passed
+= cum_days
[file_month
- 1];
888 if (years_since_leap
== 0 && file_year
!= 20 && file_month
> 2)
891 days_passed
+= file_day
- 1;
893 /* OK - have whole days. Multiply -- then add in other parts. */
895 tot_secs
= days_passed
* 86400;
896 tot_secs
+= file_hour
* 3600;
897 tot_secs
+= file_min
* 60;
898 tot_secs
+= file_tsec
* 2;
901 #elif defined (_WIN32)
902 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
903 time_t ret
= win32_filetime (h
);
909 (void) fstat (fd
, &statbuf
);
912 /* VMS has file versioning. */
913 return statbuf
.st_ctime
;
915 return statbuf
.st_mtime
;
920 /* Set the file time stamp. */
923 __gnat_set_file_time_name (name
, time_stamp
)
927 #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32) \
928 || defined (__vxworks)
930 /* Code to implement __gnat_set_file_time_name for these systems. */
938 unsigned long long backup
, create
, expire
, revise
;
942 unsigned short value
;
951 } Fat
= { 0, 0, 0, 0, 0, { 0 }};
955 { ATR$S_CREDATE
, ATR$C_CREDATE
, &Fat
.create
},
956 { ATR$S_REVDATE
, ATR$C_REVDATE
, &Fat
.revise
},
957 { ATR$S_EXPDATE
, ATR$C_EXPDATE
, &Fat
.expire
},
958 { ATR$S_BAKDATE
, ATR$C_BAKDATE
, &Fat
.backup
},
959 { ATR$S_FPRO
, ATR$C_FPRO
, &Fat
.prot
},
960 { ATR$S_UIC
, ATR$C_UIC
, &Fat
.uic
},
965 struct dsc$descriptor_fib fibdsc
= {sizeof (fib
), (void *) &fib
};
969 unsigned long long newtime
;
970 unsigned long long revtime
;
975 struct dsc$descriptor_s filedsc
976 = {NAM$C_MAXRSS
, DSC$K_DTYPE_T
, DSC$K_CLASS_S
, (void *) file
.string
};
977 struct vstring device
;
978 struct dsc$descriptor_s devicedsc
979 = {NAM$C_MAXRSS
, DSC$K_DTYPE_T
, DSC$K_CLASS_S
, (void *) device
.string
};
980 struct vstring timev
;
981 struct dsc$descriptor_s timedsc
982 = {NAM$C_MAXRSS
, DSC$K_DTYPE_T
, DSC$K_CLASS_S
, (void *) timev
.string
};
983 struct vstring result
;
984 struct dsc$descriptor_s resultdsc
985 = {NAM$C_MAXRSS
, DSC$K_DTYPE_VT
, DSC$K_CLASS_VS
, (void *) result
.string
};
987 tryfile
= (char *) __gnat_to_host_dir_spec (name
, 0);
989 /* Allocate and initialize a FAB and NAM structures. */
993 nam
.nam$l_esa
= file
.string
;
994 nam
.nam$b_ess
= NAM$C_MAXRSS
;
995 nam
.nam$l_rsa
= result
.string
;
996 nam
.nam$b_rss
= NAM$C_MAXRSS
;
997 fab
.fab$l_fna
= tryfile
;
998 fab
.fab$b_fns
= strlen (tryfile
);
999 fab
.fab$l_nam
= &nam
;
1001 /* Validate filespec syntax and device existence. */
1002 status
= SYS$
PARSE (&fab
, 0, 0);
1003 if ((status
& 1) != 1)
1004 LIB$
SIGNAL (status
);
1006 file
.string
[nam
.nam$b_esl
] = 0;
1008 /* Find matching filespec. */
1009 status
= SYS$
SEARCH (&fab
, 0, 0);
1010 if ((status
& 1) != 1)
1011 LIB$
SIGNAL (status
);
1013 file
.string
[nam
.nam$b_esl
] = 0;
1014 result
.string
[result
.length
=nam
.nam$b_rsl
] = 0;
1016 /* Get the device name and assign an IO channel. */
1017 strncpy (device
.string
, nam
.nam$l_dev
, nam
.nam$b_dev
);
1018 devicedsc
.dsc$w_length
= nam
.nam$b_dev
;
1020 status
= SYS$
ASSIGN (&devicedsc
, &chan
, 0, 0, 0);
1021 if ((status
& 1) != 1)
1022 LIB$
SIGNAL (status
);
1024 /* Initialize the FIB and fill in the directory id field. */
1025 memset (&fib
, 0, sizeof (fib
));
1026 fib
.fib$w_did
[0] = nam
.nam$w_did
[0];
1027 fib
.fib$w_did
[1] = nam
.nam$w_did
[1];
1028 fib
.fib$w_did
[2] = nam
.nam$w_did
[2];
1029 fib
.fib$l_acctl
= 0;
1031 strcpy (file
.string
, (strrchr (result
.string
, ']') + 1));
1032 filedsc
.dsc$w_length
= strlen (file
.string
);
1033 result
.string
[result
.length
= 0] = 0;
1035 /* Open and close the file to fill in the attributes. */
1037 = SYS$
QIOW (0, chan
, IO$_ACCESS
|IO$M_ACCESS
, &iosb
, 0, 0,
1038 &fibdsc
, &filedsc
, &result
.length
, &resultdsc
, &atrlst
, 0);
1039 if ((status
& 1) != 1)
1040 LIB$
SIGNAL (status
);
1041 if ((iosb
.status
& 1) != 1)
1042 LIB$
SIGNAL (iosb
.status
);
1044 result
.string
[result
.length
] = 0;
1045 status
= SYS$
QIOW (0, chan
, IO$_DEACCESS
, &iosb
, 0, 0, &fibdsc
, 0, 0, 0,
1047 if ((status
& 1) != 1)
1048 LIB$
SIGNAL (status
);
1049 if ((iosb
.status
& 1) != 1)
1050 LIB$
SIGNAL (iosb
.status
);
1056 ts
= localtime (&time_stamp
);
1058 /* Set creation time to requested time. */
1059 unix_time_to_vms (time_stamp
+ ts
->tm_gmtoff
, newtime
);
1061 t
= time ((time_t) 0);
1062 ts
= localtime (&t
);
1064 /* Set revision time to now in local time. */
1065 unix_time_to_vms (t
+ ts
->tm_gmtoff
, revtime
);
1068 /* Reopen the file, modify the times and then close. */
1069 fib
.fib$l_acctl
= FIB$M_WRITE
;
1071 = SYS$
QIOW (0, chan
, IO$_ACCESS
|IO$M_ACCESS
, &iosb
, 0, 0,
1072 &fibdsc
, &filedsc
, &result
.length
, &resultdsc
, &atrlst
, 0);
1073 if ((status
& 1) != 1)
1074 LIB$
SIGNAL (status
);
1075 if ((iosb
.status
& 1) != 1)
1076 LIB$
SIGNAL (iosb
.status
);
1078 Fat
.create
= newtime
;
1079 Fat
.revise
= revtime
;
1081 status
= SYS$
QIOW (0, chan
, IO$_DEACCESS
, &iosb
, 0, 0,
1082 &fibdsc
, 0, 0, 0, &atrlst
, 0);
1083 if ((status
& 1) != 1)
1084 LIB$
SIGNAL (status
);
1085 if ((iosb
.status
& 1) != 1)
1086 LIB$
SIGNAL (iosb
.status
);
1088 /* Deassign the channel and exit. */
1089 status
= SYS$
DASSGN (chan
);
1090 if ((status
& 1) != 1)
1091 LIB$
SIGNAL (status
);
1093 struct utimbuf utimbuf
;
1096 /* Set modification time to requested time. */
1097 utimbuf
.modtime
= time_stamp
;
1099 /* Set access time to now in local time. */
1100 t
= time ((time_t) 0);
1101 utimbuf
.actime
= mktime (localtime (&t
));
1103 utime (name
, &utimbuf
);
1108 __gnat_get_env_value_ptr (name
, len
, value
)
1113 *value
= getenv (name
);
1117 *len
= strlen (*value
);
1122 /* VMS specific declarations for set_env_value. */
1126 static char *to_host_path_spec
PARAMS ((char *));
1130 unsigned short len
, mbz
;
1134 typedef struct _ile3
1136 unsigned short len
, code
;
1138 unsigned short *retlen_adr
;
1144 __gnat_set_env_value (name
, value
)
1151 struct descriptor_s name_desc
;
1152 /* Put in JOB table for now, so that the project stuff at least works. */
1153 struct descriptor_s table_desc
= {7, 0, "LNM$JOB"};
1154 char *host_pathspec
= to_host_path_spec (value
);
1155 char *copy_pathspec
;
1156 int num_dirs_in_pathspec
= 1;
1159 if (*host_pathspec
== 0)
1162 name_desc
.len
= strlen (name
);
1164 name_desc
.adr
= name
;
1166 ptr
= host_pathspec
;
1169 num_dirs_in_pathspec
++;
1173 ile_s
*ile_array
= alloca (sizeof (ile_s
) * (num_dirs_in_pathspec
+ 1));
1174 char *copy_pathspec
= alloca (strlen (host_pathspec
) + 1);
1177 strcpy (copy_pathspec
, host_pathspec
);
1178 curr
= copy_pathspec
;
1179 for (i
= 0; i
< num_dirs_in_pathspec
; i
++)
1181 next
= strchr (curr
, ',');
1183 next
= strchr (curr
, 0);
1186 ile_array
[i
].len
= strlen (curr
);
1188 /* Code 2 from lnmdef.h means its a string. */
1189 ile_array
[i
].code
= 2;
1190 ile_array
[i
].adr
= curr
;
1192 /* retlen_adr is ignored. */
1193 ile_array
[i
].retlen_adr
= 0;
1197 /* Terminating item must be zero. */
1198 ile_array
[i
].len
= 0;
1199 ile_array
[i
].code
= 0;
1200 ile_array
[i
].adr
= 0;
1201 ile_array
[i
].retlen_adr
= 0;
1203 status
= LIB$
SET_LOGICAL (&name_desc
, 0, &table_desc
, 0, ile_array
);
1204 if ((status
& 1) != 1)
1205 LIB$
SIGNAL (status
);
1209 int size
= strlen (name
) + strlen (value
) + 2;
1212 expression
= (char *) xmalloc (size
* sizeof (char));
1214 sprintf (expression
, "%s=%s", name
, value
);
1215 putenv (expression
);
1220 #include <windows.h>
1223 /* Get the list of installed standard libraries from the
1224 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1228 __gnat_get_libraries_from_registry ()
1230 char *result
= (char *) "";
1232 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_COMPILE)
1235 DWORD name_size
, value_size
;
1242 /* First open the key. */
1243 res
= RegOpenKeyExA (HKEY_LOCAL_MACHINE
, "SOFTWARE", 0, KEY_READ
, ®_key
);
1245 if (res
== ERROR_SUCCESS
)
1246 res
= RegOpenKeyExA (reg_key
, "Ada Core Technologies", 0,
1247 KEY_READ
, ®_key
);
1249 if (res
== ERROR_SUCCESS
)
1250 res
= RegOpenKeyExA (reg_key
, "GNAT", 0, KEY_READ
, ®_key
);
1252 if (res
== ERROR_SUCCESS
)
1253 res
= RegOpenKeyExA (reg_key
, "Standard Libraries", 0, KEY_READ
, ®_key
);
1255 /* If the key exists, read out all the values in it and concatenate them
1257 for (index
= 0; res
== ERROR_SUCCESS
; index
++)
1259 value_size
= name_size
= 256;
1260 res
= RegEnumValue (reg_key
, index
, name
, &name_size
, 0,
1261 &type
, value
, &value_size
);
1263 if (res
== ERROR_SUCCESS
&& type
== REG_SZ
)
1265 char *old_result
= result
;
1267 result
= (char *) xmalloc (strlen (old_result
) + value_size
+ 2);
1268 strcpy (result
, old_result
);
1269 strcat (result
, value
);
1270 strcat (result
, ";");
1274 /* Remove the trailing ";". */
1276 result
[strlen (result
) - 1] = 0;
1283 __gnat_stat (name
, statbuf
)
1285 struct stat
*statbuf
;
1288 /* Under Windows the directory name for the stat function must not be
1289 terminated by a directory separator except if just after a drive name. */
1290 int name_len
= strlen (name
);
1291 char last_char
= name
[name_len
- 1];
1292 char win32_name
[4096];
1294 strcpy (win32_name
, name
);
1296 while (name_len
> 1 && (last_char
== '\\' || last_char
== '/'))
1298 win32_name
[name_len
- 1] = '\0';
1300 last_char
= win32_name
[name_len
- 1];
1303 if (name_len
== 2 && win32_name
[1] == ':')
1304 strcat (win32_name
, "\\");
1306 return stat (win32_name
, statbuf
);
1309 return stat (name
, statbuf
);
1314 __gnat_file_exists (name
)
1317 struct stat statbuf
;
1319 return !__gnat_stat (name
, &statbuf
);
1323 __gnat_is_absolute_path (name
)
1326 return (*name
== '/' || *name
== DIR_SEPARATOR
1327 #if defined (__EMX__) || defined (MSDOS) || defined (WINNT)
1328 || strlen (name
) > 1 && isalpha (name
[0]) && name
[1] == ':'
1334 __gnat_is_regular_file (name
)
1338 struct stat statbuf
;
1340 ret
= __gnat_stat (name
, &statbuf
);
1341 return (!ret
&& S_ISREG (statbuf
.st_mode
));
1345 __gnat_is_directory (name
)
1349 struct stat statbuf
;
1351 ret
= __gnat_stat (name
, &statbuf
);
1352 return (!ret
&& S_ISDIR (statbuf
.st_mode
));
1356 __gnat_is_writable_file (name
)
1361 struct stat statbuf
;
1363 ret
= __gnat_stat (name
, &statbuf
);
1364 mode
= statbuf
.st_mode
& S_IWUSR
;
1365 return (!ret
&& mode
);
1369 /* Defined in VMS header files. */
1370 #define fork() (decc$$alloc_vfork_blocks() >= 0 ? \
1371 LIB$GET_CURRENT_INVO_CONTEXT (decc$$get_vfork_jmpbuf()) : -1)
1374 #if defined (sun) && defined (__SVR4)
1375 /* Using fork on Solaris will duplicate all the threads. fork1, which
1376 duplicates only the active thread, must be used instead, or spawning
1377 subprocess from a program with tasking will lead into numerous problems. */
1382 __gnat_portable_spawn (args
)
1389 #if defined (MSDOS) || defined (_WIN32)
1390 status
= spawnvp (P_WAIT
, args
[0], args
);
1396 #elif defined (__vxworks)
1401 pid
= spawnvp (P_NOWAIT
, args
[0], args
);
1413 if (execv (args
[0], args
) != 0)
1415 return -1; /* execv is in parent context on VMS. */
1423 finished
= waitpid (pid
, &status
, 0);
1425 if (finished
!= pid
|| WIFEXITED (status
) == 0)
1428 return WEXITSTATUS (status
);
1434 /* WIN32 code to implement a wait call that wait for any child process. */
1438 /* Synchronization code, to be thread safe. */
1440 static CRITICAL_SECTION plist_cs
;
1443 __gnat_plist_init ()
1445 InitializeCriticalSection (&plist_cs
);
1451 EnterCriticalSection (&plist_cs
);
1457 LeaveCriticalSection (&plist_cs
);
1460 typedef struct _process_list
1463 struct _process_list
*next
;
1466 static Process_List
*PLIST
= NULL
;
1468 static int plist_length
= 0;
1476 pl
= (Process_List
*) xmalloc (sizeof (Process_List
));
1480 /* -------------------- critical section -------------------- */
1485 /* -------------------- critical section -------------------- */
1490 void remove_handle (h
)
1493 Process_List
*pl
, *prev
;
1497 /* -------------------- critical section -------------------- */
1506 prev
->next
= pl
->next
;
1518 /* -------------------- critical section -------------------- */
1524 win32_no_block_spawn (command
, args
)
1530 PROCESS_INFORMATION PI
;
1531 SECURITY_ATTRIBUTES SA
;
1536 /* compute the total command line length */
1540 csize
+= strlen (args
[k
]) + 1;
1544 full_command
= (char *) xmalloc (csize
);
1547 SI
.cb
= sizeof (STARTUPINFO
);
1548 SI
.lpReserved
= NULL
;
1549 SI
.lpReserved2
= NULL
;
1550 SI
.lpDesktop
= NULL
;
1554 SI
.wShowWindow
= SW_HIDE
;
1556 /* Security attributes. */
1557 SA
.nLength
= sizeof (SECURITY_ATTRIBUTES
);
1558 SA
.bInheritHandle
= TRUE
;
1559 SA
.lpSecurityDescriptor
= NULL
;
1561 /* Prepare the command string. */
1562 strcpy (full_command
, command
);
1563 strcat (full_command
, " ");
1568 strcat (full_command
, args
[k
]);
1569 strcat (full_command
, " ");
1573 result
= CreateProcess (NULL
, (char *) full_command
, &SA
, NULL
, TRUE
,
1574 NORMAL_PRIORITY_CLASS
, NULL
, NULL
, &SI
, &PI
);
1576 free (full_command
);
1580 add_handle (PI
.hProcess
);
1581 CloseHandle (PI
.hThread
);
1582 return (int) PI
.hProcess
;
1599 if (plist_length
== 0)
1605 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * plist_length
);
1610 /* -------------------- critical section -------------------- */
1617 /* -------------------- critical section -------------------- */
1621 res
= WaitForMultipleObjects (plist_length
, hl
, FALSE
, INFINITE
);
1622 h
= hl
[res
- WAIT_OBJECT_0
];
1627 GetExitCodeProcess (h
, &exitcode
);
1630 *status
= (int) exitcode
;
1637 __gnat_portable_no_block_spawn (args
)
1642 #if defined (__EMX__) || defined (MSDOS)
1644 /* ??? For PC machines I (Franco) don't know the system calls to implement
1645 this routine. So I'll fake it as follows. This routine will behave
1646 exactly like the blocking portable_spawn and will systematically return
1647 a pid of 0 unless the spawned task did not complete successfully, in
1648 which case we return a pid of -1. To synchronize with this the
1649 portable_wait below systematically returns a pid of 0 and reports that
1650 the subprocess terminated successfully. */
1652 if (spawnvp (P_WAIT
, args
[0], args
) != 0)
1655 #elif defined (_WIN32)
1657 pid
= win32_no_block_spawn (args
[0], args
);
1660 #elif defined (__vxworks)
1669 if (execv (args
[0], args
) != 0)
1671 return -1; /* execv is in parent context on VMS. */
1683 __gnat_portable_wait (process_status
)
1684 int *process_status
;
1689 #if defined (_WIN32)
1691 pid
= win32_wait (&status
);
1693 #elif defined (__EMX__) || defined (MSDOS)
1694 /* ??? See corresponding comment in portable_no_block_spawn. */
1696 #elif defined (__vxworks)
1697 /* Not sure what to do here, so do same as __EMX__ case, i.e., nothing but
1701 pid
= waitpid (-1, &status
, 0);
1702 status
= status
& 0xffff;
1705 *process_status
= status
;
1710 __gnat_waitpid (pid
)
1715 #if defined (_WIN32)
1716 cwait (&status
, pid
, _WAIT_CHILD
);
1717 #elif defined (__EMX__) || defined (MSDOS) || defined (__vxworks)
1718 /* Status is already zero, so nothing to do. */
1720 waitpid (pid
, &status
, 0);
1721 status
= WEXITSTATUS (status
);
1728 __gnat_os_exit (status
)
1732 /* Exit without changing 0 to 1. */
1733 __posix_exit (status
);
1739 /* Locate a regular file, give a Path value. */
1742 __gnat_locate_regular_file (file_name
, path_val
)
1748 /* Handle absolute pathnames. */
1749 for (ptr
= file_name
; *ptr
&& *ptr
!= '/' && *ptr
!= DIR_SEPARATOR
; ptr
++)
1753 #if defined (__EMX__) || defined (MSDOS) || defined (WINNT)
1754 || isalpha (file_name
[0]) && file_name
[1] == ':'
1758 if (__gnat_is_regular_file (file_name
))
1759 return xstrdup (file_name
);
1768 /* The result has to be smaller than path_val + file_name. */
1769 char *file_path
= alloca (strlen (path_val
) + strlen (file_name
) + 2);
1773 for (; *path_val
== PATH_SEPARATOR
; path_val
++)
1779 for (ptr
= file_path
; *path_val
&& *path_val
!= PATH_SEPARATOR
; )
1780 *ptr
++ = *path_val
++;
1783 if (*ptr
!= '/' && *ptr
!= DIR_SEPARATOR
)
1784 *++ptr
= DIR_SEPARATOR
;
1786 strcpy (++ptr
, file_name
);
1788 if (__gnat_is_regular_file (file_path
))
1789 return xstrdup (file_path
);
1796 /* Locate an executable given a Path argument. This routine is only used by
1797 gnatbl and should not be used otherwise. Use locate_exec_on_path
1801 __gnat_locate_exec (exec_name
, path_val
)
1805 if (!strstr (exec_name
, HOST_EXECUTABLE_SUFFIX
))
1807 char *full_exec_name
1808 = alloca (strlen (exec_name
) + strlen (HOST_EXECUTABLE_SUFFIX
) + 1);
1810 strcpy (full_exec_name
, exec_name
);
1811 strcat (full_exec_name
, HOST_EXECUTABLE_SUFFIX
);
1812 return __gnat_locate_regular_file (full_exec_name
, path_val
);
1815 return __gnat_locate_regular_file (exec_name
, path_val
);
1818 /* Locate an executable using the Systems default PATH. */
1821 __gnat_locate_exec_on_path (exec_name
)
1825 char *path_val
= "/VAXC$PATH";
1827 char *path_val
= getenv ("PATH");
1829 char *apath_val
= alloca (strlen (path_val
) + 1);
1831 strcpy (apath_val
, path_val
);
1832 return __gnat_locate_exec (exec_name
, apath_val
);
1837 /* These functions are used to translate to and from VMS and Unix syntax
1838 file, directory and path specifications. */
1840 #define MAXNAMES 256
1841 #define NEW_CANONICAL_FILELIST_INCREMENT 64
1843 static char new_canonical_dirspec
[255];
1844 static char new_canonical_filespec
[255];
1845 static char new_canonical_pathspec
[MAXNAMES
*255];
1846 static unsigned new_canonical_filelist_index
;
1847 static unsigned new_canonical_filelist_in_use
;
1848 static unsigned new_canonical_filelist_allocated
;
1849 static char **new_canonical_filelist
;
1850 static char new_host_pathspec
[MAXNAMES
*255];
1851 static char new_host_dirspec
[255];
1852 static char new_host_filespec
[255];
1854 /* Routine is called repeatedly by decc$from_vms via
1855 __gnat_to_canonical_file_list_init until it returns 0 or the expansion runs
1859 wildcard_translate_unix (name
)
1865 strcpy (buff
, name
);
1866 ver
= strrchr (buff
, '.');
1868 /* Chop off the version. */
1872 /* Dynamically extend the allocation by the increment. */
1873 if (new_canonical_filelist_in_use
== new_canonical_filelist_allocated
)
1875 new_canonical_filelist_allocated
+= NEW_CANONICAL_FILELIST_INCREMENT
;
1876 new_canonical_filelist
= (char **) xrealloc
1877 (new_canonical_filelist
,
1878 new_canonical_filelist_allocated
* sizeof (char *));
1881 new_canonical_filelist
[new_canonical_filelist_in_use
++] = xstrdup (buff
);
1886 /* Translate a wildcard VMS file spec into a list of Unix file specs. First do
1887 full translation and copy the results into a list (_init), then return them
1888 one at a time (_next). If onlydirs set, only expand directory files. */
1891 __gnat_to_canonical_file_list_init (filespec
, onlydirs
)
1898 len
= strlen (filespec
);
1899 strcpy (buff
, filespec
);
1901 /* Only look for directories. */
1902 if (onlydirs
&& !strstr (&buff
[len
- 5], "*.dir"))
1903 strcat (buff
, "*.dir");
1905 decc$
from_vms (buff
, wildcard_translate_unix
, 1);
1907 /* Remove the .dir extension. */
1913 for (i
= 0; i
< new_canonical_filelist_in_use
; i
++)
1915 ext
= strstr (new_canonical_filelist
[i
], ".dir");
1921 return new_canonical_filelist_in_use
;
1924 /* Return the next filespec in the list. */
1927 __gnat_to_canonical_file_list_next ()
1929 return new_canonical_filelist
[new_canonical_filelist_index
++];
1932 /* Free storage used in the wildcard expansion. */
1935 __gnat_to_canonical_file_list_free ()
1939 for (i
= 0; i
< new_canonical_filelist_in_use
; i
++)
1940 free (new_canonical_filelist
[i
]);
1942 free (new_canonical_filelist
);
1944 new_canonical_filelist_in_use
= 0;
1945 new_canonical_filelist_allocated
= 0;
1946 new_canonical_filelist_index
= 0;
1947 new_canonical_filelist
= 0;
1950 /* Translate a VMS syntax directory specification in to Unix syntax. If
1951 PREFIXFLAG is set, append an underscore "/". If no indicators of VMS syntax
1952 found, return input string. Also translate a dirname that contains no
1953 slashes, in case it's a logical name. */
1956 __gnat_to_canonical_dir_spec (dirspec
, prefixflag
)
1962 strcpy (new_canonical_dirspec
, "");
1963 if (strlen (dirspec
))
1967 if (strchr (dirspec
, ']') || strchr (dirspec
, ':'))
1968 strcpy (new_canonical_dirspec
, (char *) decc$
translate_vms (dirspec
));
1969 else if (!strchr (dirspec
, '/') && (dirspec1
= getenv (dirspec
)) != 0)
1970 strcpy (new_canonical_dirspec
, (char *) decc$
translate_vms (dirspec1
));
1972 strcpy (new_canonical_dirspec
, dirspec
);
1975 len
= strlen (new_canonical_dirspec
);
1976 if (prefixflag
&& new_canonical_dirspec
[len
- 1] != '/')
1977 strcat (new_canonical_dirspec
, "/");
1979 return new_canonical_dirspec
;
1983 /* Translate a VMS syntax file specification into Unix syntax.
1984 If no indicators of VMS syntax found, return input string. */
1987 __gnat_to_canonical_file_spec (filespec
)
1990 strcpy (new_canonical_filespec
, "");
1991 if (strchr (filespec
, ']') || strchr (filespec
, ':'))
1992 strcpy (new_canonical_filespec
, (char *) decc$
translate_vms (filespec
));
1994 strcpy (new_canonical_filespec
, filespec
);
1996 return new_canonical_filespec
;
1999 /* Translate a VMS syntax path specification into Unix syntax.
2000 If no indicators of VMS syntax found, return input string. */
2003 __gnat_to_canonical_path_spec (pathspec
)
2006 char *curr
, *next
, buff
[256];
2011 /* If there are /'s, assume it's a Unix path spec and return. */
2012 if (strchr (pathspec
, '/'))
2015 new_canonical_pathspec
[0] = 0;
2020 next
= strchr (curr
, ',');
2022 next
= strchr (curr
, 0);
2024 strncpy (buff
, curr
, next
- curr
);
2025 buff
[next
- curr
] = 0;
2027 /* Check for wildcards and expand if present. */
2028 if (strchr (buff
, '*') || strchr (buff
, '%') || strstr (buff
, "..."))
2032 dirs
= __gnat_to_canonical_file_list_init (buff
, 1);
2033 for (i
= 0; i
< dirs
; i
++)
2037 next_dir
= __gnat_to_canonical_file_list_next ();
2038 strcat (new_canonical_pathspec
, next_dir
);
2040 /* Don't append the separator after the last expansion. */
2042 strcat (new_canonical_pathspec
, ":");
2045 __gnat_to_canonical_file_list_free ();
2048 strcat (new_canonical_pathspec
,
2049 __gnat_to_canonical_dir_spec (buff
, 0));
2054 strcat (new_canonical_pathspec
, ":");
2058 return new_canonical_pathspec
;
2061 static char filename_buff
[256];
2064 translate_unix (name
, type
)
2068 strcpy (filename_buff
, name
);
2072 /* Translate a Unix syntax path spec into a VMS style (comma separated list of
2076 to_host_path_spec (pathspec
)
2079 char *curr
, *next
, buff
[256];
2084 /* Can't very well test for colons, since that's the Unix separator! */
2085 if (strchr (pathspec
, ']') || strchr (pathspec
, ','))
2088 new_host_pathspec
[0] = 0;
2093 next
= strchr (curr
, ':');
2095 next
= strchr (curr
, 0);
2097 strncpy (buff
, curr
, next
- curr
);
2098 buff
[next
- curr
] = 0;
2100 strcat (new_host_pathspec
, __gnat_to_host_dir_spec (buff
, 0));
2103 strcat (new_host_pathspec
, ",");
2107 return new_host_pathspec
;
2110 /* Translate a Unix syntax directory specification into VMS syntax. The
2111 PREFIXFLAG has no effect, but is kept for symmetry with
2112 to_canonical_dir_spec. If indicators of VMS syntax found, return input
2116 __gnat_to_host_dir_spec (dirspec
, prefixflag
)
2118 int prefixflag ATTRIBUTE_UNUSED
;
2120 int len
= strlen (dirspec
);
2122 strcpy (new_host_dirspec
, dirspec
);
2124 if (strchr (new_host_dirspec
, ']') || strchr (new_host_dirspec
, ':'))
2125 return new_host_dirspec
;
2127 while (len
> 1 && new_host_dirspec
[len
- 1] == '/')
2129 new_host_dirspec
[len
- 1] = 0;
2133 decc$
to_vms (new_host_dirspec
, translate_unix
, 1, 2);
2134 strcpy (new_host_dirspec
, filename_buff
);
2136 return new_host_dirspec
;
2140 /* Translate a Unix syntax file specification into VMS syntax.
2141 If indicators of VMS syntax found, return input string. */
2144 __gnat_to_host_file_spec (filespec
)
2147 strcpy (new_host_filespec
, "");
2148 if (strchr (filespec
, ']') || strchr (filespec
, ':'))
2149 strcpy (new_host_filespec
, filespec
);
2152 decc$
to_vms (filespec
, translate_unix
, 1, 1);
2153 strcpy (new_host_filespec
, filename_buff
);
2156 return new_host_filespec
;
2160 __gnat_adjust_os_resource_limits ()
2162 SYS$
ADJWSL (131072, 0);
2167 /* Dummy functions for Osint import for non-VMS systems. */
2170 __gnat_to_canonical_file_list_init (dirspec
, onlydirs
)
2171 char *dirspec ATTRIBUTE_UNUSED
;
2172 int onlydirs ATTRIBUTE_UNUSED
;
2178 __gnat_to_canonical_file_list_next ()
2184 __gnat_to_canonical_file_list_free ()
2189 __gnat_to_canonical_dir_spec (dirspec
, prefixflag
)
2191 int prefixflag ATTRIBUTE_UNUSED
;
2197 __gnat_to_canonical_file_spec (filespec
)
2204 __gnat_to_canonical_path_spec (pathspec
)
2211 __gnat_to_host_dir_spec (dirspec
, prefixflag
)
2213 int prefixflag ATTRIBUTE_UNUSED
;
2219 __gnat_to_host_file_spec (filespec
)
2226 __gnat_adjust_os_resource_limits ()
2232 /* For EMX, we cannot include dummy in libgcc, since it is too difficult
2233 to coordinate this with the EMX distribution. Consequently, we put the
2234 definition of dummy which is used for exception handling, here. */
2236 #if defined (__EMX__)
2240 #if defined (__mips_vxworks)
2243 CACHE_USER_FLUSH (0, ENTIRE_CACHE
);
2247 #if defined (CROSS_COMPILE) \
2248 || (! (defined (sparc) && defined (sun) && defined (__SVR4)) \
2249 && ! defined (linux) \
2250 && ! defined (hpux) \
2251 && ! (defined (__alpha__) && defined (__osf__)) \
2252 && ! defined (__MINGW32__))
2254 /* Dummy function to satisfy g-trasym.o. Currently Solaris sparc, HP/UX,
2255 GNU/Linux, Tru64 & Windows provide a non-dummy version of this procedure in
2259 convert_addresses (addrs
, n_addr
, buf
, len
)
2260 void *addrs ATTRIBUTE_UNUSED
;
2261 int n_addr ATTRIBUTE_UNUSED
;
2262 void *buf ATTRIBUTE_UNUSED
;
2269 #if defined (_WIN32)
2270 int __gnat_argument_needs_quote
= 1;
2272 int __gnat_argument_needs_quote
= 0;