1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
9 * Copyright (C) 1992-2008, Free Software Foundation, Inc. *
11 * GNAT is free software; you can redistribute it and/or modify it under *
12 * terms of the GNU General Public License as published by the Free Soft- *
13 * ware Foundation; either version 2, or (at your option) any later ver- *
14 * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
15 * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
16 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
17 * for more details. You should have received a copy of the GNU General *
18 * Public License distributed with GNAT; see file COPYING. If not, write *
19 * to the Free Software Foundation, 51 Franklin Street, Fifth Floor, *
20 * Boston, MA 02110-1301, USA. *
22 * As a special exception, if you link this file with other files to *
23 * produce an executable, this file does not by itself cause the resulting *
24 * executable to be covered by the GNU General Public License. This except- *
25 * ion does not however invalidate any other reasons why the executable *
26 * file might be covered by the GNU Public License. *
28 * GNAT was originally developed by the GNAT team at New York University. *
29 * Extensive contributions were provided by Ada Core Technologies Inc. *
31 ****************************************************************************/
33 /* This file contains those routines named by Import pragmas in
34 packages in the GNAT hierarchy (especially GNAT.OS_Lib) and in
35 package Osint. Many of the subprograms in OS_Lib import standard
36 library calls directly. This file contains all other routines. */
40 /* No need to redefine exit here. */
43 /* We want to use the POSIX variants of include files. */
47 #if defined (__mips_vxworks)
49 #endif /* __mips_vxworks */
55 #define HOST_EXECUTABLE_SUFFIX ".exe"
56 #define HOST_OBJECT_SUFFIX ".obj"
70 /* We don't have libiberty, so use malloc. */
71 #define xmalloc(S) malloc (S)
72 #define xrealloc(V,S) realloc (V,S)
82 #include <sys/utime.h>
84 #elif defined (__MINGW32__)
87 #include <sys/utime.h>
90 #elif defined (__Lynx__)
92 /* Lynx utime.h only defines the entities of interest to us if
93 defined (VMOS_DEV), so ... */
102 /* wait.h processing */
105 #include <sys/wait.h>
107 #elif defined (__vxworks) && defined (__RTP__)
109 #elif defined (__Lynx__)
110 /* ??? We really need wait.h and it includes resource.h on Lynx. GCC
111 has a resource.h header as well, included instead of the lynx
112 version in our setup, causing lots of errors. We don't really need
113 the lynx contents of this file, so just workaround the issue by
114 preventing the inclusion of the GCC header from doing anything. */
115 #define GCC_RESOURCE_H
116 #include <sys/wait.h>
117 #elif defined (__nucleus__)
118 /* No wait() or waitpid() calls available */
121 #include <sys/wait.h>
124 #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
127 /* Header files and definitions for __gnat_set_file_time_name. */
129 #define __NEW_STARLET 1
131 #include <vms/atrdef.h>
132 #include <vms/fibdef.h>
133 #include <vms/stsdef.h>
134 #include <vms/iodef.h>
136 #include <vms/descrip.h>
140 /* Use native 64-bit arithmetic. */
141 #define unix_time_to_vms(X,Y) \
142 { unsigned long long reftime, tmptime = (X); \
143 $DESCRIPTOR (unixtime,"1-JAN-1970 0:00:00.00"); \
144 SYS$BINTIM (&unixtime, &reftime); \
145 Y = tmptime * 10000000 + reftime; }
147 /* descrip.h doesn't have everything ... */
148 typedef struct fibdef
* __fibdef_ptr32
__attribute__ (( mode (SI
) ));
149 struct dsc$descriptor_fib
151 unsigned int fib$l_len
;
152 __fibdef_ptr32 fib$l_addr
;
155 /* I/O Status Block. */
158 unsigned short status
, count
;
162 static char *tryfile
;
164 /* Variable length string. */
168 char string
[NAM$C_MAXRSS
+1];
175 #if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
183 #define DIR_SEPARATOR '\\'
188 /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
189 defined in the current system. On DOS-like systems these flags control
190 whether the file is opened/created in text-translation mode (CR/LF in
191 external file mapped to LF in internal file), but in Unix-like systems,
192 no text translation is required, so these flags have no effect. */
194 #if defined (__EMX__)
210 #ifndef HOST_EXECUTABLE_SUFFIX
211 #define HOST_EXECUTABLE_SUFFIX ""
214 #ifndef HOST_OBJECT_SUFFIX
215 #define HOST_OBJECT_SUFFIX ".o"
218 #ifndef PATH_SEPARATOR
219 #define PATH_SEPARATOR ':'
222 #ifndef DIR_SEPARATOR
223 #define DIR_SEPARATOR '/'
226 /* Check for cross-compilation */
227 #ifdef CROSS_DIRECTORY_STRUCTURE
228 int __gnat_is_cross_compiler
= 1;
230 int __gnat_is_cross_compiler
= 0;
233 char __gnat_dir_separator
= DIR_SEPARATOR
;
235 char __gnat_path_separator
= PATH_SEPARATOR
;
237 /* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
238 the base filenames that libraries specified with -lsomelib options
239 may have. This is used by GNATMAKE to check whether an executable
240 is up-to-date or not. The syntax is
242 library_template ::= { pattern ; } pattern NUL
243 pattern ::= [ prefix ] * [ postfix ]
245 These should only specify names of static libraries as it makes
246 no sense to determine at link time if dynamic-link libraries are
247 up to date or not. Any libraries that are not found are supposed
250 * if they are needed but not present, the link
253 * otherwise they are libraries in the system paths and so
254 they are considered part of the system and not checked
257 ??? This should be part of a GNAT host-specific compiler
258 file instead of being included in all user applications
259 as well. This is only a temporary work-around for 3.11b. */
261 #ifndef GNAT_LIBRARY_TEMPLATE
262 #if defined (__EMX__)
263 #define GNAT_LIBRARY_TEMPLATE "*.a"
265 #define GNAT_LIBRARY_TEMPLATE "*.olb"
267 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
271 const char *__gnat_library_template
= GNAT_LIBRARY_TEMPLATE
;
273 /* This variable is used in hostparm.ads to say whether the host is a VMS
276 const int __gnat_vmsp
= 1;
278 const int __gnat_vmsp
= 0;
282 #define GNAT_MAX_PATH_LEN MAX_PATH
285 #define GNAT_MAX_PATH_LEN 256 /* PATH_MAX */
287 #elif defined (__vxworks) || defined (__OPENNT) || defined(__nucleus__)
288 #define GNAT_MAX_PATH_LEN PATH_MAX
292 #if defined (__MINGW32__)
296 #include <sys/param.h>
300 #include <sys/param.h>
304 #define GNAT_MAX_PATH_LEN MAXPATHLEN
306 #define GNAT_MAX_PATH_LEN 256
311 /* The __gnat_max_path_len variable is used to export the maximum
312 length of a path name to Ada code. max_path_len is also provided
313 for compatibility with older GNAT versions, please do not use
316 int __gnat_max_path_len
= GNAT_MAX_PATH_LEN
;
317 int max_path_len
= GNAT_MAX_PATH_LEN
;
319 /* The following macro HAVE_READDIR_R should be defined if the
320 system provides the routine readdir_r. */
321 #undef HAVE_READDIR_R
323 #if defined(VMS) && defined (__LONG_POINTERS)
325 /* Return a 32 bit pointer to an array of 32 bit pointers
326 given a 64 bit pointer to an array of 64 bit pointers */
328 typedef __char_ptr32
*__char_ptr_char_ptr32
__attribute__ ((mode (SI
)));
330 static __char_ptr_char_ptr32
331 to_ptr32 (char **ptr64
)
334 __char_ptr_char_ptr32 short_argv
;
336 for (argc
=0; ptr64
[argc
]; argc
++);
338 /* Reallocate argv with 32 bit pointers. */
339 short_argv
= (__char_ptr_char_ptr32
) decc$malloc
340 (sizeof (__char_ptr32
) * (argc
+ 1));
342 for (argc
=0; ptr64
[argc
]; argc
++)
343 short_argv
[argc
] = (__char_ptr32
) decc$
strdup (ptr64
[argc
]);
345 short_argv
[argc
] = (__char_ptr32
) 0;
349 #define MAYBE_TO_PTR32(argv) to_ptr32 (argv)
351 #define MAYBE_TO_PTR32(argv) argv
358 time_t res
= time (NULL
);
359 return (OS_Time
) res
;
362 /* Return the current local time as a string in the ISO 8601 format of
363 "YYYY-MM-DD HH:MM:SS.SS". The returned string is 22 + 1 (NULL) characters
367 __gnat_current_time_string
370 const char *format
= "%Y-%m-%d %H:%M:%S";
371 /* Format string necessary to describe the ISO 8601 format */
373 const time_t t_val
= time (NULL
);
375 strftime (result
, 22, format
, localtime (&t_val
));
376 /* Convert the local time into a string following the ISO format, copying
377 at most 22 characters into the result string. */
382 /* The sub-seconds are manually set to zero since type time_t lacks the
383 precision necessary for nanoseconds. */
397 time_t time
= (time_t) *p_time
;
400 /* On Windows systems, the time is sometimes rounded up to the nearest
401 even second, so if the number of seconds is odd, increment it. */
407 res
= localtime (&time
);
409 res
= gmtime (&time
);
414 *p_year
= res
->tm_year
;
415 *p_month
= res
->tm_mon
;
416 *p_day
= res
->tm_mday
;
417 *p_hours
= res
->tm_hour
;
418 *p_mins
= res
->tm_min
;
419 *p_secs
= res
->tm_sec
;
422 *p_year
= *p_month
= *p_day
= *p_hours
= *p_mins
= *p_secs
= 0;
425 /* Place the contents of the symbolic link named PATH in the buffer BUF,
426 which has size BUFSIZ. If PATH is a symbolic link, then return the number
427 of characters of its content in BUF. Otherwise, return -1.
428 For systems not supporting symbolic links, always return -1. */
431 __gnat_readlink (char *path ATTRIBUTE_UNUSED
,
432 char *buf ATTRIBUTE_UNUSED
,
433 size_t bufsiz ATTRIBUTE_UNUSED
)
435 #if defined (MSDOS) || defined (_WIN32) || defined (__EMX__) \
436 || defined (VMS) || defined(__vxworks) || defined (__nucleus__)
439 return readlink (path
, buf
, bufsiz
);
443 /* Creates a symbolic link named NEWPATH which contains the string OLDPATH.
444 If NEWPATH exists it will NOT be overwritten.
445 For systems not supporting symbolic links, always return -1. */
448 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED
,
449 char *newpath ATTRIBUTE_UNUSED
)
451 #if defined (MSDOS) || defined (_WIN32) || defined (__EMX__) \
452 || defined (VMS) || defined(__vxworks) || defined (__nucleus__)
455 return symlink (oldpath
, newpath
);
459 /* Try to lock a file, return 1 if success. */
461 #if defined (__vxworks) || defined (__nucleus__) || defined (MSDOS) \
464 /* Version that does not use link. */
467 __gnat_try_lock (char *dir
, char *file
)
471 TCHAR wfull_path
[GNAT_MAX_PATH_LEN
];
472 TCHAR wfile
[GNAT_MAX_PATH_LEN
];
473 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
475 S2WSU (wdir
, dir
, GNAT_MAX_PATH_LEN
);
476 S2WSU (wfile
, file
, GNAT_MAX_PATH_LEN
);
478 _stprintf (wfull_path
, _T("%s%c%s"), wdir
, _T(DIR_SEPARATOR
), wfile
);
479 fd
= _topen (wfull_path
, O_CREAT
| O_EXCL
, 0600);
483 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
484 fd
= open (full_path
, O_CREAT
| O_EXCL
, 0600);
494 #elif defined (__EMX__) || defined (VMS)
496 /* More cases that do not use link; identical code, to solve too long
500 __gnat_try_lock (char *dir
, char *file
)
505 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
506 fd
= open (full_path
, O_CREAT
| O_EXCL
, 0600);
517 /* Version using link(), more secure over NFS. */
518 /* See TN 6913-016 for discussion ??? */
521 __gnat_try_lock (char *dir
, char *file
)
525 struct stat stat_result
;
528 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
529 sprintf (temp_file
, "%s%cTMP-%ld-%ld",
530 dir
, DIR_SEPARATOR
, (long)getpid(), (long)getppid ());
532 /* Create the temporary file and write the process number. */
533 fd
= open (temp_file
, O_CREAT
| O_WRONLY
, 0600);
539 /* Link it with the new file. */
540 link (temp_file
, full_path
);
542 /* Count the references on the old one. If we have a count of two, then
543 the link did succeed. Remove the temporary file before returning. */
544 __gnat_stat (temp_file
, &stat_result
);
546 return stat_result
.st_nlink
== 2;
550 /* Return the maximum file name length. */
553 __gnat_get_maximum_file_name_length (void)
558 if (getenv ("GNAT$EXTENDED_FILE_SPECIFICATIONS"))
567 /* Return nonzero if file names are case sensitive. */
570 __gnat_get_file_names_case_sensitive (void)
572 #if defined (__EMX__) || defined (MSDOS) || defined (VMS) || defined (WINNT)
580 __gnat_get_default_identifier_character_set (void)
582 #if defined (__EMX__) || defined (MSDOS)
589 /* Return the current working directory. */
592 __gnat_get_current_dir (char *dir
, int *length
)
594 #if defined (__MINGW32__)
595 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
597 _tgetcwd (wdir
, *length
);
599 WS2SU (dir
, wdir
, GNAT_MAX_PATH_LEN
);
602 /* Force Unix style, which is what GNAT uses internally. */
603 getcwd (dir
, *length
, 0);
605 getcwd (dir
, *length
);
608 *length
= strlen (dir
);
610 if (dir
[*length
- 1] != DIR_SEPARATOR
)
612 dir
[*length
] = DIR_SEPARATOR
;
618 /* Return the suffix for object files. */
621 __gnat_get_object_suffix_ptr (int *len
, const char **value
)
623 *value
= HOST_OBJECT_SUFFIX
;
628 *len
= strlen (*value
);
633 /* Return the suffix for executable files. */
636 __gnat_get_executable_suffix_ptr (int *len
, const char **value
)
638 *value
= HOST_EXECUTABLE_SUFFIX
;
642 *len
= strlen (*value
);
647 /* Return the suffix for debuggable files. Usually this is the same as the
648 executable extension. */
651 __gnat_get_debuggable_suffix_ptr (int *len
, const char **value
)
654 *value
= HOST_EXECUTABLE_SUFFIX
;
656 /* On DOS, the extensionless COFF file is what gdb likes. */
663 *len
= strlen (*value
);
668 /* Returns the OS filename and corresponding encoding. */
671 __gnat_os_filename (char *filename
, char *w_filename ATTRIBUTE_UNUSED
,
672 char *os_name
, int *o_length
,
673 char *encoding ATTRIBUTE_UNUSED
, int *e_length
)
675 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE)
676 WS2SU (os_name
, (TCHAR
*)w_filename
, o_length
);
677 *o_length
= strlen (os_name
);
678 strcpy (encoding
, "encoding=utf8");
679 *e_length
= strlen (encoding
);
681 strcpy (os_name
, filename
);
682 *o_length
= strlen (filename
);
688 __gnat_fopen (char *path
, char *mode
, int encoding ATTRIBUTE_UNUSED
)
690 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE)
691 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
694 S2WS (wmode
, mode
, 10);
696 if (encoding
== Encoding_UTF8
)
697 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
699 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
701 return _tfopen (wpath
, wmode
);
703 return decc$
fopen (path
, mode
);
705 return fopen (path
, mode
);
710 __gnat_freopen (char *path
, char *mode
, FILE *stream
, int encoding ATTRIBUTE_UNUSED
)
712 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE)
713 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
716 S2WS (wmode
, mode
, 10);
718 if (encoding
== Encoding_UTF8
)
719 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
721 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
723 return _tfreopen (wpath
, wmode
, stream
);
725 return decc$
freopen (path
, mode
, stream
);
727 return freopen (path
, mode
, stream
);
732 __gnat_open_read (char *path
, int fmode
)
735 int o_fmode
= O_BINARY
;
741 /* Optional arguments mbc,deq,fop increase read performance. */
742 fd
= open (path
, O_RDONLY
| o_fmode
, 0444,
743 "mbc=16", "deq=64", "fop=tef");
744 #elif defined (__vxworks)
745 fd
= open (path
, O_RDONLY
| o_fmode
, 0444);
746 #elif defined (__MINGW32__)
748 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
750 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
751 fd
= _topen (wpath
, O_RDONLY
| o_fmode
, 0444);
754 fd
= open (path
, O_RDONLY
| o_fmode
);
757 return fd
< 0 ? -1 : fd
;
760 #if defined (__EMX__) || defined (__MINGW32__)
761 #define PERM (S_IREAD | S_IWRITE)
763 /* Excerpt from DECC C RTL Reference Manual:
764 To create files with OpenVMS RMS default protections using the UNIX
765 system-call functions umask, mkdir, creat, and open, call mkdir, creat,
766 and open with a file-protection mode argument of 0777 in a program
767 that never specifically calls umask. These default protections include
768 correctly establishing protections based on ACLs, previous versions of
772 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
776 __gnat_open_rw (char *path
, int fmode
)
779 int o_fmode
= O_BINARY
;
785 fd
= open (path
, O_RDWR
| o_fmode
, PERM
,
786 "mbc=16", "deq=64", "fop=tef");
787 #elif defined (__MINGW32__)
789 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
791 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
792 fd
= _topen (wpath
, O_RDWR
| o_fmode
, PERM
);
795 fd
= open (path
, O_RDWR
| o_fmode
, PERM
);
798 return fd
< 0 ? -1 : fd
;
802 __gnat_open_create (char *path
, int fmode
)
805 int o_fmode
= O_BINARY
;
811 fd
= open (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
,
812 "mbc=16", "deq=64", "fop=tef");
813 #elif defined (__MINGW32__)
815 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
817 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
818 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
821 fd
= open (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
824 return fd
< 0 ? -1 : fd
;
828 __gnat_create_output_file (char *path
)
832 fd
= open (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
,
833 "rfm=stmlf", "ctx=rec", "rat=none", "rop=nlk",
834 "shr=del,get,put,upd");
835 #elif defined (__MINGW32__)
837 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
839 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
840 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
843 fd
= open (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
846 return fd
< 0 ? -1 : fd
;
850 __gnat_open_append (char *path
, int fmode
)
853 int o_fmode
= O_BINARY
;
859 fd
= open (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
,
860 "mbc=16", "deq=64", "fop=tef");
861 #elif defined (__MINGW32__)
863 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
865 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
866 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
869 fd
= open (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
872 return fd
< 0 ? -1 : fd
;
875 /* Open a new file. Return error (-1) if the file already exists. */
878 __gnat_open_new (char *path
, int fmode
)
881 int o_fmode
= O_BINARY
;
887 fd
= open (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
,
888 "mbc=16", "deq=64", "fop=tef");
889 #elif defined (__MINGW32__)
891 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
893 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
894 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
897 fd
= open (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
900 return fd
< 0 ? -1 : fd
;
903 /* Open a new temp file. Return error (-1) if the file already exists.
904 Special options for VMS allow the file to be shared between parent and child
905 processes, however they really slow down output. Used in gnatchop. */
908 __gnat_open_new_temp (char *path
, int fmode
)
911 int o_fmode
= O_BINARY
;
913 strcpy (path
, "GNAT-XXXXXX");
915 #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
916 || defined (linux) || defined(__GLIBC__)) && !defined (__vxworks)
917 return mkstemp (path
);
918 #elif defined (__Lynx__)
920 #elif defined (__nucleus__)
923 if (mktemp (path
) == NULL
)
931 fd
= open (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
,
932 "rfm=stmlf", "ctx=rec", "rat=none", "shr=del,get,put,upd",
933 "mbc=16", "deq=64", "fop=tef");
935 fd
= open (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
938 return fd
< 0 ? -1 : fd
;
941 /* Return the number of bytes in the specified file. */
944 __gnat_file_length (int fd
)
949 ret
= fstat (fd
, &statbuf
);
950 if (ret
|| !S_ISREG (statbuf
.st_mode
))
953 return (statbuf
.st_size
);
956 /* Return the number of bytes in the specified named file. */
959 __gnat_named_file_length (char *name
)
964 ret
= __gnat_stat (name
, &statbuf
);
965 if (ret
|| !S_ISREG (statbuf
.st_mode
))
968 return (statbuf
.st_size
);
971 /* Create a temporary filename and put it in string pointed to by
975 __gnat_tmp_name (char *tmp_filename
)
981 /* tempnam tries to create a temporary file in directory pointed to by
982 TMP environment variable, in c:\temp if TMP is not set, and in
983 directory specified by P_tmpdir in stdio.h if c:\temp does not
984 exist. The filename will be created with the prefix "gnat-". */
986 pname
= (char *) tempnam ("c:\\temp", "gnat-");
988 /* if pname is NULL, the file was not created properly, the disk is full
989 or there is no more free temporary files */
992 *tmp_filename
= '\0';
994 /* If pname start with a back slash and not path information it means that
995 the filename is valid for the current working directory. */
997 else if (pname
[0] == '\\')
999 strcpy (tmp_filename
, ".\\");
1000 strcat (tmp_filename
, pname
+1);
1003 strcpy (tmp_filename
, pname
);
1008 #elif defined (linux) || defined (__FreeBSD__) || defined (__NetBSD__) \
1009 || defined (__OpenBSD__) || defined(__GLIBC__)
1010 #define MAX_SAFE_PATH 1000
1011 char *tmpdir
= getenv ("TMPDIR");
1013 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1014 a buffer overflow. */
1015 if (tmpdir
== NULL
|| strlen (tmpdir
) > MAX_SAFE_PATH
)
1016 strcpy (tmp_filename
, "/tmp/gnat-XXXXXX");
1018 sprintf (tmp_filename
, "%s/gnat-XXXXXX", tmpdir
);
1020 close (mkstemp(tmp_filename
));
1022 tmpnam (tmp_filename
);
1026 /* Open directory and returns a DIR pointer. */
1028 DIR* __gnat_opendir (char *name
)
1031 /* Not supported in RTX */
1035 #elif defined (__MINGW32__)
1036 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1038 S2WSU (wname
, name
, GNAT_MAX_PATH_LEN
);
1039 return (DIR*)_topendir (wname
);
1042 return opendir (name
);
1046 /* Read the next entry in a directory. The returned string points somewhere
1050 __gnat_readdir (DIR *dirp
, char *buffer
, int *len
)
1053 /* Not supported in RTX */
1056 #elif defined (__MINGW32__)
1057 struct _tdirent
*dirent
= _treaddir ((_TDIR
*)dirp
);
1061 WS2SU (buffer
, dirent
->d_name
, GNAT_MAX_PATH_LEN
);
1062 *len
= strlen (buffer
);
1069 #elif defined (HAVE_READDIR_R)
1070 /* If possible, try to use the thread-safe version. */
1071 if (readdir_r (dirp
, buffer
) != NULL
)
1073 *len
= strlen (((struct dirent
*) buffer
)->d_name
);
1074 return ((struct dirent
*) buffer
)->d_name
;
1080 struct dirent
*dirent
= (struct dirent
*) readdir (dirp
);
1084 strcpy (buffer
, dirent
->d_name
);
1085 *len
= strlen (buffer
);
1094 /* Close a directory entry. */
1096 int __gnat_closedir (DIR *dirp
)
1099 /* Not supported in RTX */
1103 #elif defined (__MINGW32__)
1104 return _tclosedir ((_TDIR
*)dirp
);
1107 return closedir (dirp
);
1111 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1114 __gnat_readdir_is_thread_safe (void)
1116 #ifdef HAVE_READDIR_R
1123 #if defined (_WIN32) && !defined (RTX)
1124 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1125 static const unsigned long long w32_epoch_offset
= 11644473600ULL;
1127 /* Returns the file modification timestamp using Win32 routines which are
1128 immune against daylight saving time change. It is in fact not possible to
1129 use fstat for this purpose as the DST modify the st_mtime field of the
1133 win32_filetime (HANDLE h
)
1138 unsigned long long ull_time
;
1141 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1142 since <Jan 1st 1601>. This function must return the number of seconds
1143 since <Jan 1st 1970>. */
1145 if (GetFileTime (h
, NULL
, NULL
, &t_write
.ft_time
))
1146 return (time_t) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1151 /* Return a GNAT time stamp given a file name. */
1154 __gnat_file_time_name (char *name
)
1157 #if defined (__EMX__) || defined (MSDOS)
1158 int fd
= open (name
, O_RDONLY
| O_BINARY
);
1159 time_t ret
= __gnat_file_time_fd (fd
);
1161 return (OS_Time
)ret
;
1163 #elif defined (_WIN32) && !defined (RTX)
1165 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1167 S2WSU (wname
, name
, GNAT_MAX_PATH_LEN
);
1169 HANDLE h
= CreateFile
1170 (wname
, GENERIC_READ
, FILE_SHARE_READ
, 0,
1171 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
, 0);
1173 if (h
!= INVALID_HANDLE_VALUE
)
1175 ret
= win32_filetime (h
);
1178 return (OS_Time
) ret
;
1180 struct stat statbuf
;
1181 if (__gnat_stat (name
, &statbuf
) != 0) {
1185 /* VMS has file versioning. */
1186 return (OS_Time
)statbuf
.st_ctime
;
1188 return (OS_Time
)statbuf
.st_mtime
;
1194 /* Return a GNAT time stamp given a file descriptor. */
1197 __gnat_file_time_fd (int fd
)
1199 /* The following workaround code is due to the fact that under EMX and
1200 DJGPP fstat attempts to convert time values to GMT rather than keep the
1201 actual OS timestamp of the file. By using the OS2/DOS functions directly
1202 the GNAT timestamp are independent of this behavior, which is desired to
1203 facilitate the distribution of GNAT compiled libraries. */
1205 #if defined (__EMX__) || defined (MSDOS)
1209 int ret
= DosQueryFileInfo (fd
, 1, (unsigned char *) &fs
,
1210 sizeof (FILESTATUS
));
1212 unsigned file_year
= fs
.fdateLastWrite
.year
;
1213 unsigned file_month
= fs
.fdateLastWrite
.month
;
1214 unsigned file_day
= fs
.fdateLastWrite
.day
;
1215 unsigned file_hour
= fs
.ftimeLastWrite
.hours
;
1216 unsigned file_min
= fs
.ftimeLastWrite
.minutes
;
1217 unsigned file_tsec
= fs
.ftimeLastWrite
.twosecs
;
1221 int ret
= getftime (fd
, &fs
);
1223 unsigned file_year
= fs
.ft_year
;
1224 unsigned file_month
= fs
.ft_month
;
1225 unsigned file_day
= fs
.ft_day
;
1226 unsigned file_hour
= fs
.ft_hour
;
1227 unsigned file_min
= fs
.ft_min
;
1228 unsigned file_tsec
= fs
.ft_tsec
;
1231 /* Calculate the seconds since epoch from the time components. First count
1232 the whole days passed. The value for years returned by the DOS and OS2
1233 functions count years from 1980, so to compensate for the UNIX epoch which
1234 begins in 1970 start with 10 years worth of days and add days for each
1235 four year period since then. */
1238 int cum_days
[12] = {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
1239 int days_passed
= 3652 + (file_year
/ 4) * 1461;
1240 int years_since_leap
= file_year
% 4;
1242 if (years_since_leap
== 1)
1244 else if (years_since_leap
== 2)
1246 else if (years_since_leap
== 3)
1247 days_passed
+= 1096;
1252 days_passed
+= cum_days
[file_month
- 1];
1253 if (years_since_leap
== 0 && file_year
!= 20 && file_month
> 2)
1256 days_passed
+= file_day
- 1;
1258 /* OK - have whole days. Multiply -- then add in other parts. */
1260 tot_secs
= days_passed
* 86400;
1261 tot_secs
+= file_hour
* 3600;
1262 tot_secs
+= file_min
* 60;
1263 tot_secs
+= file_tsec
* 2;
1264 return (OS_Time
) tot_secs
;
1266 #elif defined (_WIN32) && !defined (RTX)
1267 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
1268 time_t ret
= win32_filetime (h
);
1269 return (OS_Time
) ret
;
1272 struct stat statbuf
;
1274 if (fstat (fd
, &statbuf
) != 0) {
1275 return (OS_Time
) -1;
1278 /* VMS has file versioning. */
1279 return (OS_Time
) statbuf
.st_ctime
;
1281 return (OS_Time
) statbuf
.st_mtime
;
1287 /* Set the file time stamp. */
1290 __gnat_set_file_time_name (char *name
, time_t time_stamp
)
1292 #if defined (__EMX__) || defined (MSDOS) || defined (__vxworks)
1294 /* Code to implement __gnat_set_file_time_name for these systems. */
1296 #elif defined (_WIN32) && !defined (RTX)
1300 unsigned long long ull_time
;
1302 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1304 S2WSU (wname
, name
, GNAT_MAX_PATH_LEN
);
1306 HANDLE h
= CreateFile
1307 (wname
, GENERIC_WRITE
, FILE_SHARE_WRITE
, NULL
,
1308 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
,
1310 if (h
== INVALID_HANDLE_VALUE
)
1312 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1313 t_write
.ull_time
= ((unsigned long long)time_stamp
+ w32_epoch_offset
);
1314 /* Convert to 100 nanosecond units */
1315 t_write
.ull_time
*= 10000000ULL;
1317 SetFileTime(h
, NULL
, NULL
, &t_write
.ft_time
);
1327 unsigned long long backup
, create
, expire
, revise
;
1331 unsigned short value
;
1334 unsigned system
: 4;
1340 } Fat
= { 0, 0, 0, 0, 0, { 0 }};
1344 { ATR$S_CREDATE
, ATR$C_CREDATE
, &Fat
.create
},
1345 { ATR$S_REVDATE
, ATR$C_REVDATE
, &Fat
.revise
},
1346 { ATR$S_EXPDATE
, ATR$C_EXPDATE
, &Fat
.expire
},
1347 { ATR$S_BAKDATE
, ATR$C_BAKDATE
, &Fat
.backup
},
1348 { ATR$S_FPRO
, ATR$C_FPRO
, &Fat
.prot
},
1349 { ATR$S_UIC
, ATR$C_UIC
, &Fat
.uic
},
1354 struct dsc$descriptor_fib fibdsc
= {sizeof (fib
), (void *) &fib
};
1358 unsigned long long newtime
;
1359 unsigned long long revtime
;
1363 struct vstring file
;
1364 struct dsc$descriptor_s filedsc
1365 = {NAM$C_MAXRSS
, DSC$K_DTYPE_T
, DSC$K_CLASS_S
, (void *) file
.string
};
1366 struct vstring device
;
1367 struct dsc$descriptor_s devicedsc
1368 = {NAM$C_MAXRSS
, DSC$K_DTYPE_T
, DSC$K_CLASS_S
, (void *) device
.string
};
1369 struct vstring timev
;
1370 struct dsc$descriptor_s timedsc
1371 = {NAM$C_MAXRSS
, DSC$K_DTYPE_T
, DSC$K_CLASS_S
, (void *) timev
.string
};
1372 struct vstring result
;
1373 struct dsc$descriptor_s resultdsc
1374 = {NAM$C_MAXRSS
, DSC$K_DTYPE_VT
, DSC$K_CLASS_VS
, (void *) result
.string
};
1376 /* Convert parameter name (a file spec) to host file form. Note that this
1377 is needed on VMS to prepare for subsequent calls to VMS RMS library
1378 routines. Note that it would not work to call __gnat_to_host_dir_spec
1379 as was done in a previous version, since this fails silently unless
1380 the feature logical DECC$EFS_CHARSET is enabled, in which case a DNF
1381 (directory not found) condition is signalled. */
1382 tryfile
= (char *) __gnat_to_host_file_spec (name
);
1384 /* Allocate and initialize a FAB and NAM structures. */
1388 nam
.nam$l_esa
= file
.string
;
1389 nam
.nam$b_ess
= NAM$C_MAXRSS
;
1390 nam
.nam$l_rsa
= result
.string
;
1391 nam
.nam$b_rss
= NAM$C_MAXRSS
;
1392 fab
.fab$l_fna
= tryfile
;
1393 fab
.fab$b_fns
= strlen (tryfile
);
1394 fab
.fab$l_nam
= &nam
;
1396 /* Validate filespec syntax and device existence. */
1397 status
= SYS$
PARSE (&fab
, 0, 0);
1398 if ((status
& 1) != 1)
1399 LIB$
SIGNAL (status
);
1401 file
.string
[nam
.nam$b_esl
] = 0;
1403 /* Find matching filespec. */
1404 status
= SYS$
SEARCH (&fab
, 0, 0);
1405 if ((status
& 1) != 1)
1406 LIB$
SIGNAL (status
);
1408 file
.string
[nam
.nam$b_esl
] = 0;
1409 result
.string
[result
.length
=nam
.nam$b_rsl
] = 0;
1411 /* Get the device name and assign an IO channel. */
1412 strncpy (device
.string
, nam
.nam$l_dev
, nam
.nam$b_dev
);
1413 devicedsc
.dsc$w_length
= nam
.nam$b_dev
;
1415 status
= SYS$
ASSIGN (&devicedsc
, &chan
, 0, 0, 0);
1416 if ((status
& 1) != 1)
1417 LIB$
SIGNAL (status
);
1419 /* Initialize the FIB and fill in the directory id field. */
1420 memset (&fib
, 0, sizeof (fib
));
1421 fib
.fib$w_did
[0] = nam
.nam$w_did
[0];
1422 fib
.fib$w_did
[1] = nam
.nam$w_did
[1];
1423 fib
.fib$w_did
[2] = nam
.nam$w_did
[2];
1424 fib
.fib$l_acctl
= 0;
1426 strcpy (file
.string
, (strrchr (result
.string
, ']') + 1));
1427 filedsc
.dsc$w_length
= strlen (file
.string
);
1428 result
.string
[result
.length
= 0] = 0;
1430 /* Open and close the file to fill in the attributes. */
1432 = SYS$
QIOW (0, chan
, IO$_ACCESS
|IO$M_ACCESS
, &iosb
, 0, 0,
1433 &fibdsc
, &filedsc
, &result
.length
, &resultdsc
, &atrlst
, 0);
1434 if ((status
& 1) != 1)
1435 LIB$
SIGNAL (status
);
1436 if ((iosb
.status
& 1) != 1)
1437 LIB$
SIGNAL (iosb
.status
);
1439 result
.string
[result
.length
] = 0;
1440 status
= SYS$
QIOW (0, chan
, IO$_DEACCESS
, &iosb
, 0, 0, &fibdsc
, 0, 0, 0,
1442 if ((status
& 1) != 1)
1443 LIB$
SIGNAL (status
);
1444 if ((iosb
.status
& 1) != 1)
1445 LIB$
SIGNAL (iosb
.status
);
1450 /* Set creation time to requested time. */
1451 unix_time_to_vms (time_stamp
, newtime
);
1453 t
= time ((time_t) 0);
1455 /* Set revision time to now in local time. */
1456 unix_time_to_vms (t
, revtime
);
1459 /* Reopen the file, modify the times and then close. */
1460 fib
.fib$l_acctl
= FIB$M_WRITE
;
1462 = SYS$
QIOW (0, chan
, IO$_ACCESS
|IO$M_ACCESS
, &iosb
, 0, 0,
1463 &fibdsc
, &filedsc
, &result
.length
, &resultdsc
, &atrlst
, 0);
1464 if ((status
& 1) != 1)
1465 LIB$
SIGNAL (status
);
1466 if ((iosb
.status
& 1) != 1)
1467 LIB$
SIGNAL (iosb
.status
);
1469 Fat
.create
= newtime
;
1470 Fat
.revise
= revtime
;
1472 status
= SYS$
QIOW (0, chan
, IO$_DEACCESS
, &iosb
, 0, 0,
1473 &fibdsc
, 0, 0, 0, &atrlst
, 0);
1474 if ((status
& 1) != 1)
1475 LIB$
SIGNAL (status
);
1476 if ((iosb
.status
& 1) != 1)
1477 LIB$
SIGNAL (iosb
.status
);
1479 /* Deassign the channel and exit. */
1480 status
= SYS$
DASSGN (chan
);
1481 if ((status
& 1) != 1)
1482 LIB$
SIGNAL (status
);
1484 struct utimbuf utimbuf
;
1487 /* Set modification time to requested time. */
1488 utimbuf
.modtime
= time_stamp
;
1490 /* Set access time to now in local time. */
1491 t
= time ((time_t) 0);
1492 utimbuf
.actime
= mktime (localtime (&t
));
1494 utime (name
, &utimbuf
);
1499 #include <windows.h>
1502 /* Get the list of installed standard libraries from the
1503 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1507 __gnat_get_libraries_from_registry (void)
1509 char *result
= (char *) "";
1511 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_DIRECTORY_STRUCTURE) && ! defined (RTX)
1514 DWORD name_size
, value_size
;
1521 /* First open the key. */
1522 res
= RegOpenKeyExA (HKEY_LOCAL_MACHINE
, "SOFTWARE", 0, KEY_READ
, ®_key
);
1524 if (res
== ERROR_SUCCESS
)
1525 res
= RegOpenKeyExA (reg_key
, "Ada Core Technologies", 0,
1526 KEY_READ
, ®_key
);
1528 if (res
== ERROR_SUCCESS
)
1529 res
= RegOpenKeyExA (reg_key
, "GNAT", 0, KEY_READ
, ®_key
);
1531 if (res
== ERROR_SUCCESS
)
1532 res
= RegOpenKeyExA (reg_key
, "Standard Libraries", 0, KEY_READ
, ®_key
);
1534 /* If the key exists, read out all the values in it and concatenate them
1536 for (index
= 0; res
== ERROR_SUCCESS
; index
++)
1538 value_size
= name_size
= 256;
1539 res
= RegEnumValueA (reg_key
, index
, (TCHAR
*)name
, &name_size
, 0,
1540 &type
, (LPBYTE
)value
, &value_size
);
1542 if (res
== ERROR_SUCCESS
&& type
== REG_SZ
)
1544 char *old_result
= result
;
1546 result
= (char *) xmalloc (strlen (old_result
) + value_size
+ 2);
1547 strcpy (result
, old_result
);
1548 strcat (result
, value
);
1549 strcat (result
, ";");
1553 /* Remove the trailing ";". */
1555 result
[strlen (result
) - 1] = 0;
1562 __gnat_stat (char *name
, struct stat
*statbuf
)
1565 /* Under Windows the directory name for the stat function must not be
1566 terminated by a directory separator except if just after a drive name. */
1567 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1571 S2WSU (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1572 name_len
= _tcslen (wname
);
1574 if (name_len
> GNAT_MAX_PATH_LEN
)
1577 last_char
= wname
[name_len
- 1];
1579 while (name_len
> 1 && (last_char
== _T('\\') || last_char
== _T('/')))
1581 wname
[name_len
- 1] = _T('\0');
1583 last_char
= wname
[name_len
- 1];
1586 /* Only a drive letter followed by ':', we must add a directory separator
1587 for the stat routine to work properly. */
1588 if (name_len
== 2 && wname
[1] == _T(':'))
1589 _tcscat (wname
, _T("\\"));
1591 return _tstat (wname
, statbuf
);
1594 return stat (name
, statbuf
);
1599 __gnat_file_exists (char *name
)
1601 #if defined (__MINGW32__) && !defined (RTX)
1602 /* On Windows do not use __gnat_stat() because a bug in Microsoft
1603 _stat() routine. When the system time-zone is set with a negative
1604 offset the _stat() routine fails on specific files like CON: */
1605 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1607 S2WSU (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1608 return GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
;
1610 struct stat statbuf
;
1612 return !__gnat_stat (name
, &statbuf
);
1617 __gnat_is_absolute_path (char *name
, int length
)
1620 /* On VxWorks systems, an absolute path can be represented (depending on
1621 the host platform) as either /dir/file, or device:/dir/file, or
1622 device:drive_letter:/dir/file. */
1629 for (index
= 0; index
< length
; index
++)
1631 if (name
[index
] == ':' &&
1632 ((name
[index
+ 1] == '/') ||
1633 (isalpha (name
[index
+ 1]) && index
+ 2 <= length
&&
1634 name
[index
+ 2] == '/')))
1637 else if (name
[index
] == '/')
1642 return (length
!= 0) &&
1643 (*name
== '/' || *name
== DIR_SEPARATOR
1644 #if defined (__EMX__) || defined (MSDOS) || defined (WINNT)
1645 || (length
> 1 && isalpha (name
[0]) && name
[1] == ':')
1652 __gnat_is_regular_file (char *name
)
1655 struct stat statbuf
;
1657 ret
= __gnat_stat (name
, &statbuf
);
1658 return (!ret
&& S_ISREG (statbuf
.st_mode
));
1662 __gnat_is_directory (char *name
)
1665 struct stat statbuf
;
1667 ret
= __gnat_stat (name
, &statbuf
);
1668 return (!ret
&& S_ISDIR (statbuf
.st_mode
));
1672 __gnat_is_readable_file (char *name
)
1676 struct stat statbuf
;
1678 ret
= __gnat_stat (name
, &statbuf
);
1679 mode
= statbuf
.st_mode
& S_IRUSR
;
1680 return (!ret
&& mode
);
1684 __gnat_is_writable_file (char *name
)
1688 struct stat statbuf
;
1690 ret
= __gnat_stat (name
, &statbuf
);
1691 mode
= statbuf
.st_mode
& S_IWUSR
;
1692 return (!ret
&& mode
);
1696 __gnat_set_writable (char *name
)
1698 #if ! defined (__vxworks) && ! defined(__nucleus__)
1699 struct stat statbuf
;
1701 if (stat (name
, &statbuf
) == 0)
1703 statbuf
.st_mode
= statbuf
.st_mode
| S_IWUSR
;
1704 chmod (name
, statbuf
.st_mode
);
1710 __gnat_set_executable (char *name
)
1712 #if ! defined (__vxworks) && ! defined(__nucleus__)
1713 struct stat statbuf
;
1715 if (stat (name
, &statbuf
) == 0)
1717 statbuf
.st_mode
= statbuf
.st_mode
| S_IXUSR
;
1718 chmod (name
, statbuf
.st_mode
);
1724 __gnat_set_readonly (char *name
)
1726 #if ! defined (__vxworks) && ! defined(__nucleus__)
1727 struct stat statbuf
;
1729 if (stat (name
, &statbuf
) == 0)
1731 statbuf
.st_mode
= statbuf
.st_mode
& 07577;
1732 chmod (name
, statbuf
.st_mode
);
1738 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED
)
1740 #if defined (__vxworks) || defined (__nucleus__)
1743 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
1745 struct stat statbuf
;
1747 ret
= lstat (name
, &statbuf
);
1748 return (!ret
&& S_ISLNK (statbuf
.st_mode
));
1755 #if defined (sun) && defined (__SVR4)
1756 /* Using fork on Solaris will duplicate all the threads. fork1, which
1757 duplicates only the active thread, must be used instead, or spawning
1758 subprocess from a program with tasking will lead into numerous problems. */
1763 __gnat_portable_spawn (char *args
[])
1766 int finished ATTRIBUTE_UNUSED
;
1767 int pid ATTRIBUTE_UNUSED
;
1769 #if defined (__vxworks) || defined(__nucleus__) || defined(RTX)
1772 #elif defined (MSDOS) || defined (_WIN32)
1773 /* args[0] must be quotes as it could contain a full pathname with spaces */
1774 char *args_0
= args
[0];
1775 args
[0] = (char *)xmalloc (strlen (args_0
) + 3);
1776 strcpy (args
[0], "\"");
1777 strcat (args
[0], args_0
);
1778 strcat (args
[0], "\"");
1780 status
= spawnvp (P_WAIT
, args_0
, (const char* const*)args
);
1782 /* restore previous value */
1784 args
[0] = (char *)args_0
;
1794 pid
= spawnvp (P_NOWAIT
, args
[0], args
);
1806 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
1808 return -1; /* execv is in parent context on VMS. */
1816 finished
= waitpid (pid
, &status
, 0);
1818 if (finished
!= pid
|| WIFEXITED (status
) == 0)
1821 return WEXITSTATUS (status
);
1827 /* Create a copy of the given file descriptor.
1828 Return -1 if an error occurred. */
1831 __gnat_dup (int oldfd
)
1833 #if defined (__vxworks) && !defined (__RTP__)
1834 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
1842 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
1843 Return -1 if an error occurred. */
1846 __gnat_dup2 (int oldfd
, int newfd
)
1848 #if defined (__vxworks) && !defined (__RTP__)
1849 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
1853 return dup2 (oldfd
, newfd
);
1857 /* WIN32 code to implement a wait call that wait for any child process. */
1859 #if defined (_WIN32) && !defined (RTX)
1861 /* Synchronization code, to be thread safe. */
1863 static CRITICAL_SECTION plist_cs
;
1866 __gnat_plist_init (void)
1868 InitializeCriticalSection (&plist_cs
);
1874 EnterCriticalSection (&plist_cs
);
1880 LeaveCriticalSection (&plist_cs
);
1883 typedef struct _process_list
1886 struct _process_list
*next
;
1889 static Process_List
*PLIST
= NULL
;
1891 static int plist_length
= 0;
1894 add_handle (HANDLE h
)
1898 pl
= (Process_List
*) xmalloc (sizeof (Process_List
));
1902 /* -------------------- critical section -------------------- */
1907 /* -------------------- critical section -------------------- */
1913 remove_handle (HANDLE h
)
1916 Process_List
*prev
= NULL
;
1920 /* -------------------- critical section -------------------- */
1929 prev
->next
= pl
->next
;
1941 /* -------------------- critical section -------------------- */
1947 win32_no_block_spawn (char *command
, char *args
[])
1951 PROCESS_INFORMATION PI
;
1952 SECURITY_ATTRIBUTES SA
;
1957 /* compute the total command line length */
1961 csize
+= strlen (args
[k
]) + 1;
1965 full_command
= (char *) xmalloc (csize
);
1968 SI
.cb
= sizeof (STARTUPINFO
);
1969 SI
.lpReserved
= NULL
;
1970 SI
.lpReserved2
= NULL
;
1971 SI
.lpDesktop
= NULL
;
1975 SI
.wShowWindow
= SW_HIDE
;
1977 /* Security attributes. */
1978 SA
.nLength
= sizeof (SECURITY_ATTRIBUTES
);
1979 SA
.bInheritHandle
= TRUE
;
1980 SA
.lpSecurityDescriptor
= NULL
;
1982 /* Prepare the command string. */
1983 strcpy (full_command
, command
);
1984 strcat (full_command
, " ");
1989 strcat (full_command
, args
[k
]);
1990 strcat (full_command
, " ");
1995 int wsize
= csize
* 2;
1996 TCHAR
*wcommand
= (TCHAR
*) xmalloc (wsize
);
1998 S2WSU (wcommand
, full_command
, wsize
);
2000 free (full_command
);
2002 result
= CreateProcess
2003 (NULL
, wcommand
, &SA
, NULL
, TRUE
,
2004 GetPriorityClass (GetCurrentProcess()), NULL
, NULL
, &SI
, &PI
);
2011 add_handle (PI
.hProcess
);
2012 CloseHandle (PI
.hThread
);
2013 return (int) PI
.hProcess
;
2020 win32_wait (int *status
)
2029 if (plist_length
== 0)
2035 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * plist_length
);
2040 /* -------------------- critical section -------------------- */
2047 /* -------------------- critical section -------------------- */
2051 res
= WaitForMultipleObjects (plist_length
, hl
, FALSE
, INFINITE
);
2052 h
= hl
[res
- WAIT_OBJECT_0
];
2057 GetExitCodeProcess (h
, &exitcode
);
2060 *status
= (int) exitcode
;
2067 __gnat_portable_no_block_spawn (char *args
[])
2071 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX)
2074 #elif defined (__EMX__) || defined (MSDOS)
2076 /* ??? For PC machines I (Franco) don't know the system calls to implement
2077 this routine. So I'll fake it as follows. This routine will behave
2078 exactly like the blocking portable_spawn and will systematically return
2079 a pid of 0 unless the spawned task did not complete successfully, in
2080 which case we return a pid of -1. To synchronize with this the
2081 portable_wait below systematically returns a pid of 0 and reports that
2082 the subprocess terminated successfully. */
2084 if (spawnvp (P_WAIT
, args
[0], args
) != 0)
2087 #elif defined (_WIN32)
2089 pid
= win32_no_block_spawn (args
[0], args
);
2098 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2100 return -1; /* execv is in parent context on VMS. */
2112 __gnat_portable_wait (int *process_status
)
2117 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX)
2118 /* Not sure what to do here, so do same as __EMX__ case, i.e., nothing but
2121 #elif defined (_WIN32)
2123 pid
= win32_wait (&status
);
2125 #elif defined (__EMX__) || defined (MSDOS)
2126 /* ??? See corresponding comment in portable_no_block_spawn. */
2130 pid
= waitpid (-1, &status
, 0);
2131 status
= status
& 0xffff;
2134 *process_status
= status
;
2139 __gnat_os_exit (int status
)
2144 /* Locate a regular file, give a Path value. */
2147 __gnat_locate_regular_file (char *file_name
, char *path_val
)
2150 char *file_path
= alloca (strlen (file_name
) + 1);
2153 /* Return immediately if file_name is empty */
2155 if (*file_name
== '\0')
2158 /* Remove quotes around file_name if present */
2164 strcpy (file_path
, ptr
);
2166 ptr
= file_path
+ strlen (file_path
) - 1;
2171 /* Handle absolute pathnames. */
2173 absolute
= __gnat_is_absolute_path (file_path
, strlen (file_name
));
2177 if (__gnat_is_regular_file (file_path
))
2178 return xstrdup (file_path
);
2183 /* If file_name include directory separator(s), try it first as
2184 a path name relative to the current directory */
2185 for (ptr
= file_name
; *ptr
&& *ptr
!= '/' && *ptr
!= DIR_SEPARATOR
; ptr
++)
2190 if (__gnat_is_regular_file (file_name
))
2191 return xstrdup (file_name
);
2198 /* The result has to be smaller than path_val + file_name. */
2199 char *file_path
= alloca (strlen (path_val
) + strlen (file_name
) + 2);
2203 for (; *path_val
== PATH_SEPARATOR
; path_val
++)
2209 /* Skip the starting quote */
2211 if (*path_val
== '"')
2214 for (ptr
= file_path
; *path_val
&& *path_val
!= PATH_SEPARATOR
; )
2215 *ptr
++ = *path_val
++;
2219 /* Skip the ending quote */
2224 if (*ptr
!= '/' && *ptr
!= DIR_SEPARATOR
)
2225 *++ptr
= DIR_SEPARATOR
;
2227 strcpy (++ptr
, file_name
);
2229 if (__gnat_is_regular_file (file_path
))
2230 return xstrdup (file_path
);
2237 /* Locate an executable given a Path argument. This routine is only used by
2238 gnatbl and should not be used otherwise. Use locate_exec_on_path
2242 __gnat_locate_exec (char *exec_name
, char *path_val
)
2245 if (!strstr (exec_name
, HOST_EXECUTABLE_SUFFIX
))
2247 char *full_exec_name
2248 = alloca (strlen (exec_name
) + strlen (HOST_EXECUTABLE_SUFFIX
) + 1);
2250 strcpy (full_exec_name
, exec_name
);
2251 strcat (full_exec_name
, HOST_EXECUTABLE_SUFFIX
);
2252 ptr
= __gnat_locate_regular_file (full_exec_name
, path_val
);
2255 return __gnat_locate_regular_file (exec_name
, path_val
);
2259 return __gnat_locate_regular_file (exec_name
, path_val
);
2262 /* Locate an executable using the Systems default PATH. */
2265 __gnat_locate_exec_on_path (char *exec_name
)
2269 #if defined (_WIN32) && !defined (RTX)
2270 TCHAR
*wpath_val
= _tgetenv (_T("PATH"));
2272 /* In Win32 systems we expand the PATH as for XP environment
2273 variables are not automatically expanded. We also prepend the
2274 ".;" to the path to match normal NT path search semantics */
2276 #define EXPAND_BUFFER_SIZE 32767
2278 wapath_val
= alloca (EXPAND_BUFFER_SIZE
);
2280 wapath_val
[0] = '.';
2281 wapath_val
[1] = ';';
2283 DWORD res
= ExpandEnvironmentStrings
2284 (wpath_val
, &wapath_val
[2], EXPAND_BUFFER_SIZE
- 2);
2286 if (!res
) wapath_val
[0] = _T('\0');
2288 apath_val
= alloca (EXPAND_BUFFER_SIZE
);
2290 WS2SU (apath_val
, wapath_val
, EXPAND_BUFFER_SIZE
);
2291 return __gnat_locate_exec (exec_name
, apath_val
);
2296 char *path_val
= "/VAXC$PATH";
2298 char *path_val
= getenv ("PATH");
2300 if (path_val
== NULL
) return NULL
;
2301 apath_val
= alloca (strlen (path_val
) + 1);
2302 strcpy (apath_val
, path_val
);
2303 return __gnat_locate_exec (exec_name
, apath_val
);
2309 /* These functions are used to translate to and from VMS and Unix syntax
2310 file, directory and path specifications. */
2313 #define MAXNAMES 256
2314 #define NEW_CANONICAL_FILELIST_INCREMENT 64
2316 static char new_canonical_dirspec
[MAXPATH
];
2317 static char new_canonical_filespec
[MAXPATH
];
2318 static char new_canonical_pathspec
[MAXNAMES
*MAXPATH
];
2319 static unsigned new_canonical_filelist_index
;
2320 static unsigned new_canonical_filelist_in_use
;
2321 static unsigned new_canonical_filelist_allocated
;
2322 static char **new_canonical_filelist
;
2323 static char new_host_pathspec
[MAXNAMES
*MAXPATH
];
2324 static char new_host_dirspec
[MAXPATH
];
2325 static char new_host_filespec
[MAXPATH
];
2327 /* Routine is called repeatedly by decc$from_vms via
2328 __gnat_to_canonical_file_list_init until it returns 0 or the expansion
2332 wildcard_translate_unix (char *name
)
2335 char buff
[MAXPATH
];
2337 strncpy (buff
, name
, MAXPATH
);
2338 buff
[MAXPATH
- 1] = (char) 0;
2339 ver
= strrchr (buff
, '.');
2341 /* Chop off the version. */
2345 /* Dynamically extend the allocation by the increment. */
2346 if (new_canonical_filelist_in_use
== new_canonical_filelist_allocated
)
2348 new_canonical_filelist_allocated
+= NEW_CANONICAL_FILELIST_INCREMENT
;
2349 new_canonical_filelist
= (char **) xrealloc
2350 (new_canonical_filelist
,
2351 new_canonical_filelist_allocated
* sizeof (char *));
2354 new_canonical_filelist
[new_canonical_filelist_in_use
++] = xstrdup (buff
);
2359 /* Translate a wildcard VMS file spec into a list of Unix file specs. First do
2360 full translation and copy the results into a list (_init), then return them
2361 one at a time (_next). If onlydirs set, only expand directory files. */
2364 __gnat_to_canonical_file_list_init (char *filespec
, int onlydirs
)
2367 char buff
[MAXPATH
];
2369 len
= strlen (filespec
);
2370 strncpy (buff
, filespec
, MAXPATH
);
2372 /* Only look for directories */
2373 if (onlydirs
&& !strstr (&buff
[len
-5], "*.dir"))
2374 strncat (buff
, "*.dir", MAXPATH
);
2376 buff
[MAXPATH
- 1] = (char) 0;
2378 decc$
from_vms (buff
, wildcard_translate_unix
, 1);
2380 /* Remove the .dir extension. */
2386 for (i
= 0; i
< new_canonical_filelist_in_use
; i
++)
2388 ext
= strstr (new_canonical_filelist
[i
], ".dir");
2394 return new_canonical_filelist_in_use
;
2397 /* Return the next filespec in the list. */
2400 __gnat_to_canonical_file_list_next ()
2402 return new_canonical_filelist
[new_canonical_filelist_index
++];
2405 /* Free storage used in the wildcard expansion. */
2408 __gnat_to_canonical_file_list_free ()
2412 for (i
= 0; i
< new_canonical_filelist_in_use
; i
++)
2413 free (new_canonical_filelist
[i
]);
2415 free (new_canonical_filelist
);
2417 new_canonical_filelist_in_use
= 0;
2418 new_canonical_filelist_allocated
= 0;
2419 new_canonical_filelist_index
= 0;
2420 new_canonical_filelist
= 0;
2423 /* The functional equivalent of decc$translate_vms routine.
2424 Designed to produce the same output, but is protected against
2425 malformed paths (original version ACCVIOs in this case) and
2426 does not require VMS-specific DECC RTL */
2428 #define NAM$C_MAXRSS 1024
2431 __gnat_translate_vms (char *src
)
2433 static char retbuf
[NAM$C_MAXRSS
+1];
2434 char *srcendpos
, *pos1
, *pos2
, *retpos
;
2435 int disp
, path_present
= 0;
2437 if (!src
) return NULL
;
2439 srcendpos
= strchr (src
, '\0');
2442 /* Look for the node and/or device in front of the path */
2444 pos2
= strchr (pos1
, ':');
2446 if (pos2
&& (pos2
< srcendpos
) && (*(pos2
+ 1) == ':')) {
2447 /* There is a node name. "node_name::" becomes "node_name!" */
2449 strncpy (retbuf
, pos1
, disp
);
2450 retpos
[disp
] = '!';
2451 retpos
= retpos
+ disp
+ 1;
2453 pos2
= strchr (pos1
, ':');
2457 /* There is a device name. "dev_name:" becomes "/dev_name/" */
2460 strncpy (retpos
, pos1
, disp
);
2461 retpos
= retpos
+ disp
;
2466 /* No explicit device; we must look ahead and prepend /sys$disk/ if
2467 the path is absolute */
2468 if ((*pos1
== '[' || *pos1
== '<') && (pos1
< srcendpos
)
2469 && !strchr (".-]>", *(pos1
+ 1))) {
2470 strncpy (retpos
, "/sys$disk/", 10);
2474 /* Process the path part */
2475 while (*pos1
== '[' || *pos1
== '<') {
2478 if (*pos1
== ']' || *pos1
== '>') {
2479 /* Special case, [] translates to '.' */
2484 /* '[000000' means root dir. It can be present in the middle of
2485 the path due to expansion of logical devices, in which case
2487 if (!strncmp (pos1
, "000000", 6) && path_present
> 1 &&
2488 (*(pos1
+ 6) == ']' || *(pos1
+ 6) == '>' || *(pos1
+ 6) == '.')) {
2490 if (*pos1
== '.') pos1
++;
2492 else if (*pos1
== '.') {
2497 /* There is a qualified path */
2498 while (*pos1
&& *pos1
!= ']' && *pos1
!= '>') {
2501 /* '.' is used to separate directories. Replace it with '/' but
2502 only if there isn't already '/' just before */
2503 if (*(retpos
- 1) != '/') *(retpos
++) = '/';
2505 if (pos1
+ 1 < srcendpos
&& *pos1
== '.' && *(pos1
+ 1) == '.') {
2506 /* ellipsis refers to entire subtree; replace with '**' */
2507 *(retpos
++) = '*'; *(retpos
++) = '*'; *(retpos
++) = '/';
2512 /* When after '.' '[' '<' is equivalent to Unix ".." but there
2513 may be several in a row */
2514 if (*(pos1
- 1) == '.' || *(pos1
- 1) == '[' ||
2515 *(pos1
- 1) == '<') {
2516 while (*pos1
== '-') {
2518 *(retpos
++) = '.'; *(retpos
++) = '.'; *(retpos
++) = '/';
2523 /* otherwise fall through to default */
2525 *(retpos
++) = *(pos1
++);
2532 if (pos1
< srcendpos
) {
2533 /* Now add the actual file name, until the version suffix if any */
2534 if (path_present
) *(retpos
++) = '/';
2535 pos2
= strchr (pos1
, ';');
2536 disp
= pos2
? (pos2
- pos1
) : (srcendpos
- pos1
);
2537 strncpy (retpos
, pos1
, disp
);
2539 if (pos2
&& pos2
< srcendpos
) {
2540 /* There is a non-empty version suffix. ";<ver>" becomes ".<ver>" */
2542 disp
= srcendpos
- pos2
- 1;
2543 strncpy (retpos
, pos2
+ 1, disp
);
2554 /* Translate a VMS syntax directory specification in to Unix syntax. If
2555 PREFIXFLAG is set, append an underscore "/". If no indicators of VMS syntax
2556 found, return input string. Also translate a dirname that contains no
2557 slashes, in case it's a logical name. */
2560 __gnat_to_canonical_dir_spec (char *dirspec
, int prefixflag
)
2564 strcpy (new_canonical_dirspec
, "");
2565 if (strlen (dirspec
))
2569 if (strchr (dirspec
, ']') || strchr (dirspec
, ':'))
2571 strncpy (new_canonical_dirspec
,
2572 __gnat_translate_vms (dirspec
),
2575 else if (!strchr (dirspec
, '/') && (dirspec1
= getenv (dirspec
)) != 0)
2577 strncpy (new_canonical_dirspec
,
2578 __gnat_translate_vms (dirspec1
),
2583 strncpy (new_canonical_dirspec
, dirspec
, MAXPATH
);
2587 len
= strlen (new_canonical_dirspec
);
2588 if (prefixflag
&& new_canonical_dirspec
[len
-1] != '/')
2589 strncat (new_canonical_dirspec
, "/", MAXPATH
);
2591 new_canonical_dirspec
[MAXPATH
- 1] = (char) 0;
2593 return new_canonical_dirspec
;
2597 /* Translate a VMS syntax file specification into Unix syntax.
2598 If no indicators of VMS syntax found, check if it's an uppercase
2599 alphanumeric_ name and if so try it out as an environment
2600 variable (logical name). If all else fails return the
2604 __gnat_to_canonical_file_spec (char *filespec
)
2608 strncpy (new_canonical_filespec
, "", MAXPATH
);
2610 if (strchr (filespec
, ']') || strchr (filespec
, ':'))
2612 char *tspec
= (char *) __gnat_translate_vms (filespec
);
2614 if (tspec
!= (char *) -1)
2615 strncpy (new_canonical_filespec
, tspec
, MAXPATH
);
2617 else if ((strlen (filespec
) == strspn (filespec
,
2618 "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"))
2619 && (filespec1
= getenv (filespec
)))
2621 char *tspec
= (char *) __gnat_translate_vms (filespec1
);
2623 if (tspec
!= (char *) -1)
2624 strncpy (new_canonical_filespec
, tspec
, MAXPATH
);
2628 strncpy (new_canonical_filespec
, filespec
, MAXPATH
);
2631 new_canonical_filespec
[MAXPATH
- 1] = (char) 0;
2633 return new_canonical_filespec
;
2636 /* Translate a VMS syntax path specification into Unix syntax.
2637 If no indicators of VMS syntax found, return input string. */
2640 __gnat_to_canonical_path_spec (char *pathspec
)
2642 char *curr
, *next
, buff
[MAXPATH
];
2647 /* If there are /'s, assume it's a Unix path spec and return. */
2648 if (strchr (pathspec
, '/'))
2651 new_canonical_pathspec
[0] = 0;
2656 next
= strchr (curr
, ',');
2658 next
= strchr (curr
, 0);
2660 strncpy (buff
, curr
, next
- curr
);
2661 buff
[next
- curr
] = 0;
2663 /* Check for wildcards and expand if present. */
2664 if (strchr (buff
, '*') || strchr (buff
, '%') || strstr (buff
, "..."))
2668 dirs
= __gnat_to_canonical_file_list_init (buff
, 1);
2669 for (i
= 0; i
< dirs
; i
++)
2673 next_dir
= __gnat_to_canonical_file_list_next ();
2674 strncat (new_canonical_pathspec
, next_dir
, MAXPATH
);
2676 /* Don't append the separator after the last expansion. */
2678 strncat (new_canonical_pathspec
, ":", MAXPATH
);
2681 __gnat_to_canonical_file_list_free ();
2684 strncat (new_canonical_pathspec
,
2685 __gnat_to_canonical_dir_spec (buff
, 0), MAXPATH
);
2690 strncat (new_canonical_pathspec
, ":", MAXPATH
);
2694 new_canonical_pathspec
[MAXPATH
- 1] = (char) 0;
2696 return new_canonical_pathspec
;
2699 static char filename_buff
[MAXPATH
];
2702 translate_unix (char *name
, int type
)
2704 strncpy (filename_buff
, name
, MAXPATH
);
2705 filename_buff
[MAXPATH
- 1] = (char) 0;
2709 /* Translate a Unix syntax path spec into a VMS style (comma separated list of
2713 to_host_path_spec (char *pathspec
)
2715 char *curr
, *next
, buff
[MAXPATH
];
2720 /* Can't very well test for colons, since that's the Unix separator! */
2721 if (strchr (pathspec
, ']') || strchr (pathspec
, ','))
2724 new_host_pathspec
[0] = 0;
2729 next
= strchr (curr
, ':');
2731 next
= strchr (curr
, 0);
2733 strncpy (buff
, curr
, next
- curr
);
2734 buff
[next
- curr
] = 0;
2736 strncat (new_host_pathspec
, __gnat_to_host_dir_spec (buff
, 0), MAXPATH
);
2739 strncat (new_host_pathspec
, ",", MAXPATH
);
2743 new_host_pathspec
[MAXPATH
- 1] = (char) 0;
2745 return new_host_pathspec
;
2748 /* Translate a Unix syntax directory specification into VMS syntax. The
2749 PREFIXFLAG has no effect, but is kept for symmetry with
2750 to_canonical_dir_spec. If indicators of VMS syntax found, return input
2754 __gnat_to_host_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2756 int len
= strlen (dirspec
);
2758 strncpy (new_host_dirspec
, dirspec
, MAXPATH
);
2759 new_host_dirspec
[MAXPATH
- 1] = (char) 0;
2761 if (strchr (new_host_dirspec
, ']') || strchr (new_host_dirspec
, ':'))
2762 return new_host_dirspec
;
2764 while (len
> 1 && new_host_dirspec
[len
- 1] == '/')
2766 new_host_dirspec
[len
- 1] = 0;
2770 decc$
to_vms (new_host_dirspec
, translate_unix
, 1, 2);
2771 strncpy (new_host_dirspec
, filename_buff
, MAXPATH
);
2772 new_host_dirspec
[MAXPATH
- 1] = (char) 0;
2774 return new_host_dirspec
;
2777 /* Translate a Unix syntax file specification into VMS syntax.
2778 If indicators of VMS syntax found, return input string. */
2781 __gnat_to_host_file_spec (char *filespec
)
2783 strncpy (new_host_filespec
, "", MAXPATH
);
2784 if (strchr (filespec
, ']') || strchr (filespec
, ':'))
2786 strncpy (new_host_filespec
, filespec
, MAXPATH
);
2790 decc$
to_vms (filespec
, translate_unix
, 1, 1);
2791 strncpy (new_host_filespec
, filename_buff
, MAXPATH
);
2794 new_host_filespec
[MAXPATH
- 1] = (char) 0;
2796 return new_host_filespec
;
2800 __gnat_adjust_os_resource_limits ()
2802 SYS$
ADJWSL (131072, 0);
2807 /* Dummy functions for Osint import for non-VMS systems. */
2810 __gnat_to_canonical_file_list_init
2811 (char *dirspec ATTRIBUTE_UNUSED
, int onlydirs ATTRIBUTE_UNUSED
)
2817 __gnat_to_canonical_file_list_next (void)
2823 __gnat_to_canonical_file_list_free (void)
2828 __gnat_to_canonical_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2834 __gnat_to_canonical_file_spec (char *filespec
)
2840 __gnat_to_canonical_path_spec (char *pathspec
)
2846 __gnat_to_host_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2852 __gnat_to_host_file_spec (char *filespec
)
2858 __gnat_adjust_os_resource_limits (void)
2864 /* For EMX, we cannot include dummy in libgcc, since it is too difficult
2865 to coordinate this with the EMX distribution. Consequently, we put the
2866 definition of dummy which is used for exception handling, here. */
2868 #if defined (__EMX__)
2872 #if defined (__mips_vxworks)
2876 CACHE_USER_FLUSH (0, ENTIRE_CACHE
);
2880 #if defined (CROSS_DIRECTORY_STRUCTURE) \
2881 || (! ((defined (sparc) || defined (i386)) && defined (sun) \
2882 && defined (__SVR4)) \
2883 && ! (defined (linux) && (defined (i386) || defined (__x86_64__))) \
2884 && ! (defined (linux) && defined (__ia64__)) \
2885 && ! (defined (linux) && defined (powerpc)) \
2886 && ! defined (__FreeBSD__) \
2887 && ! defined (__hpux__) \
2888 && ! defined (__APPLE__) \
2889 && ! defined (_AIX) \
2890 && ! (defined (__alpha__) && defined (__osf__)) \
2891 && ! defined (VMS) \
2892 && ! defined (__MINGW32__) \
2893 && ! (defined (__mips) && defined (__sgi)))
2895 /* Dummy function to satisfy g-trasym.o. See the preprocessor conditional
2896 just above for a list of native platforms that provide a non-dummy
2897 version of this procedure in libaddr2line.a. */
2900 convert_addresses (const char *file_name ATTRIBUTE_UNUSED
,
2901 void *addrs ATTRIBUTE_UNUSED
,
2902 int n_addr ATTRIBUTE_UNUSED
,
2903 void *buf ATTRIBUTE_UNUSED
,
2904 int *len ATTRIBUTE_UNUSED
)
2910 #if defined (_WIN32)
2911 int __gnat_argument_needs_quote
= 1;
2913 int __gnat_argument_needs_quote
= 0;
2916 /* This option is used to enable/disable object files handling from the
2917 binder file by the GNAT Project module. For example, this is disabled on
2918 Windows (prior to GCC 3.4) as it is already done by the mdll module.
2919 Stating with GCC 3.4 the shared libraries are not based on mdll
2920 anymore as it uses the GCC's -shared option */
2921 #if defined (_WIN32) \
2922 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
2923 int __gnat_prj_add_obj_files
= 0;
2925 int __gnat_prj_add_obj_files
= 1;
2928 /* char used as prefix/suffix for environment variables */
2929 #if defined (_WIN32)
2930 char __gnat_environment_char
= '%';
2932 char __gnat_environment_char
= '$';
2935 /* This functions copy the file attributes from a source file to a
2938 mode = 0 : In this mode copy only the file time stamps (last access and
2939 last modification time stamps).
2941 mode = 1 : In this mode, time stamps and read/write/execute attributes are
2944 Returns 0 if operation was successful and -1 in case of error. */
2947 __gnat_copy_attribs (char *from
, char *to
, int mode
)
2949 #if defined (VMS) || defined (__vxworks) || defined (__nucleus__)
2953 struct utimbuf tbuf
;
2955 if (stat (from
, &fbuf
) == -1)
2960 tbuf
.actime
= fbuf
.st_atime
;
2961 tbuf
.modtime
= fbuf
.st_mtime
;
2963 if (utime (to
, &tbuf
) == -1)
2970 if (chmod (to
, fbuf
.st_mode
) == -1)
2981 __gnat_lseek (int fd
, long offset
, int whence
)
2983 return (int) lseek (fd
, offset
, whence
);
2986 /* This function returns the major version number of GCC being used. */
2988 get_gcc_version (void)
2993 return (int) (version_string
[0] - '0');
2998 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED
,
2999 int close_on_exec_p ATTRIBUTE_UNUSED
)
3001 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
3002 int flags
= fcntl (fd
, F_GETFD
, 0);
3005 if (close_on_exec_p
)
3006 flags
|= FD_CLOEXEC
;
3008 flags
&= ~FD_CLOEXEC
;
3009 return fcntl (fd
, F_SETFD
, flags
| FD_CLOEXEC
);
3012 /* For the Windows case, we should use SetHandleInformation to remove
3013 the HANDLE_INHERIT property from fd. This is not implemented yet,
3014 but for our purposes (support of GNAT.Expect) this does not matter,
3015 as by default handles are *not* inherited. */
3019 /* Indicates if platforms supports automatic initialization through the
3020 constructor mechanism */
3022 __gnat_binder_supports_auto_init ()
3031 /* Indicates that Stand-Alone Libraries are automatically initialized through
3032 the constructor mechanism */
3034 __gnat_sals_init_using_constructors ()
3036 #if defined (__vxworks) || defined (__Lynx__) || defined (VMS)
3043 /* In RTX mode, the procedure to get the time (as file time) is different
3044 in RTSS mode and Win32 mode. In order to avoid duplicating an Ada file,
3045 we introduce an intermediate procedure to link against the corresponding
3046 one in each situation. */
3049 void GetTimeAsFileTime(LPFILETIME pTime
)
3052 RtGetRtssTimeAsFileTime (pTime
); /* RTSS interface */
3054 GetSystemTimeAsFileTime (pTime
); /* w32 interface */
3059 #if defined (linux) || defined(__GLIBC__)
3060 /* pthread affinity support */
3062 int __gnat_pthread_setaffinity_np (pthread_t th
,
3064 const void *cpuset
);
3067 #include <pthread.h>
3069 __gnat_pthread_setaffinity_np (pthread_t th
,
3071 const cpu_set_t
*cpuset
)
3073 return pthread_setaffinity_np (th
, cpusetsize
, cpuset
);
3077 __gnat_pthread_setaffinity_np (pthread_t th ATTRIBUTE_UNUSED
,
3078 size_t cpusetsize ATTRIBUTE_UNUSED
,
3079 const void *cpuset ATTRIBUTE_UNUSED
)