1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
9 * C Implementation File *
11 * Copyright (C) 1992-2001, 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 packages */
36 /* in the GNAT hierarchy (especially GNAT.OS_Lib) and in package Osint. */
37 /* Many of the subprograms in OS_Lib import standard library calls */
38 /* directly. This file contains all other routines. */
41 /* 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 us malloc. */
63 #define xmalloc(S) malloc (S)
70 #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
90 #define NOEXECUTE 0x04
93 /* use native 64-bit arithmetic */
94 #define unix_time_to_vms(X,Y) \
95 { unsigned long long reftime, tmptime = (X); \
96 $DESCRIPTOR (unixtime,"1-JAN-1970 0:00:00.00"); \
97 SYS$BINTIM (&unixtime, &reftime); \
98 Y = tmptime * 10000000 + reftime; }
100 /* descrip.h doesn't have everything ... */
101 struct dsc$descriptor_fib
103 unsigned long fib$l_len
;
104 struct fibdef
*fib$l_addr
;
109 unsigned short status
, count
;
110 unsigned long devdep
;
113 static char *tryfile
;
118 char string
[NAM$C_MAXRSS
+1];
126 #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
137 /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
138 defined in the current system. On DOS-like systems these flags control
139 whether the file is opened/created in text-translation mode (CR/LF in
140 external file mapped to LF in internal file), but in Unix-like systems,
141 no text translation is required, so these flags have no effect. */
143 #if defined (__EMX__)
159 #ifndef HOST_EXECUTABLE_SUFFIX
160 #define HOST_EXECUTABLE_SUFFIX ""
163 #ifndef HOST_OBJECT_SUFFIX
164 #define HOST_OBJECT_SUFFIX ".o"
167 #ifndef PATH_SEPARATOR
168 #define PATH_SEPARATOR ':'
171 #ifndef DIR_SEPARATOR
172 #define DIR_SEPARATOR '/'
175 char __gnat_dir_separator
= DIR_SEPARATOR
;
177 char __gnat_path_separator
= PATH_SEPARATOR
;
179 /* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
180 the base filenames that libraries specified with -lsomelib options
181 may have. This is used by GNATMAKE to check whether an executable
182 is up-to-date or not. The syntax is
184 library_template ::= { pattern ; } pattern NUL
185 pattern ::= [ prefix ] * [ postfix ]
187 These should only specify names of static libraries as it makes
188 no sense to determine at link time if dynamic-link libraries are
189 up to date or not. Any libraries that are not found are supposed
192 * if they are needed but not present, the link
195 * otherwise they are libraries in the system paths and so
196 they are considered part of the system and not checked
199 ??? This should be part of a GNAT host-specific compiler
200 file instead of being included in all user applications
201 as well. This is only a temporary work-around for 3.11b. */
203 #ifndef GNAT_LIBRARY_TEMPLATE
205 #define GNAT_LIBRARY_TEMPLATE "*.a"
207 #define GNAT_LIBRARY_TEMPLATE "*.olb"
209 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
213 const char *__gnat_library_template
= GNAT_LIBRARY_TEMPLATE
;
215 /* The following macro HAVE_READDIR_R should be defined if the
216 system provides the routine readdir_r */
217 #undef HAVE_READDIR_R
220 __gnat_to_gm_time (p_time
, p_year
, p_month
, p_day
, p_hours
, p_mins
, p_secs
)
222 int *p_year
, *p_month
, *p_day
, *p_hours
, *p_mins
, *p_secs
;
225 time_t time
= *p_time
;
228 /* On Windows systems, the time is sometimes rounded up to the nearest
229 even second, so if the number of seconds is odd, increment it. */
234 res
= gmtime (&time
);
238 *p_year
= res
->tm_year
;
239 *p_month
= res
->tm_mon
;
240 *p_day
= res
->tm_mday
;
241 *p_hours
= res
->tm_hour
;
242 *p_mins
= res
->tm_min
;
243 *p_secs
= res
->tm_sec
;
246 *p_year
= *p_month
= *p_day
= *p_hours
= *p_mins
= *p_secs
= 0;
249 /* Place the contents of the symbolic link named PATH in the buffer BUF,
250 which has size BUFSIZ. If PATH is a symbolic link, then return the number
251 of characters of its content in BUF. Otherwise, return -1. For Windows,
252 OS/2 and vxworks, always return -1. */
255 __gnat_readlink (path
, buf
, bufsiz
)
260 #if defined (MSDOS) || defined (_WIN32) || defined (__EMX__)
262 #elif defined (__INTERIX) || defined (VMS)
264 #elif defined (__vxworks)
267 return readlink (path
, buf
, bufsiz
);
271 /* Creates a symbolic link named newpath
272 which contains the string oldpath.
273 If newpath exists it will NOT be overwritten.
274 For Windows, OS/2, vxworks, Interix and VMS, always retur -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
)
303 char full_path
[256];
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
)
325 char full_path
[256];
328 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
329 fd
= open (full_path
, O_CREAT
| O_EXCL
, 0600);
338 /* Version using link(), more secure over NFS. */
341 __gnat_try_lock (dir
, file
)
345 char full_path
[256];
346 char temp_file
[256];
347 struct stat stat_result
;
350 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
351 sprintf (temp_file
, "%s-%d-%d", dir
, getpid(), getppid ());
353 /* Create the temporary file and write the process number */
354 fd
= open (temp_file
, O_CREAT
| O_WRONLY
, 0600);
360 /* Link it with the new file */
361 link (temp_file
, full_path
);
363 /* Count the references on the old one. If we have a count of two, then
364 the link did succeed. Remove the temporary file before returning. */
365 __gnat_stat (temp_file
, &stat_result
);
367 return stat_result
.st_nlink
== 2;
371 /* Return the maximum file name length. */
374 __gnat_get_maximum_file_name_length ()
379 if (getenv ("GNAT$EXTENDED_FILE_SPECIFICATIONS"))
388 /* Return the default switch character. */
391 __gnat_get_switch_character ()
393 /* Under MSDOS, the switch character is not normally a hyphen, but this is
394 the convention DJGPP uses. Similarly under OS2, the switch character is
395 not normally a hypen, but this is the convention EMX uses. */
400 /* Return nonzero if file names are case sensitive. */
403 __gnat_get_file_names_case_sensitive ()
405 #if defined (__EMX__) || defined (MSDOS) || defined (VMS) || defined(WINNT)
413 __gnat_get_default_identifier_character_set ()
415 #if defined (__EMX__) || defined (MSDOS)
422 /* Return the current working directory */
425 __gnat_get_current_dir (dir
, length
)
430 /* Force Unix style, which is what GNAT uses internally. */
431 getcwd (dir
, *length
, 0);
433 getcwd (dir
, *length
);
436 *length
= strlen (dir
);
438 dir
[*length
] = DIR_SEPARATOR
;
440 dir
[*length
] = '\0';
443 /* Return the suffix for object files. */
446 __gnat_get_object_suffix_ptr (len
, value
)
450 *value
= HOST_OBJECT_SUFFIX
;
455 *len
= strlen (*value
);
460 /* Return the suffix for executable files */
463 __gnat_get_executable_suffix_ptr (len
, value
)
467 *value
= HOST_EXECUTABLE_SUFFIX
;
471 *len
= strlen (*value
);
476 /* Return the suffix for debuggable files. Usually this is the same as the
477 executable extension. */
480 __gnat_get_debuggable_suffix_ptr (len
, value
)
485 *value
= HOST_EXECUTABLE_SUFFIX
;
487 /* On DOS, the extensionless COFF file is what gdb likes. */
494 *len
= strlen (*value
);
500 __gnat_open_read (path
, fmode
)
505 int o_fmode
= O_BINARY
;
511 /* Optional arguments mbc,deq,fop increase read performance */
512 fd
= open (path
, O_RDONLY
| o_fmode
, 0444,
513 "mbc=16", "deq=64", "fop=tef");
514 #elif defined(__vxworks)
515 fd
= open (path
, O_RDONLY
| o_fmode
, 0444);
517 fd
= open (path
, O_RDONLY
| o_fmode
);
519 return fd
< 0 ? -1 : fd
;
522 #if defined (__EMX__)
523 #define PERM (S_IREAD | S_IWRITE)
525 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
529 __gnat_open_rw (path
, fmode
)
534 int o_fmode
= O_BINARY
;
540 fd
= open (path
, O_RDWR
| o_fmode
, PERM
,
541 "mbc=16", "deq=64", "fop=tef");
543 fd
= open (path
, O_RDWR
| o_fmode
, PERM
);
546 return fd
< 0 ? -1 : fd
;
550 __gnat_open_create (path
, fmode
)
555 int o_fmode
= O_BINARY
;
561 fd
= open (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
,
562 "mbc=16", "deq=64", "fop=tef");
564 fd
= open (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
567 return fd
< 0 ? -1 : fd
;
571 __gnat_open_append (path
, fmode
)
576 int o_fmode
= O_BINARY
;
582 fd
= open (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
,
583 "mbc=16", "deq=64", "fop=tef");
585 fd
= open (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
588 return fd
< 0 ? -1 : fd
;
591 /* Open a new file. Return error (-1) if the file already exists. */
594 __gnat_open_new (path
, fmode
)
599 int o_fmode
= O_BINARY
;
605 fd
= open (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
,
606 "mbc=16", "deq=64", "fop=tef");
608 fd
= open (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
611 return fd
< 0 ? -1 : fd
;
614 /* Open a new temp file. Return error (-1) if the file already exists.
615 Special options for VMS allow the file to be shared between parent and
616 child processes, however they really slow down output. Used in
620 __gnat_open_new_temp (path
, fmode
)
625 int o_fmode
= O_BINARY
;
627 strcpy (path
, "GNAT-XXXXXX");
629 #if defined (linux) && !defined (__vxworks)
630 return mkstemp (path
);
633 if (mktemp (path
) == NULL
)
641 fd
= open (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
,
642 "rfm=stmlf", "ctx=rec", "rat=none", "shr=del,get,put,upd",
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
;
652 __gnat_mkdir (dir_name
)
655 /* On some systems, mkdir has two args and on some it has one. If we
656 are being built as part of the compiler, autoconf has figured that out
657 for us. Otherwise, we have to do it ourselves. */
659 return mkdir (dir_name
, S_IRWXU
| S_IRWXG
| S_IRWXO
);
661 #if defined (_WIN32) || defined (__vxworks)
662 return mkdir (dir_name
);
664 return mkdir (dir_name
, S_IRWXU
| S_IRWXG
| S_IRWXO
);
669 /* Return the number of bytes in the specified file. */
672 __gnat_file_length (fd
)
678 ret
= fstat (fd
, &statbuf
);
679 if (ret
|| !S_ISREG (statbuf
.st_mode
))
682 return (statbuf
.st_size
);
685 /* Create a temporary filename and put it in string pointed to by
689 __gnat_tmp_name (tmp_filename
)
696 /* tempnam tries to create a temporary file in directory pointed to by
697 TMP environment variable, in c:\temp if TMP is not set, and in
698 directory specified by P_tmpdir in stdio.h if c:\temp does not
699 exist. The filename will be created with the prefix "gnat-". */
701 pname
= (char *) tempnam ("c:\\temp", "gnat-");
703 /* if pname start with a back slash and not path information it means that
704 the filename is valid for the current working directory */
706 if (pname
[0] == '\\')
708 strcpy (tmp_filename
, ".\\");
709 strcat (tmp_filename
, pname
+1);
712 strcpy (tmp_filename
, pname
);
716 #elif defined (linux)
717 char *tmpdir
= getenv ("TMPDIR");
720 strcpy (tmp_filename
, "/tmp/gnat-XXXXXX");
722 sprintf (tmp_filename
, "%s/gnat-XXXXXX", tmpdir
);
724 close (mkstemp(tmp_filename
));
726 tmpnam (tmp_filename
);
730 /* Read the next entry in a directory. The returned string points somewhere
734 __gnat_readdir (dirp
, buffer
)
738 /* If possible, try to use the thread-safe version. */
739 #ifdef HAVE_READDIR_R
740 if (readdir_r (dirp
, buffer
) != NULL
)
741 return ((struct dirent
*) buffer
)->d_name
;
746 struct dirent
*dirent
= readdir (dirp
);
750 strcpy (buffer
, dirent
->d_name
);
759 /* Returns 1 if readdir is thread safe, 0 otherwise. */
762 __gnat_readdir_is_thread_safe ()
764 #ifdef HAVE_READDIR_R
773 /* Returns the file modification timestamp using Win32 routines which are
774 immune against daylight saving time change. It is in fact not possible to
775 use fstat for this purpose as the DST modify the st_mtime field of the
786 unsigned long long timestamp
;
788 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
789 unsigned long long offset
= 11644473600;
791 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
792 since <Jan 1st 1601>. This function must return the number of seconds
793 since <Jan 1st 1970>. */
795 res
= GetFileTime (h
, &t_create
, &t_access
, &t_write
);
797 timestamp
= (((long long) t_write
.dwHighDateTime
<< 32)
798 + t_write
.dwLowDateTime
);
800 timestamp
= timestamp
/ 10000000 - offset
;
802 return (time_t) timestamp
;
806 /* Return a GNAT time stamp given a file name. */
809 __gnat_file_time_name (name
)
814 #if defined (__EMX__) || defined (MSDOS)
815 int fd
= open (name
, O_RDONLY
| O_BINARY
);
816 time_t ret
= __gnat_file_time_fd (fd
);
820 #elif defined (_WIN32)
821 HANDLE h
= CreateFile (name
, GENERIC_READ
, FILE_SHARE_READ
, 0,
822 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
, 0);
823 time_t ret
= win32_filetime (h
);
828 (void) __gnat_stat (name
, &statbuf
);
830 /* VMS has file versioning */
831 return statbuf
.st_ctime
;
833 return statbuf
.st_mtime
;
838 /* Return a GNAT time stamp given a file descriptor. */
841 __gnat_file_time_fd (fd
)
844 /* The following workaround code is due to the fact that under EMX and
845 DJGPP fstat attempts to convert time values to GMT rather than keep the
846 actual OS timestamp of the file. By using the OS2/DOS functions directly
847 the GNAT timestamp are independent of this behavior, which is desired to
848 facilitate the distribution of GNAT compiled libraries. */
850 #if defined (__EMX__) || defined (MSDOS)
854 int ret
= DosQueryFileInfo (fd
, 1, (unsigned char *) &fs
,
855 sizeof (FILESTATUS
));
857 unsigned file_year
= fs
.fdateLastWrite
.year
;
858 unsigned file_month
= fs
.fdateLastWrite
.month
;
859 unsigned file_day
= fs
.fdateLastWrite
.day
;
860 unsigned file_hour
= fs
.ftimeLastWrite
.hours
;
861 unsigned file_min
= fs
.ftimeLastWrite
.minutes
;
862 unsigned file_tsec
= fs
.ftimeLastWrite
.twosecs
;
866 int ret
= getftime (fd
, &fs
);
868 unsigned file_year
= fs
.ft_year
;
869 unsigned file_month
= fs
.ft_month
;
870 unsigned file_day
= fs
.ft_day
;
871 unsigned file_hour
= fs
.ft_hour
;
872 unsigned file_min
= fs
.ft_min
;
873 unsigned file_tsec
= fs
.ft_tsec
;
876 /* Calculate the seconds since epoch from the time components. First count
877 the whole days passed. The value for years returned by the DOS and OS2
878 functions count years from 1980, so to compensate for the UNIX epoch which
879 begins in 1970 start with 10 years worth of days and add days for each
880 four year period since then. */
883 int cum_days
[12] = {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
884 int days_passed
= 3652 + (file_year
/ 4) * 1461;
885 int years_since_leap
= file_year
% 4;
887 if (years_since_leap
== 1)
889 else if (years_since_leap
== 2)
891 else if (years_since_leap
== 3)
897 days_passed
+= cum_days
[file_month
- 1];
898 if (years_since_leap
== 0 && file_year
!= 20 && file_month
> 2)
901 days_passed
+= file_day
- 1;
903 /* OK - have whole days. Multiply -- then add in other parts. */
905 tot_secs
= days_passed
* 86400;
906 tot_secs
+= file_hour
* 3600;
907 tot_secs
+= file_min
* 60;
908 tot_secs
+= file_tsec
* 2;
911 #elif defined (_WIN32)
912 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
913 time_t ret
= win32_filetime (h
);
920 (void) fstat (fd
, &statbuf
);
923 /* VMS has file versioning */
924 return statbuf
.st_ctime
;
926 return statbuf
.st_mtime
;
931 /* Set the file time stamp */
934 __gnat_set_file_time_name (name
, time_stamp
)
938 #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
945 unsigned long long backup
, create
, expire
, revise
;
949 unsigned short value
;
962 { ATR$S_CREDATE
, ATR$C_CREDATE
, &Fat
.create
},
963 { ATR$S_REVDATE
, ATR$C_REVDATE
, &Fat
.revise
},
964 { ATR$S_EXPDATE
, ATR$C_EXPDATE
, &Fat
.expire
},
965 { ATR$S_BAKDATE
, ATR$C_BAKDATE
, &Fat
.backup
},
966 n
{ ATR$S_FPRO
, ATR$C_FPRO
, &Fat
.prot
},
967 { ATR$S_UIC
, ATR$C_UIC
, &Fat
.uic
},
972 struct dsc$descriptor_fib fibdsc
= {sizeof (fib
), (void *) &fib
};
976 unsigned long long newtime
;
977 unsigned long long revtime
;
982 struct dsc$descriptor_s filedsc
983 = {NAM$C_MAXRSS
, DSC$K_DTYPE_T
, DSC$K_CLASS_S
, (void *) file
.string
};
984 struct vstring device
;
985 struct dsc$descriptor_s devicedsc
986 = {NAM$C_MAXRSS
, DSC$K_DTYPE_T
, DSC$K_CLASS_S
, (void *) device
.string
};
987 struct vstring timev
;
988 struct dsc$descriptor_s timedsc
989 = {NAM$C_MAXRSS
, DSC$K_DTYPE_T
, DSC$K_CLASS_S
, (void *) timev
.string
};
990 struct vstring result
;
991 struct dsc$descriptor_s resultdsc
992 = {NAM$C_MAXRSS
, DSC$K_DTYPE_VT
, DSC$K_CLASS_VS
, (void *) result
.string
};
994 tryfile
= (char *) __gnat_to_host_dir_spec (name
, 0);
996 /* Allocate and initialize a fab and nam structures. */
1000 nam
.nam$l_esa
= file
.string
;
1001 nam
.nam$b_ess
= NAM$C_MAXRSS
;
1002 nam
.nam$l_rsa
= result
.string
;
1003 nam
.nam$b_rss
= NAM$C_MAXRSS
;
1004 fab
.fab$l_fna
= tryfile
;
1005 fab
.fab$b_fns
= strlen (tryfile
);
1006 fab
.fab$l_nam
= &nam
;
1008 /*Validate filespec syntax and device existence. */
1009 status
= SYS$
PARSE (&fab
, 0, 0);
1010 if ((status
& 1) != 1)
1011 LIB$
SIGNAL (status
);
1013 file
.string
[nam
.nam$b_esl
] = 0;
1015 /* Find matching filespec. */
1016 status
= SYS$
SEARCH (&fab
, 0, 0);
1017 if ((status
& 1) != 1)
1018 LIB$
SIGNAL (status
);
1020 file
.string
[nam
.nam$b_esl
] = 0;
1021 result
.string
[result
.length
=nam
.nam$b_rsl
] = 0;
1023 /* Get the device name and assign an IO channel. */
1024 strncpy (device
.string
, nam
.nam$l_dev
, nam
.nam$b_dev
);
1025 devicedsc
.dsc$w_length
= nam
.nam$b_dev
;
1027 status
= SYS$
ASSIGN (&devicedsc
, &chan
, 0, 0, 0);
1028 if ((status
& 1) != 1)
1029 LIB$
SIGNAL (status
);
1031 /* Initialize the FIB and fill in the directory id field. */
1032 bzero (&fib
, sizeof (fib
));
1033 fib
.fib$w_did
[0] = nam
.nam$w_did
[0];
1034 fib
.fib$w_did
[1] = nam
.nam$w_did
[1];
1035 fib
.fib$w_did
[2] = nam
.nam$w_did
[2];
1036 fib
.fib$l_acctl
= 0;
1038 strcpy (file
.string
, (strrchr (result
.string
, ']') + 1));
1039 filedsc
.dsc$w_length
= strlen (file
.string
);
1040 result
.string
[result
.length
= 0] = 0;
1042 /* Open and close the file to fill in the attributes. */
1044 = SYS$
QIOW (0, chan
, IO$_ACCESS
|IO$M_ACCESS
, &iosb
, 0, 0,
1045 &fibdsc
, &filedsc
, &result
.length
, &resultdsc
, &atrlst
, 0);
1046 if ((status
& 1) != 1)
1047 LIB$
SIGNAL (status
);
1048 if ((iosb
.status
& 1) != 1)
1049 LIB$
SIGNAL (iosb
.status
);
1051 result
.string
[result
.length
] = 0;
1052 status
= SYS$
QIOW (0, chan
, IO$_DEACCESS
, &iosb
, 0, 0,
1053 &fibdsc
, 0, 0, 0, &atrlst
, 0);
1054 if ((status
& 1) != 1)
1055 LIB$
SIGNAL (status
);
1056 if ((iosb
.status
& 1) != 1)
1057 LIB$
SIGNAL (iosb
.status
);
1059 /* Set creation time to requested time */
1060 unix_time_to_vms (time_stamp
, newtime
);
1066 t
= time ((time_t) 0);
1067 ts
= localtime (&t
);
1069 /* Set revision time to now in local time. */
1070 unix_time_to_vms (t
+ ts
->tm_gmtoff
, revtime
);
1073 /* Reopen the file, modify the times and then close. */
1074 fib
.fib$l_acctl
= FIB$M_WRITE
;
1076 = SYS$
QIOW (0, chan
, IO$_ACCESS
|IO$M_ACCESS
, &iosb
, 0, 0,
1077 &fibdsc
, &filedsc
, &result
.length
, &resultdsc
, &atrlst
, 0);
1078 if ((status
& 1) != 1)
1079 LIB$
SIGNAL (status
);
1080 if ((iosb
.status
& 1) != 1)
1081 LIB$
SIGNAL (iosb
.status
);
1083 Fat
.create
= newtime
;
1084 Fat
.revise
= revtime
;
1086 status
= SYS$
QIOW (0, chan
, IO$_DEACCESS
, &iosb
, 0, 0,
1087 &fibdsc
, 0, 0, 0, &atrlst
, 0);
1088 if ((status
& 1) != 1)
1089 LIB$
SIGNAL (status
);
1090 if ((iosb
.status
& 1) != 1)
1091 LIB$
SIGNAL (iosb
.status
);
1093 /* Deassign the channel and exit. */
1094 status
= SYS$
DASSGN (chan
);
1095 if ((status
& 1) != 1)
1096 LIB$
SIGNAL (status
);
1098 struct utimbuf utimbuf
;
1101 /* Set modification time to requested time */
1102 utimbuf
.modtime
= time_stamp
;
1104 /* Set access time to now in local time */
1105 t
= time ((time_t) 0);
1106 utimbuf
.actime
= mktime (localtime (&t
));
1108 utime (name
, &utimbuf
);
1113 __gnat_get_env_value_ptr (name
, len
, value
)
1118 *value
= getenv (name
);
1122 *len
= strlen (*value
);
1127 /* VMS specific declarations for set_env_value. */
1131 static char *to_host_path_spec
PROTO ((char *));
1135 unsigned short len
, mbz
;
1139 typedef struct _ile3
1141 unsigned short len
, code
;
1143 unsigned short *retlen_adr
;
1149 __gnat_set_env_value (name
, value
)
1156 struct descriptor_s name_desc
;
1157 /* Put in JOB table for now, so that the project stuff at least works */
1158 struct descriptor_s table_desc
= {7, 0, "LNM$JOB"};
1159 char *host_pathspec
= to_host_path_spec (value
);
1160 char *copy_pathspec
;
1161 int num_dirs_in_pathspec
= 1;
1164 if (*host_pathspec
== 0)
1167 name_desc
.len
= strlen (name
);
1169 name_desc
.adr
= name
;
1171 ptr
= host_pathspec
;
1174 num_dirs_in_pathspec
++;
1178 ile_s
*ile_array
= alloca (sizeof (ile_s
) * (num_dirs_in_pathspec
+ 1));
1179 char *copy_pathspec
= alloca (strlen (host_pathspec
) + 1);
1182 strcpy (copy_pathspec
, host_pathspec
);
1183 curr
= copy_pathspec
;
1184 for (i
= 0; i
< num_dirs_in_pathspec
; i
++)
1186 next
= strchr (curr
, ',');
1188 next
= strchr (curr
, 0);
1191 ile_array
[i
].len
= strlen (curr
);
1193 /* Code 2 from lnmdef.h means its a string */
1194 ile_array
[i
].code
= 2;
1195 ile_array
[i
].adr
= curr
;
1197 /* retlen_adr is ignored */
1198 ile_array
[i
].retlen_adr
= 0;
1202 /* Terminating item must be zero */
1203 ile_array
[i
].len
= 0;
1204 ile_array
[i
].code
= 0;
1205 ile_array
[i
].adr
= 0;
1206 ile_array
[i
].retlen_adr
= 0;
1208 status
= LIB$
SET_LOGICAL (&name_desc
, 0, &table_desc
, 0, ile_array
);
1209 if ((status
& 1) != 1)
1210 LIB$
SIGNAL (status
);
1214 int size
= strlen (name
) + strlen (value
) + 2;
1217 expression
= (char *) xmalloc (size
* sizeof (char));
1219 sprintf (expression
, "%s=%s", name
, value
);
1220 putenv (expression
);
1225 #include <windows.h>
1228 /* Get the list of installed standard libraries from the
1229 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1233 __gnat_get_libraries_from_registry ()
1235 char *result
= (char *) "";
1237 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_COMPILE)
1240 DWORD name_size
, value_size
;
1247 /* First open the key. */
1248 res
= RegOpenKeyExA (HKEY_LOCAL_MACHINE
, "SOFTWARE", 0, KEY_READ
, ®_key
);
1250 if (res
== ERROR_SUCCESS
)
1251 res
= RegOpenKeyExA (reg_key
, "Ada Core Technologies", 0,
1252 KEY_READ
, ®_key
);
1254 if (res
== ERROR_SUCCESS
)
1255 res
= RegOpenKeyExA (reg_key
, "GNAT", 0, KEY_READ
, ®_key
);
1257 if (res
== ERROR_SUCCESS
)
1258 res
= RegOpenKeyExA (reg_key
, "Standard Libraries", 0, KEY_READ
, ®_key
);
1260 /* If the key exists, read out all the values in it and concatenate them
1262 for (index
= 0; res
== ERROR_SUCCESS
; index
++)
1264 value_size
= name_size
= 256;
1265 res
= RegEnumValue (reg_key
, index
, name
, &name_size
, 0,
1266 &type
, value
, &value_size
);
1268 if (res
== ERROR_SUCCESS
&& type
== REG_SZ
)
1270 char *old_result
= result
;
1272 result
= (char *) xmalloc (strlen (old_result
) + value_size
+ 2);
1273 strcpy (result
, old_result
);
1274 strcat (result
, value
);
1275 strcat (result
, ";");
1279 /* Remove the trailing ";". */
1281 result
[strlen (result
) - 1] = 0;
1288 __gnat_stat (name
, statbuf
)
1290 struct stat
*statbuf
;
1293 /* Under Windows the directory name for the stat function must not be
1294 terminated by a directory separator except if just after a drive name. */
1295 int name_len
= strlen (name
);
1296 char last_char
= name
[name_len
- 1];
1297 char win32_name
[4096];
1299 strcpy (win32_name
, name
);
1301 while (name_len
> 1 && (last_char
== '\\' || last_char
== '/'))
1303 win32_name
[name_len
- 1] = '\0';
1305 last_char
= win32_name
[name_len
- 1];
1308 if (name_len
== 2 && win32_name
[1] == ':')
1309 strcat (win32_name
, "\\");
1311 return stat (win32_name
, statbuf
);
1314 return stat (name
, statbuf
);
1319 __gnat_file_exists (name
)
1322 struct stat statbuf
;
1324 return !__gnat_stat (name
, &statbuf
);
1328 __gnat_is_absolute_path (name
)
1331 return (*name
== '/' || *name
== DIR_SEPARATOR
1332 #if defined(__EMX__) || defined(MSDOS) || defined(WINNT)
1333 || strlen (name
) > 1 && isalpha (name
[0]) && name
[1] == ':'
1339 __gnat_is_regular_file (name
)
1343 struct stat statbuf
;
1345 ret
= __gnat_stat (name
, &statbuf
);
1346 return (!ret
&& S_ISREG (statbuf
.st_mode
));
1350 __gnat_is_directory (name
)
1354 struct stat statbuf
;
1356 ret
= __gnat_stat (name
, &statbuf
);
1357 return (!ret
&& S_ISDIR (statbuf
.st_mode
));
1361 __gnat_is_writable_file (name
)
1366 struct stat statbuf
;
1368 ret
= __gnat_stat (name
, &statbuf
);
1369 mode
= statbuf
.st_mode
& S_IWUSR
;
1370 return (!ret
&& mode
);
1374 /* Defined in VMS header files */
1375 #define fork() (decc$$alloc_vfork_blocks() >= 0 ? \
1376 LIB$GET_CURRENT_INVO_CONTEXT (decc$$get_vfork_jmpbuf()) : -1)
1379 #if defined (sun) && defined (__SVR4)
1380 /* Using fork on Solaris will duplicate all the threads. fork1, which
1381 duplicates only the active thread, must be used instead, or spawning
1382 subprocess from a program with tasking will lead into numerous problems. */
1387 __gnat_portable_spawn (args
)
1394 #if defined (MSDOS) || defined (_WIN32)
1395 status
= spawnvp (P_WAIT
, args
[0], args
);
1401 #elif defined(__vxworks) /* Mods for VxWorks */
1402 pid
= sp (args
[0], args
); /* Spawn process and save pid */
1406 while (taskIdVerify(pid
) >= 0)
1407 /* Wait until spawned task is complete then continue. */
1412 pid
= spawnvp (P_NOWAIT
, args
[0], args
);
1420 if (pid
== 0 && execv (args
[0], args
) != 0)
1425 finished
= waitpid (pid
, &status
, 0);
1427 if (finished
!= pid
|| WIFEXITED (status
) == 0)
1430 return WEXITSTATUS (status
);
1435 /* 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
;
1533 char full_command
[2000];
1537 SI
.cb
= sizeof (STARTUPINFO
);
1538 SI
.lpReserved
= NULL
;
1539 SI
.lpReserved2
= NULL
;
1540 SI
.lpDesktop
= NULL
;
1544 SI
.wShowWindow
= SW_HIDE
;
1546 /* Security attributes. */
1547 SA
.nLength
= sizeof (SECURITY_ATTRIBUTES
);
1548 SA
.bInheritHandle
= TRUE
;
1549 SA
.lpSecurityDescriptor
= NULL
;
1551 /* Prepare the command string. */
1552 strcpy (full_command
, command
);
1553 strcat (full_command
, " ");
1558 strcat (full_command
, args
[k
]);
1559 strcat (full_command
, " ");
1563 result
= CreateProcess (NULL
, (char *) full_command
, &SA
, NULL
, TRUE
,
1564 NORMAL_PRIORITY_CLASS
, NULL
, NULL
, &SI
, &PI
);
1568 add_handle (PI
.hProcess
);
1569 CloseHandle (PI
.hThread
);
1570 return (int) PI
.hProcess
;
1587 if (plist_length
== 0)
1593 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * plist_length
);
1598 /* -------------------- critical section -------------------- */
1605 /* -------------------- critical section -------------------- */
1609 res
= WaitForMultipleObjects (plist_length
, hl
, FALSE
, INFINITE
);
1610 h
= hl
[res
- WAIT_OBJECT_0
];
1615 GetExitCodeProcess (h
, &exitcode
);
1618 *status
= (int) exitcode
;
1625 __gnat_portable_no_block_spawn (args
)
1630 #if defined (__EMX__) || defined (MSDOS)
1632 /* ??? For PC machines I (Franco) don't know the system calls to implement
1633 this routine. So I'll fake it as follows. This routine will behave
1634 exactly like the blocking portable_spawn and will systematically return
1635 a pid of 0 unless the spawned task did not complete successfully, in
1636 which case we return a pid of -1. To synchronize with this the
1637 portable_wait below systematically returns a pid of 0 and reports that
1638 the subprocess terminated successfully. */
1640 if (spawnvp (P_WAIT
, args
[0], args
) != 0)
1643 #elif defined (_WIN32)
1645 pid
= win32_no_block_spawn (args
[0], args
);
1648 #elif defined (__vxworks) /* Mods for VxWorks */
1649 pid
= sp (args
[0], args
); /* Spawn task and then return (no waiting) */
1658 if (pid
== 0 && execv (args
[0], args
) != 0)
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
1685 /* Wait doesn't do the right thing on VMS */
1686 pid
= waitpid (-1, &status
, 0);
1688 pid
= wait (&status
);
1690 status
= status
& 0xffff;
1693 *process_status
= status
;
1698 __gnat_os_exit (status
)
1702 /* Exit without changing 0 to 1 */
1703 __posix_exit (status
);
1709 /* Locate a regular file, give a Path value */
1712 __gnat_locate_regular_file (file_name
, path_val
)
1718 /* Handle absolute pathnames. */
1719 for (ptr
= file_name
; *ptr
&& *ptr
!= '/' && *ptr
!= DIR_SEPARATOR
; ptr
++)
1723 #if defined(__EMX__) || defined(MSDOS) || defined(WINNT)
1724 || isalpha (file_name
[0]) && file_name
[1] == ':'
1728 if (__gnat_is_regular_file (file_name
))
1729 return xstrdup (file_name
);
1738 /* The result has to be smaller than path_val + file_name. */
1739 char *file_path
= alloca (strlen (path_val
) + strlen (file_name
) + 2);
1743 for (; *path_val
== PATH_SEPARATOR
; path_val
++)
1749 for (ptr
= file_path
; *path_val
&& *path_val
!= PATH_SEPARATOR
; )
1750 *ptr
++ = *path_val
++;
1753 if (*ptr
!= '/' && *ptr
!= DIR_SEPARATOR
)
1754 *++ptr
= DIR_SEPARATOR
;
1756 strcpy (++ptr
, file_name
);
1758 if (__gnat_is_regular_file (file_path
))
1759 return xstrdup (file_path
);
1767 /* Locate an executable given a Path argument. This routine is only used by
1768 gnatbl and should not be used otherwise. Use locate_exec_on_path
1772 __gnat_locate_exec (exec_name
, path_val
)
1776 if (!strstr (exec_name
, HOST_EXECUTABLE_SUFFIX
))
1778 char *full_exec_name
1779 = alloca (strlen (exec_name
) + strlen (HOST_EXECUTABLE_SUFFIX
) + 1);
1781 strcpy (full_exec_name
, exec_name
);
1782 strcat (full_exec_name
, HOST_EXECUTABLE_SUFFIX
);
1783 return __gnat_locate_regular_file (full_exec_name
, path_val
);
1786 return __gnat_locate_regular_file (exec_name
, path_val
);
1789 /* Locate an executable using the Systems default PATH */
1792 __gnat_locate_exec_on_path (exec_name
)
1796 char *path_val
= "/VAXC$PATH";
1798 char *path_val
= getenv ("PATH");
1800 char *apath_val
= alloca (strlen (path_val
) + 1);
1802 strcpy (apath_val
, path_val
);
1803 return __gnat_locate_exec (exec_name
, apath_val
);
1808 /* These functions are used to translate to and from VMS and Unix syntax
1809 file, directory and path specifications. */
1811 #define MAXNAMES 256
1812 #define NEW_CANONICAL_FILELIST_INCREMENT 64
1814 static char new_canonical_dirspec
[255];
1815 static char new_canonical_filespec
[255];
1816 static char new_canonical_pathspec
[MAXNAMES
*255];
1817 static unsigned new_canonical_filelist_index
;
1818 static unsigned new_canonical_filelist_in_use
;
1819 static unsigned new_canonical_filelist_allocated
;
1820 static char **new_canonical_filelist
;
1821 static char new_host_pathspec
[MAXNAMES
*255];
1822 static char new_host_dirspec
[255];
1823 static char new_host_filespec
[255];
1825 /* Routine is called repeatedly by decc$from_vms via
1826 __gnat_to_canonical_file_list_init until it returns 0 or the expansion
1830 wildcard_translate_unix (name
)
1836 strcpy (buff
, name
);
1837 ver
= strrchr (buff
, '.');
1839 /* Chop off the version */
1843 /* Dynamically extend the allocation by the increment */
1844 if (new_canonical_filelist_in_use
== new_canonical_filelist_allocated
)
1846 new_canonical_filelist_allocated
+= NEW_CANONICAL_FILELIST_INCREMENT
;
1847 new_canonical_filelist
= (char **) realloc
1848 (new_canonical_filelist
,
1849 new_canonical_filelist_allocated
* sizeof (char *));
1852 new_canonical_filelist
[new_canonical_filelist_in_use
++] = xstrdup (buff
);
1857 /* Translate a wildcard VMS file spec into a list of Unix file
1858 specs. First do full translation and copy the results into a list (_init),
1859 then return them one at a time (_next). If onlydirs set, only expand
1863 __gnat_to_canonical_file_list_init (filespec
, onlydirs
)
1870 len
= strlen (filespec
);
1871 strcpy (buff
, filespec
);
1873 /* Only look for directories */
1874 if (onlydirs
&& !strstr (&buff
[len
-5], "*.dir"))
1875 strcat (buff
, "*.dir");
1877 decc$
from_vms (buff
, wildcard_translate_unix
, 1);
1879 /* Remove the .dir extension */
1885 for (i
= 0; i
< new_canonical_filelist_in_use
; i
++)
1887 ext
= strstr (new_canonical_filelist
[i
], ".dir");
1893 return new_canonical_filelist_in_use
;
1896 /* Return the next filespec in the list */
1899 __gnat_to_canonical_file_list_next ()
1901 return new_canonical_filelist
[new_canonical_filelist_index
++];
1904 /* Free up storage used in the wildcard expansion */
1907 __gnat_to_canonical_file_list_free ()
1911 for (i
= 0; i
< new_canonical_filelist_in_use
; i
++)
1912 free (new_canonical_filelist
[i
]);
1914 free (new_canonical_filelist
);
1916 new_canonical_filelist_in_use
= 0;
1917 new_canonical_filelist_allocated
= 0;
1918 new_canonical_filelist_index
= 0;
1919 new_canonical_filelist
= 0;
1922 /* Translate a VMS syntax directory specification in to Unix syntax.
1923 If prefixflag is set, append an underscore "/". If no indicators
1924 of VMS syntax found, return input string. Also translate a dirname
1925 that contains no slashes, in case it's a logical name. */
1928 __gnat_to_canonical_dir_spec (dirspec
,prefixflag
)
1934 strcpy (new_canonical_dirspec
, "");
1935 if (strlen (dirspec
))
1939 if (strchr (dirspec
, ']') || strchr (dirspec
, ':'))
1940 strcpy (new_canonical_dirspec
, (char *) decc$
translate_vms (dirspec
));
1941 else if (!strchr (dirspec
, '/') && (dirspec1
= getenv (dirspec
)) != 0)
1942 strcpy (new_canonical_dirspec
, (char *) decc$
translate_vms (dirspec1
));
1944 strcpy (new_canonical_dirspec
, dirspec
);
1947 len
= strlen (new_canonical_dirspec
);
1948 if (prefixflag
&& new_canonical_dirspec
[len
-1] != '/')
1949 strcat (new_canonical_dirspec
, "/");
1951 return new_canonical_dirspec
;
1955 /* Translate a VMS syntax file specification into Unix syntax.
1956 If no indicators of VMS syntax found, return input string. */
1959 __gnat_to_canonical_file_spec (filespec
)
1962 strcpy (new_canonical_filespec
, "");
1963 if (strchr (filespec
, ']') || strchr (filespec
, ':'))
1964 strcpy (new_canonical_filespec
, (char *) decc$
translate_vms (filespec
));
1966 strcpy (new_canonical_filespec
, filespec
);
1968 return new_canonical_filespec
;
1971 /* Translate a VMS syntax path specification into Unix syntax.
1972 If no indicators of VMS syntax found, return input string. */
1975 __gnat_to_canonical_path_spec (pathspec
)
1978 char *curr
, *next
, buff
[256];
1983 /* If there are /'s, assume it's a Unix path spec and return */
1984 if (strchr (pathspec
, '/'))
1987 new_canonical_pathspec
[0] = 0;
1992 next
= strchr (curr
, ',');
1994 next
= strchr (curr
, 0);
1996 strncpy (buff
, curr
, next
- curr
);
1997 buff
[next
- curr
] = 0;
1999 /* Check for wildcards and expand if present */
2000 if (strchr (buff
, '*') || strchr (buff
, '%') || strstr (buff
, "..."))
2004 dirs
= __gnat_to_canonical_file_list_init (buff
, 1);
2005 for (i
= 0; i
< dirs
; i
++)
2009 next_dir
= __gnat_to_canonical_file_list_next ();
2010 strcat (new_canonical_pathspec
, next_dir
);
2012 /* Don't append the separator after the last expansion */
2014 strcat (new_canonical_pathspec
, ":");
2017 __gnat_to_canonical_file_list_free ();
2020 strcat (new_canonical_pathspec
,
2021 __gnat_to_canonical_dir_spec (buff
, 0));
2026 strcat (new_canonical_pathspec
, ":");
2030 return new_canonical_pathspec
;
2033 static char filename_buff
[256];
2036 translate_unix (name
, type
)
2040 strcpy (filename_buff
, name
);
2044 /* Translate a Unix syntax path spec into a VMS style (comma separated
2045 list of directories. Only used in this file so make it static */
2048 to_host_path_spec (pathspec
)
2051 char *curr
, *next
, buff
[256];
2056 /* Can't very well test for colons, since that's the Unix separator! */
2057 if (strchr (pathspec
, ']') || strchr (pathspec
, ','))
2060 new_host_pathspec
[0] = 0;
2065 next
= strchr (curr
, ':');
2067 next
= strchr (curr
, 0);
2069 strncpy (buff
, curr
, next
- curr
);
2070 buff
[next
- curr
] = 0;
2072 strcat (new_host_pathspec
, __gnat_to_host_dir_spec (buff
, 0));
2075 strcat (new_host_pathspec
, ",");
2079 return new_host_pathspec
;
2082 /* Translate a Unix syntax directory specification into VMS syntax.
2083 The prefixflag has no effect, but is kept for symmetry with
2084 to_canonical_dir_spec.
2085 If indicators of VMS syntax found, return input string. */
2088 __gnat_to_host_dir_spec (dirspec
, prefixflag
)
2092 int len
= strlen (dirspec
);
2094 strcpy (new_host_dirspec
, dirspec
);
2096 if (strchr (new_host_dirspec
, ']') || strchr (new_host_dirspec
, ':'))
2097 return new_host_dirspec
;
2099 while (len
> 1 && new_host_dirspec
[len
-1] == '/')
2101 new_host_dirspec
[len
-1] = 0;
2105 decc$
to_vms (new_host_dirspec
, translate_unix
, 1, 2);
2106 strcpy (new_host_dirspec
, filename_buff
);
2108 return new_host_dirspec
;
2112 /* Translate a Unix syntax file specification into VMS syntax.
2113 If indicators of VMS syntax found, return input string. */
2116 __gnat_to_host_file_spec (filespec
)
2119 strcpy (new_host_filespec
, "");
2120 if (strchr (filespec
, ']') || strchr (filespec
, ':'))
2121 strcpy (new_host_filespec
, filespec
);
2124 decc$
to_vms (filespec
, translate_unix
, 1, 1);
2125 strcpy (new_host_filespec
, filename_buff
);
2128 return new_host_filespec
;
2132 __gnat_adjust_os_resource_limits ()
2134 SYS$
ADJWSL (131072, 0);
2139 /* Dummy functions for Osint import for non-VMS systems */
2142 __gnat_to_canonical_file_list_init (dirspec
, onlydirs
)
2143 char *dirspec ATTRIBUTE_UNUSED
;
2144 int onlydirs ATTRIBUTE_UNUSED
;
2150 __gnat_to_canonical_file_list_next ()
2156 __gnat_to_canonical_file_list_free ()
2161 __gnat_to_canonical_dir_spec (dirspec
, prefixflag
)
2163 int prefixflag ATTRIBUTE_UNUSED
;
2169 __gnat_to_canonical_file_spec (filespec
)
2176 __gnat_to_canonical_path_spec (pathspec
)
2183 __gnat_to_host_dir_spec (dirspec
, prefixflag
)
2185 int prefixflag ATTRIBUTE_UNUSED
;
2191 __gnat_to_host_file_spec (filespec
)
2198 __gnat_adjust_os_resource_limits ()
2204 /* for EMX, we cannot include dummy in libgcc, since it is too difficult
2205 to coordinate this with the EMX distribution. Consequently, we put the
2206 definition of dummy() which is used for exception handling, here */
2208 #if defined (__EMX__)
2212 #if defined (__mips_vxworks)
2215 CACHE_USER_FLUSH (0, ENTIRE_CACHE
);
2219 #if defined (CROSS_COMPILE) \
2220 || (! (defined (sparc) && defined (sun) && defined (__SVR4)) \
2221 && ! defined (linux) \
2222 && ! defined (sgi) \
2223 && ! defined (hpux) \
2224 && ! (defined (__alpha__) && defined (__osf__)) \
2225 && ! defined (__MINGW32__))
2226 /* Dummy function to satisfy g-trasym.o.
2227 Currently Solaris sparc, HP/UX, IRIX, GNU/Linux, Tru64 & Windows provide a
2228 non-dummy version of this procedure in libaddr2line.a */
2231 convert_addresses (addrs
, n_addr
, buf
, len
)
2232 void *addrs ATTRIBUTE_UNUSED
;
2233 int n_addr ATTRIBUTE_UNUSED
;
2234 void *buf ATTRIBUTE_UNUSED
;