1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
9 * Copyright (C) 1992-2022, 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 3, 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. *
18 * As a special exception under Section 7 of GPL version 3, you are granted *
19 * additional permissions described in the GCC Runtime Library Exception, *
20 * version 3.1, as published by the Free Software Foundation. *
22 * You should have received a copy of the GNU General Public License and *
23 * a copy of the GCC Runtime Library Exception along with this program; *
24 * see the files COPYING3 and COPYING.RUNTIME respectively. If not, see *
25 * <http://www.gnu.org/licenses/>. *
27 * GNAT was originally developed by the GNAT team at New York University. *
28 * Extensive contributions were provided by Ada Core Technologies Inc. *
30 ****************************************************************************/
32 /* This file contains those routines named by Import pragmas in
33 packages in the GNAT hierarchy (especially GNAT.OS_Lib) and in
34 package Osint. Many of the subprograms in OS_Lib import standard
35 library calls directly. This file contains all other routines. */
37 /* Ensure access to errno is thread safe. */
47 /* Use 64 bit Large File API */
49 #define _LARGEFILE64_SOURCE 1
50 #elif !defined(_LARGEFILE_SOURCE)
51 #define _LARGEFILE_SOURCE
53 #define _FILE_OFFSET_BITS 64
57 /* No need to redefine exit here. */
60 /* We want to use the POSIX variants of include files. */
65 #if defined (__mips_vxworks)
67 #endif /* __mips_vxworks */
69 /* If SMP, access vxCpuConfiguredGet */
70 #ifdef _WRS_CONFIG_SMP
72 #endif /* _WRS_CONFIG_SMP */
74 /* We need to know the VxWorks version because some file operations
75 (such as chmod) are only available on VxWorks 6. */
78 /* vwModNum.h and dosFsLib.h are needed for the VxWorks 6 rename workaround.
80 #if (_WRS_VXWORKS_MAJOR == 6)
86 #if defined (__APPLE__)
90 #if defined (__hpux__)
91 #include <sys/param.h>
92 #include <sys/pstat.h>
96 #define __BSD_VISIBLE 1
100 #include <sys/syspage.h>
101 #include <sys/time.h>
108 #include <sys/types.h>
109 #include <sys/stat.h>
114 /* for CPU_SET/CPU_ZERO */
125 #include <sys/stat.h>
129 #if defined (__vxworks) || defined (__ANDROID__)
130 /* S_IREAD and S_IWRITE are not defined in VxWorks or Android */
132 #define S_IREAD (S_IRUSR | S_IRGRP | S_IROTH)
136 #define S_IWRITE (S_IWUSR)
140 /* We don't have libiberty, so use malloc. */
141 #define xmalloc(S) malloc (S)
142 #define xrealloc(V,S) realloc (V,S)
149 /* limits.h is needed for LLONG_MIN. */
160 #if defined (__DJGPP__)
162 /* For isalpha-like tests in the compiler, we're expected to resort to
163 safe-ctype.h/ISALPHA. This isn't available for the runtime library
164 build, so we fallback on ctype.h/isalpha there. */
168 #define ISALPHA isalpha
171 #elif defined (__MINGW32__) || defined (__CYGWIN__)
175 /* Current code page and CCS encoding to use, set in initialize.c. */
176 UINT __gnat_current_codepage
;
177 UINT __gnat_current_ccs_encoding
;
179 #include <sys/utime.h>
181 /* For isalpha-like tests in the compiler, we're expected to resort to
182 safe-ctype.h/ISALPHA. This isn't available for the runtime library
183 build, so we fallback on ctype.h/isalpha there. */
187 #define ISALPHA isalpha
190 #elif defined (__Lynx__)
192 /* Lynx utime.h only defines the entities of interest to us if
193 defined (VMOS_DEV), so ... */
202 /* wait.h processing */
203 #if defined (__vxworks) && defined (__RTP__)
205 #elif defined (__Lynx__)
206 /* ??? We really need wait.h and it includes resource.h on Lynx. GCC
207 has a resource.h header as well, included instead of the lynx
208 version in our setup, causing lots of errors. We don't really need
209 the lynx contents of this file, so just workaround the issue by
210 preventing the inclusion of the GCC header from doing anything. */
211 # define GCC_RESOURCE_H
212 # include <sys/wait.h>
213 #elif defined (__PikeOS__) || defined (__MINGW32__)
214 /* No wait() or waitpid() calls available. */
217 #include <sys/wait.h>
220 #if defined (__DJGPP__)
226 #define DIR_SEPARATOR '\\'
228 #elif defined (_WIN32)
233 #include <tlhelp32.h>
236 #define DIR_SEPARATOR '\\'
244 int __gnat_in_child_after_fork
= 0;
246 #if defined (__APPLE__) && defined (st_mtime)
247 #define st_atim st_atimespec
248 #define st_mtim st_mtimespec
251 /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
252 defined in the current system. On DOS-like systems these flags control
253 whether the file is opened/created in text-translation mode (CR/LF in
254 external file mapped to LF in internal file), but in Unix-like systems,
255 no text translation is required, so these flags have no effect. */
265 #ifndef HOST_EXECUTABLE_SUFFIX
266 #define HOST_EXECUTABLE_SUFFIX ""
269 #ifndef HOST_OBJECT_SUFFIX
270 #define HOST_OBJECT_SUFFIX ".o"
273 #ifndef PATH_SEPARATOR
274 #define PATH_SEPARATOR ':'
277 #ifndef DIR_SEPARATOR
278 #define DIR_SEPARATOR '/'
279 #define IS_DIRECTORY_SEPARATOR(c) ((c) == DIR_SEPARATOR)
281 #define IS_DIRECTORY_SEPARATOR(c) ((c) == '/' || (c) == DIR_SEPARATOR)
284 /* Check for cross-compilation. */
285 #if defined (CROSS_COMPILE) || defined (CROSS_DIRECTORY_STRUCTURE)
287 int __gnat_is_cross_compiler
= 1;
290 int __gnat_is_cross_compiler
= 0;
293 char __gnat_dir_separator
= DIR_SEPARATOR
;
295 char __gnat_path_separator
= PATH_SEPARATOR
;
297 /* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
298 the base filenames that libraries specified with -lsomelib options
299 may have. This is used by GNATMAKE to check whether an executable
300 is up-to-date or not. The syntax is
302 library_template ::= { pattern ; } pattern NUL
303 pattern ::= [ prefix ] * [ postfix ]
305 These should only specify names of static libraries as it makes
306 no sense to determine at link time if dynamic-link libraries are
307 up to date or not. Any libraries that are not found are supposed
310 * if they are needed but not present, the link
313 * otherwise they are libraries in the system paths and so
314 they are considered part of the system and not checked
317 ??? This should be part of a GNAT host-specific compiler
318 file instead of being included in all user applications
319 as well. This is only a temporary work-around for 3.11b. */
321 #ifndef GNAT_LIBRARY_TEMPLATE
322 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
325 const char *__gnat_library_template
= GNAT_LIBRARY_TEMPLATE
;
327 #if defined (__vxworks)
328 #define GNAT_MAX_PATH_LEN PATH_MAX
332 #if defined (__MINGW32__)
335 #include <sys/param.h>
339 #define GNAT_MAX_PATH_LEN MAXPATHLEN
341 #define GNAT_MAX_PATH_LEN 256
346 /* Used for runtime check that Ada constant File_Attributes_Size is no
347 less than the actual size of struct file_attributes (see Osint
349 int __gnat_size_of_file_attributes
= sizeof (struct file_attributes
);
351 void __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
);
353 /* The __gnat_max_path_len variable is used to export the maximum
354 length of a path name to Ada code. max_path_len is also provided
355 for compatibility with older GNAT versions, please do not use
358 int __gnat_max_path_len
= GNAT_MAX_PATH_LEN
;
359 int max_path_len
= GNAT_MAX_PATH_LEN
;
361 /* Control whether we can use ACL on Windows. */
363 int __gnat_use_acl
= 1;
365 /* The following macro HAVE_READDIR_R should be defined if the
366 system provides the routine readdir_r.
367 ... but we never define it anywhere??? */
368 #undef HAVE_READDIR_R
370 #define MAYBE_TO_PTR32(argv) argv
372 static const char ATTR_UNSET
= 127;
374 /* Reset the file attributes as if no system call had been performed */
377 __gnat_reset_attributes (struct file_attributes
* attr
)
379 attr
->exists
= ATTR_UNSET
;
380 attr
->error
= EINVAL
;
382 attr
->writable
= ATTR_UNSET
;
383 attr
->readable
= ATTR_UNSET
;
384 attr
->executable
= ATTR_UNSET
;
386 attr
->regular
= ATTR_UNSET
;
387 attr
->symbolic_link
= ATTR_UNSET
;
388 attr
->directory
= ATTR_UNSET
;
390 attr
->timestamp
= (OS_Time
)-2;
391 attr
->file_length
= -1;
395 __gnat_error_attributes (struct file_attributes
*attr
) {
400 __gnat_current_time (void)
402 time_t res
= time (NULL
);
403 return (OS_Time
) res
;
406 /* Return the current local time as a string in the ISO 8601 format of
407 "YYYY-MM-DD HH:MM:SS.SS". The returned string is 22 + 1 (NULL) characters
411 __gnat_current_time_string (char *result
)
413 const char *format
= "%Y-%m-%d %H:%M:%S";
414 /* Format string necessary to describe the ISO 8601 format */
416 const time_t t_val
= time (NULL
);
418 strftime (result
, 22, format
, localtime (&t_val
));
419 /* Convert the local time into a string following the ISO format, copying
420 at most 22 characters into the result string. */
425 /* The sub-seconds are manually set to zero since type time_t lacks the
426 precision necessary for nanoseconds. */
430 __gnat_to_gm_time (OS_Time
*p_time
, int *p_year
, int *p_month
, int *p_day
,
431 int *p_hours
, int *p_mins
, int *p_secs
)
434 time_t time
= (time_t) *p_time
;
436 res
= gmtime (&time
);
439 *p_year
= res
->tm_year
;
440 *p_month
= res
->tm_mon
;
441 *p_day
= res
->tm_mday
;
442 *p_hours
= res
->tm_hour
;
443 *p_mins
= res
->tm_min
;
444 *p_secs
= res
->tm_sec
;
447 *p_year
= *p_month
= *p_day
= *p_hours
= *p_mins
= *p_secs
= 0;
451 __gnat_to_os_time (OS_Time
*p_time
, int year
, int month
, int day
,
452 int hours
, int mins
, int secs
)
464 /* returns -1 of failing, this is s-os_lib Invalid_Time */
466 *p_time
= (OS_Time
) mktime (&v
);
469 /* Place the contents of the symbolic link named PATH in the buffer BUF,
470 which has size BUFSIZ. If PATH is a symbolic link, then return the number
471 of characters of its content in BUF. Otherwise, return -1.
472 For systems not supporting symbolic links, always return -1. */
475 __gnat_readlink (char *path ATTRIBUTE_UNUSED
,
476 char *buf ATTRIBUTE_UNUSED
,
477 size_t bufsiz ATTRIBUTE_UNUSED
)
479 #if defined (_WIN32) \
480 || defined(__vxworks) || defined (__PikeOS__)
483 return readlink (path
, buf
, bufsiz
);
487 /* Creates a symbolic link named NEWPATH which contains the string OLDPATH.
488 If NEWPATH exists it will NOT be overwritten.
489 For systems not supporting symbolic links, always return -1. */
492 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED
,
493 char *newpath ATTRIBUTE_UNUSED
)
495 #if defined (_WIN32) \
496 || defined(__vxworks) || defined (__PikeOS__)
499 return symlink (oldpath
, newpath
);
503 /* Try to lock a file, return 1 if success. */
505 #if defined (__vxworks) \
506 || defined (_WIN32) || defined (__PikeOS__)
508 /* Version that does not use link. */
511 __gnat_try_lock (char *dir
, char *file
)
515 TCHAR wfull_path
[GNAT_MAX_PATH_LEN
];
516 TCHAR wfile
[GNAT_MAX_PATH_LEN
];
517 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
519 S2WSC (wdir
, dir
, GNAT_MAX_PATH_LEN
);
520 S2WSC (wfile
, file
, GNAT_MAX_PATH_LEN
);
522 /* ??? the code below crash on MingW64 for obscure reasons, a ticket
523 has been opened here:
525 https://sourceforge.net/p/mingw-w64/bugs/414/
527 As a workaround an equivalent set of code has been put in place below.
529 _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
532 _tcscpy (wfull_path
, wdir
);
533 _tcscat (wfull_path
, L
"\\");
534 _tcscat (wfull_path
, wfile
);
536 fd
= _topen (wfull_path
, O_CREAT
| O_EXCL
, 0600);
540 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
541 fd
= open (full_path
, O_CREAT
| O_EXCL
, 0600);
553 /* Version using link(), more secure over NFS. */
554 /* See TN 6913-016 for discussion ??? */
557 __gnat_try_lock (char *dir
, char *file
)
561 GNAT_STRUCT_STAT stat_result
;
564 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
565 sprintf (temp_file
, "%s%cTMP-%ld-%ld",
566 dir
, DIR_SEPARATOR
, (long)getpid(), (long)getppid ());
568 /* Create the temporary file and write the process number. */
569 fd
= open (temp_file
, O_CREAT
| O_WRONLY
, 0600);
575 /* Link it with the new file. */
576 link (temp_file
, full_path
);
578 /* Count the references on the old one. If we have a count of two, then
579 the link did succeed. Remove the temporary file before returning. */
580 __gnat_stat (temp_file
, &stat_result
);
582 return stat_result
.st_nlink
== 2;
586 /* Return the maximum file name length. */
589 __gnat_get_maximum_file_name_length (void)
594 /* Return nonzero if file names are case sensitive. */
596 static int file_names_case_sensitive_cache
= -1;
599 __gnat_get_file_names_case_sensitive (void)
601 if (file_names_case_sensitive_cache
== -1)
603 const char *sensitive
= getenv ("GNAT_FILE_NAME_CASE_SENSITIVE");
605 if (sensitive
!= NULL
606 && (sensitive
[0] == '0' || sensitive
[0] == '1')
607 && sensitive
[1] == '\0')
608 file_names_case_sensitive_cache
= sensitive
[0] - '0';
611 /* By default, we suppose filesystems aren't case sensitive on
612 Windows and Darwin (but they are on arm-darwin). */
613 #if defined (WINNT) || defined (__DJGPP__) \
614 || (defined (__APPLE__) && !(defined (__arm__) || defined (__arm64__)))
615 file_names_case_sensitive_cache
= 0;
617 file_names_case_sensitive_cache
= 1;
621 return file_names_case_sensitive_cache
;
624 /* Return nonzero if environment variables are case sensitive. */
627 __gnat_get_env_vars_case_sensitive (void)
629 #if defined (WINNT) || defined (__DJGPP__)
637 __gnat_get_default_identifier_character_set (void)
642 /* Return the current working directory. */
645 __gnat_get_current_dir (char *dir
, int *length
)
647 #if defined (__MINGW32__)
648 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
650 _tgetcwd (wdir
, *length
);
652 WS2SC (dir
, wdir
, GNAT_MAX_PATH_LEN
);
655 char* result
= getcwd (dir
, *length
);
656 /* If the current directory does not exist, set length = 0
657 to indicate error. That can't happen on windows, where
658 you can't delete a directory if it is the current
659 directory of some process. */
667 *length
= strlen (dir
);
669 if (dir
[*length
- 1] != DIR_SEPARATOR
)
671 dir
[*length
] = DIR_SEPARATOR
;
677 /* Return the suffix for object files. */
680 __gnat_get_object_suffix_ptr (int *len
, const char **value
)
682 *value
= HOST_OBJECT_SUFFIX
;
687 *len
= strlen (*value
);
692 /* Return the suffix for executable files. */
695 __gnat_get_executable_suffix_ptr (int *len
, const char **value
)
697 *value
= HOST_EXECUTABLE_SUFFIX
;
702 *len
= strlen (*value
);
707 /* Return the suffix for debuggable files. Usually this is the same as the
708 executable extension. */
711 __gnat_get_debuggable_suffix_ptr (int *len
, const char **value
)
713 *value
= HOST_EXECUTABLE_SUFFIX
;
718 *len
= strlen (*value
);
723 /* Returns the OS filename and corresponding encoding. */
726 __gnat_os_filename (char *filename ATTRIBUTE_UNUSED
,
727 char *w_filename ATTRIBUTE_UNUSED
,
728 char *os_name
, int *o_length
,
729 char *encoding ATTRIBUTE_UNUSED
, int *e_length
)
731 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
732 WS2SC (os_name
, (TCHAR
*)w_filename
, (DWORD
)*o_length
);
733 *o_length
= strlen (os_name
);
734 strcpy (encoding
, "encoding=utf8");
735 *e_length
= strlen (encoding
);
737 strcpy (os_name
, filename
);
738 *o_length
= strlen (filename
);
746 __gnat_unlink (char *path
)
748 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
750 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
752 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
753 return _tunlink (wpath
);
756 return unlink (path
);
763 __gnat_rename (char *from
, char *to
)
765 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
767 TCHAR wfrom
[GNAT_MAX_PATH_LEN
], wto
[GNAT_MAX_PATH_LEN
];
769 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
);
770 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
);
771 return _trename (wfrom
, wto
);
773 #elif defined (__vxworks) && (_WRS_VXWORKS_MAJOR == 6)
775 /* When used on a dos filesystem under VxWorks 6.9 rename will trigger a
776 S_dosFsLib_FILE_NOT_FOUND errno when the file is not found. Let's map
777 that to ENOENT so Ada.Directory.Rename can detect that and raise the
778 Name_Error exception. */
779 int ret
= rename (from
, to
);
781 if (ret
&& (errno
== S_dosFsLib_FILE_NOT_FOUND
))
788 return rename (from
, to
);
792 /* Changing directory. */
795 __gnat_chdir (char *path
)
797 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
799 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
801 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
802 return _tchdir (wpath
);
809 /* Removing a directory. */
812 __gnat_rmdir (char *path
)
814 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
816 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
818 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
819 return _trmdir (wpath
);
821 #elif defined (VTHREADS)
822 /* rmdir not available */
829 #if defined (_WIN32) || defined (__linux__) || defined (__sun__) \
830 || defined (__FreeBSD__) || defined(__DragonFly__) || defined (__QNX__)
831 #define HAS_TARGET_WCHAR_T
834 #ifdef HAS_TARGET_WCHAR_T
839 __gnat_fputwc(int c
, FILE *stream
)
841 #ifdef HAS_TARGET_WCHAR_T
842 return fputwc ((wchar_t)c
, stream
);
844 return fputc (c
, stream
);
849 __gnat_fopen (char *path
, char *mode
, int encoding ATTRIBUTE_UNUSED
)
851 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
852 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
855 S2WS (wmode
, mode
, 10);
857 if (encoding
== Encoding_Unspecified
)
858 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
859 else if (encoding
== Encoding_UTF8
)
860 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
862 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
864 return _tfopen (wpath
, wmode
);
867 return GNAT_FOPEN (path
, mode
);
872 __gnat_freopen (char *path
,
875 int encoding ATTRIBUTE_UNUSED
)
877 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
878 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
881 S2WS (wmode
, mode
, 10);
883 if (encoding
== Encoding_Unspecified
)
884 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
885 else if (encoding
== Encoding_UTF8
)
886 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
888 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
890 return _tfreopen (wpath
, wmode
, stream
);
892 return freopen (path
, mode
, stream
);
897 __gnat_open_read (char *path
, int fmode
)
900 int o_fmode
= O_BINARY
;
905 #if defined (__vxworks)
906 fd
= open (path
, O_RDONLY
| o_fmode
, 0444);
907 #elif defined (__MINGW32__)
909 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
911 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
912 fd
= _topen (wpath
, O_RDONLY
| o_fmode
, 0444);
915 fd
= GNAT_OPEN (path
, O_RDONLY
| o_fmode
);
918 return fd
< 0 ? -1 : fd
;
921 #if defined (__MINGW32__)
922 #define PERM (S_IREAD | S_IWRITE)
924 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
928 __gnat_open_rw (char *path
, int fmode
)
931 int o_fmode
= O_BINARY
;
936 #if defined (__MINGW32__)
938 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
940 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
941 fd
= _topen (wpath
, O_RDWR
| o_fmode
, PERM
);
944 fd
= GNAT_OPEN (path
, O_RDWR
| o_fmode
, PERM
);
947 return fd
< 0 ? -1 : fd
;
951 __gnat_open_create (char *path
, int fmode
)
954 int o_fmode
= O_BINARY
;
959 #if defined (__MINGW32__)
961 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
963 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
964 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
967 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
970 return fd
< 0 ? -1 : fd
;
974 __gnat_create_output_file (char *path
)
977 #if defined (__MINGW32__)
979 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
981 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
982 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
985 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
988 return fd
< 0 ? -1 : fd
;
992 __gnat_create_output_file_new (char *path
)
995 #if defined (__MINGW32__)
997 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
999 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1000 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
1003 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
1006 return fd
< 0 ? -1 : fd
;
1010 __gnat_open_append (char *path
, int fmode
)
1013 int o_fmode
= O_BINARY
;
1018 #if defined (__MINGW32__)
1020 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1022 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1023 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
1026 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
1029 return fd
< 0 ? -1 : fd
;
1032 /* Open a new file. Return error (-1) if the file already exists. */
1035 __gnat_open_new (char *path
, int fmode
)
1038 int o_fmode
= O_BINARY
;
1043 #if defined (__MINGW32__)
1045 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1047 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1048 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1051 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1054 return fd
< 0 ? -1 : fd
;
1057 /* Open a new temp file. Return error (-1) if the file already exists. */
1060 __gnat_open_new_temp (char *path
, int fmode
)
1063 int o_fmode
= O_BINARY
;
1065 strcpy (path
, "GNAT-XXXXXX");
1067 #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
1068 || defined (__linux__) || defined (__GLIBC__) || defined (__ANDROID__) \
1069 || defined (__DragonFly__) || defined (__QNX__)) && !defined (__vxworks)
1070 return mkstemp (path
);
1071 #elif defined (__Lynx__)
1074 if (mktemp (path
) == NULL
)
1081 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1082 return fd
< 0 ? -1 : fd
;
1086 __gnat_open (char *path
, int fmode
)
1090 #if defined (__MINGW32__)
1092 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1094 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1095 fd
= _topen (wpath
, fmode
, PERM
);
1098 fd
= GNAT_OPEN (path
, fmode
, PERM
);
1101 return fd
< 0 ? -1 : fd
;
1104 /****************************************************************
1105 ** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information
1106 ** as possible from it, storing the result in a cache for later reuse
1107 ****************************************************************/
1110 __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
)
1112 GNAT_STRUCT_STAT statbuf
;
1116 /* GNAT_FSTAT returns -1 and sets errno for failure */
1117 ret
= GNAT_FSTAT (fd
, &statbuf
);
1118 error
= ret
? errno
: 0;
1121 /* __gnat_stat returns errno value directly */
1122 error
= __gnat_stat (name
, &statbuf
);
1123 ret
= error
? -1 : 0;
1127 * A missing file is reported as an attr structure with error == 0 and
1131 if (error
== 0 || error
== ENOENT
)
1134 attr
->error
= error
;
1136 attr
->regular
= (!ret
&& S_ISREG (statbuf
.st_mode
));
1137 attr
->directory
= (!ret
&& S_ISDIR (statbuf
.st_mode
));
1140 attr
->file_length
= 0;
1142 /* st_size may be 32 bits, or 64 bits which is converted to long. We
1143 don't return a useful value for files larger than 2 gigabytes in
1145 attr
->file_length
= statbuf
.st_size
; /* all systems */
1147 attr
->exists
= !ret
;
1149 #if !defined (_WIN32)
1150 /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
1151 attr
->readable
= (!ret
&& (statbuf
.st_mode
& S_IRUSR
));
1152 attr
->writable
= (!ret
&& (statbuf
.st_mode
& S_IWUSR
));
1153 attr
->executable
= (!ret
&& (statbuf
.st_mode
& S_IXUSR
));
1157 attr
->timestamp
= (OS_Time
)-1;
1159 attr
->timestamp
= (OS_Time
)statbuf
.st_mtime
;
1163 /****************************************************************
1164 ** Return the number of bytes in the specified file
1165 ****************************************************************/
1168 __gnat_file_length_attr (int fd
, char* name
, struct file_attributes
* attr
)
1170 if (attr
->file_length
== -1) {
1171 __gnat_stat_to_attr (fd
, name
, attr
);
1174 return attr
->file_length
;
1178 __gnat_file_length (int fd
)
1180 struct file_attributes attr
;
1181 __gnat_reset_attributes (&attr
);
1182 return __gnat_file_length_attr (fd
, NULL
, &attr
);
1186 __gnat_file_length_long (int fd
)
1188 struct file_attributes attr
;
1189 __gnat_reset_attributes (&attr
);
1190 return (long)__gnat_file_length_attr (fd
, NULL
, &attr
);
1194 __gnat_named_file_length (char *name
)
1196 struct file_attributes attr
;
1197 __gnat_reset_attributes (&attr
);
1198 return __gnat_file_length_attr (-1, name
, &attr
);
1201 /* Create a temporary filename and put it in string pointed to by
1205 __gnat_tmp_name (char *tmp_filename
)
1207 #if defined (__MINGW32__)
1212 /* tempnam tries to create a temporary file in directory pointed to by
1213 TMP environment variable, in c:\temp if TMP is not set, and in
1214 directory specified by P_tmpdir in stdio.h if c:\temp does not
1215 exist. The filename will be created with the prefix "gnat-". */
1217 sprintf (prefix
, "gnat-%d-", (int)getpid());
1218 pname
= (char *) _tempnam ("c:\\temp", prefix
);
1220 /* if pname is NULL, the file was not created properly, the disk is full
1221 or there is no more free temporary files */
1224 *tmp_filename
= '\0';
1226 /* If pname start with a back slash and not path information it means that
1227 the filename is valid for the current working directory. */
1229 else if (pname
[0] == '\\')
1231 strcpy (tmp_filename
, ".\\");
1232 strcat (tmp_filename
, pname
+1);
1235 strcpy (tmp_filename
, pname
);
1240 #elif defined (__linux__) || defined (__FreeBSD__) || defined (__NetBSD__) \
1241 || defined (__OpenBSD__) || defined (__GLIBC__) || defined (__ANDROID__) \
1242 || defined (__DragonFly__) || defined (__QNX__)
1243 #define MAX_SAFE_PATH 1000
1244 char *tmpdir
= getenv ("TMPDIR");
1246 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1247 a buffer overflow. */
1248 if (tmpdir
== NULL
|| strlen (tmpdir
) > MAX_SAFE_PATH
)
1250 strcpy (tmp_filename
, "/cache/gnat-XXXXXX");
1252 strcpy (tmp_filename
, "/tmp/gnat-XXXXXX");
1255 sprintf (tmp_filename
, "%s/gnat-XXXXXX", tmpdir
);
1257 close (mkstemp(tmp_filename
));
1258 #elif defined (__vxworks) && !defined (VTHREADS)
1262 static ushort_t seed
= 0; /* used to generate unique name */
1264 /* Generate a unique name. */
1265 strcpy (tmp_filename
, "tmp");
1268 savepos
= pos
= tmp_filename
+ strlen (tmp_filename
) + index
;
1276 /* Fill up the name buffer from the last position. */
1278 for (t
= seed
; --index
>= 0; t
>>= 3)
1279 *--pos
= '0' + (t
& 07);
1281 /* Check to see if its unique, if not bump the seed and try again. */
1282 f
= fopen (tmp_filename
, "r");
1290 tmpnam (tmp_filename
);
1294 /* Open directory and returns a DIR pointer. */
1296 DIR* __gnat_opendir (char *name
)
1298 #if defined (__MINGW32__)
1299 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1301 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1302 return (DIR*)_topendir (wname
);
1305 return opendir (name
);
1309 /* Read the next entry in a directory. The returned string points somewhere
1312 #if defined (__sun__)
1313 /* For Solaris, be sure to use the 64-bit version, otherwise NFS reads may
1314 fail with EOVERFLOW if the server uses 64-bit cookies. */
1315 #define dirent dirent64
1316 #define readdir readdir64
1320 __gnat_readdir (DIR *dirp
, char *buffer
, int *len
)
1322 #if defined (__MINGW32__)
1323 struct _tdirent
*dirent
= _treaddir ((_TDIR
*)dirp
);
1327 WS2SC (buffer
, dirent
->d_name
, GNAT_MAX_PATH_LEN
);
1328 *len
= strlen (buffer
);
1335 #elif defined (HAVE_READDIR_R)
1336 /* If possible, try to use the thread-safe version. */
1337 if (readdir_r (dirp
, buffer
) != NULL
)
1339 *len
= strlen (((struct dirent
*) buffer
)->d_name
);
1340 return ((struct dirent
*) buffer
)->d_name
;
1346 struct dirent
*dirent
= (struct dirent
*) readdir (dirp
);
1350 strcpy (buffer
, dirent
->d_name
);
1351 *len
= strlen (buffer
);
1360 /* Close a directory entry. */
1362 int __gnat_closedir (DIR *dirp
)
1364 #if defined (__MINGW32__)
1365 return _tclosedir ((_TDIR
*)dirp
);
1368 return closedir (dirp
);
1372 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1375 __gnat_readdir_is_thread_safe (void)
1377 #ifdef HAVE_READDIR_R
1384 #if defined (_WIN32)
1385 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1386 static const unsigned long long w32_epoch_offset
= 11644473600ULL;
1388 /* Returns the file modification timestamp using Win32 routines which are
1389 immune against daylight saving time change. It is in fact not possible to
1390 use fstat for this purpose as the DST modify the st_mtime field of the
1394 win32_filetime (HANDLE h
)
1399 unsigned long long ull_time
;
1402 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1403 since <Jan 1st 1601>. This function must return the number of seconds
1404 since <Jan 1st 1970>. */
1406 if (GetFileTime (h
, NULL
, NULL
, &t_write
.ft_time
))
1407 return (time_t) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1411 /* As above but starting from a FILETIME. */
1413 f2t (const FILETIME
*ft
, __time64_t
*t
)
1418 unsigned long long ull_time
;
1421 t_write
.ft_time
= *ft
;
1422 *t
= (__time64_t
) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1426 /* Return a GNAT time stamp given a file name. */
1429 __gnat_file_time_name_attr (char* name
, struct file_attributes
* attr
)
1431 if (attr
->timestamp
== (OS_Time
)-2) {
1432 #if defined (_WIN32)
1434 WIN32_FILE_ATTRIBUTE_DATA fad
;
1435 __time64_t ret
= -1;
1436 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1437 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1439 if ((res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
)))
1440 f2t (&fad
.ftLastWriteTime
, &ret
);
1441 attr
->timestamp
= (OS_Time
) ret
;
1443 __gnat_stat_to_attr (-1, name
, attr
);
1446 return attr
->timestamp
;
1450 __gnat_file_time_name (char *name
)
1452 struct file_attributes attr
;
1453 __gnat_reset_attributes (&attr
);
1454 return __gnat_file_time_name_attr (name
, &attr
);
1457 /* Return a GNAT time stamp given a file descriptor. */
1460 __gnat_file_time_fd_attr (int fd
, struct file_attributes
* attr
)
1462 if (attr
->timestamp
== (OS_Time
)-2) {
1463 #if defined (_WIN32)
1464 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
1465 time_t ret
= win32_filetime (h
);
1466 attr
->timestamp
= (OS_Time
) ret
;
1469 __gnat_stat_to_attr (fd
, NULL
, attr
);
1473 return attr
->timestamp
;
1477 __gnat_file_time_fd (int fd
)
1479 struct file_attributes attr
;
1480 __gnat_reset_attributes (&attr
);
1481 return __gnat_file_time_fd_attr (fd
, &attr
);
1484 extern long long __gnat_file_time(char* name
)
1491 /* Number of seconds between <Jan 1st 1970> and <Jan 1st 2150>. */
1492 static const long long ada_epoch_offset
= (136 * 365 + 44 * 366) * 86400LL;
1495 /* Number of 100 nanoseconds between <Jan 1st 1601> and <Jan 1st 2150>. */
1496 static const long long w32_epoch_offset
=
1497 (11644473600LL + ada_epoch_offset
) * 1E7
;
1499 WIN32_FILE_ATTRIBUTE_DATA fad
;
1506 if (!GetFileAttributesExA(name
, GetFileExInfoStandard
, &fad
)) {
1510 t_write
.ft_time
= fad
.ftLastWriteTime
;
1512 #if defined(__GNUG__) && __GNUG__ <= 4
1513 result
= (t_write
.ll_time
- w32_epoch_offset
) * 100;
1515 /* Next code similar to (t_write.ll_time - w32_epoch_offset) * 100
1516 but on overflow returns LLONG_MIN value. */
1518 if (__builtin_ssubll_overflow(t_write
.ll_time
, w32_epoch_offset
, &result
)) {
1522 if (__builtin_smulll_overflow(result
, 100, &result
)) {
1530 if (stat(name
, &sb
) != 0) {
1534 #if defined(__GNUG__) && __GNUG__ <= 4
1535 result
= (sb
.st_mtime
- ada_epoch_offset
) * 1E9
;
1536 #if defined(st_mtime)
1537 result
+= sb
.st_mtim
.tv_nsec
;
1540 /* Next code similar to
1541 (sb.st_mtime - ada_epoch_offset) * 1E9 + sb.st_mtim.tv_nsec
1542 but on overflow returns LLONG_MIN value. */
1544 if (__builtin_ssubll_overflow(sb
.st_mtime
, ada_epoch_offset
, &result
)) {
1548 if (__builtin_smulll_overflow(result
, 1E9
, &result
)) {
1552 #if defined(st_mtime)
1553 if (__builtin_saddll_overflow(result
, sb
.st_mtim
.tv_nsec
, &result
)) {
1562 /* Set the file time stamp. */
1565 __gnat_set_file_time_name (char *name
, OS_Time time_stamp
)
1567 #if defined (__vxworks)
1569 /* Code to implement __gnat_set_file_time_name for these systems. */
1571 #elif defined (_WIN32)
1575 unsigned long long ull_time
;
1577 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1579 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1581 HANDLE h
= CreateFile
1582 (wname
, GENERIC_WRITE
, FILE_SHARE_WRITE
, NULL
,
1583 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
,
1585 if (h
== INVALID_HANDLE_VALUE
)
1587 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1588 t_write
.ull_time
= ((unsigned long long)time_stamp
+ w32_epoch_offset
);
1589 /* Convert to 100 nanosecond units */
1590 t_write
.ull_time
*= 10000000ULL;
1592 SetFileTime(h
, NULL
, NULL
, &t_write
.ft_time
);
1597 struct utimbuf utimbuf
;
1600 /* Set modification time to requested time. */
1601 utimbuf
.modtime
= (time_t) time_stamp
;
1603 /* Set access time to now in local time. */
1605 utimbuf
.actime
= mktime (localtime (&t
));
1607 utime (name
, &utimbuf
);
1611 /* Get the list of installed standard libraries from the
1612 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1616 __gnat_get_libraries_from_registry (void)
1618 char *result
= (char *) xmalloc (1);
1622 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
1625 DWORD name_size
, value_size
;
1632 /* First open the key. */
1633 res
= RegOpenKeyExA (HKEY_LOCAL_MACHINE
, "SOFTWARE", 0, KEY_READ
, ®_key
);
1635 if (res
== ERROR_SUCCESS
)
1636 res
= RegOpenKeyExA (reg_key
, "Ada Core Technologies", 0,
1637 KEY_READ
, ®_key
);
1639 if (res
== ERROR_SUCCESS
)
1640 res
= RegOpenKeyExA (reg_key
, "GNAT", 0, KEY_READ
, ®_key
);
1642 if (res
== ERROR_SUCCESS
)
1643 res
= RegOpenKeyExA (reg_key
, "Standard Libraries", 0, KEY_READ
, ®_key
);
1645 /* If the key exists, read out all the values in it and concatenate them
1647 for (index
= 0; res
== ERROR_SUCCESS
; index
++)
1649 value_size
= name_size
= 256;
1650 res
= RegEnumValueA (reg_key
, index
, name
, &name_size
, 0,
1651 &type
, (LPBYTE
)value
, &value_size
);
1653 if (res
== ERROR_SUCCESS
&& type
== REG_SZ
)
1655 char *old_result
= result
;
1657 result
= (char *) xmalloc (strlen (old_result
) + value_size
+ 2);
1658 strcpy (result
, old_result
);
1659 strcat (result
, value
);
1660 strcat (result
, ";");
1665 /* Remove the trailing ";". */
1667 result
[strlen (result
) - 1] = 0;
1673 /* Query information for the given file NAME and return it in STATBUF.
1674 * Returns 0 for success, or errno value for failure.
1677 __gnat_stat (char *name
, GNAT_STRUCT_STAT
*statbuf
)
1680 WIN32_FILE_ATTRIBUTE_DATA fad
;
1681 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1686 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1687 name_len
= _tcslen (wname
);
1689 if (name_len
> GNAT_MAX_PATH_LEN
)
1692 ZeroMemory (statbuf
, sizeof(GNAT_STRUCT_STAT
));
1694 res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
);
1697 error
= GetLastError();
1699 /* Check file existence using GetFileAttributes() which does not fail on
1700 special Windows files like con:, aux:, nul: etc... */
1702 if (GetFileAttributes(wname
) != INVALID_FILE_ATTRIBUTES
) {
1703 /* Just pretend that it is a regular and readable file */
1704 statbuf
->st_mode
= S_IFREG
| S_IREAD
| S_IWRITE
;
1709 case ERROR_ACCESS_DENIED
:
1710 case ERROR_SHARING_VIOLATION
:
1711 case ERROR_LOCK_VIOLATION
:
1712 case ERROR_SHARING_BUFFER_EXCEEDED
:
1714 case ERROR_BUFFER_OVERFLOW
:
1715 return ENAMETOOLONG
;
1716 case ERROR_NOT_ENOUGH_MEMORY
:
1723 f2t (&fad
.ftCreationTime
, &statbuf
->st_ctime
);
1724 f2t (&fad
.ftLastWriteTime
, &statbuf
->st_mtime
);
1725 f2t (&fad
.ftLastAccessTime
, &statbuf
->st_atime
);
1728 (__int64
)fad
.nFileSizeLow
| (__int64
)fad
.nFileSizeHigh
<< 32;
1730 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1731 statbuf
->st_mode
= S_IREAD
;
1733 if (fad
.dwFileAttributes
& FILE_ATTRIBUTE_DIRECTORY
)
1734 statbuf
->st_mode
|= S_IFDIR
;
1736 statbuf
->st_mode
|= S_IFREG
;
1738 if (!(fad
.dwFileAttributes
& FILE_ATTRIBUTE_READONLY
))
1739 statbuf
->st_mode
|= S_IWRITE
;
1744 return GNAT_STAT (name
, statbuf
) == 0 ? 0 : errno
;
1748 /*************************************************************************
1749 ** Check whether a file exists
1750 *************************************************************************/
1753 __gnat_file_exists_attr (char* name
, struct file_attributes
* attr
)
1755 if (attr
->exists
== ATTR_UNSET
)
1756 __gnat_stat_to_attr (-1, name
, attr
);
1758 return attr
->exists
;
1762 __gnat_file_exists (char *name
)
1764 struct file_attributes attr
;
1765 __gnat_reset_attributes (&attr
);
1766 return __gnat_file_exists_attr (name
, &attr
);
1769 /**********************************************************************
1770 ** Whether name is an absolute path
1771 **********************************************************************/
1774 __gnat_is_absolute_path (char *name
, int length
)
1777 /* On VxWorks systems, an absolute path can be represented (depending on
1778 the host platform) as either /dir/file, or device:/dir/file, or
1779 device:drive_letter:/dir/file. */
1786 for (index
= 0; index
< length
; index
++)
1788 if (name
[index
] == ':' &&
1789 ((name
[index
+ 1] == '/') ||
1790 (isalpha (name
[index
+ 1]) && index
+ 2 <= length
&&
1791 name
[index
+ 2] == '/')))
1794 else if (name
[index
] == '/')
1799 return (length
!= 0) &&
1800 (IS_DIRECTORY_SEPARATOR(*name
)
1801 #if defined (WINNT) || defined(__DJGPP__)
1802 || (length
> 2 && ISALPHA (name
[0]) && name
[1] == ':'
1803 && IS_DIRECTORY_SEPARATOR(name
[2]))
1810 __gnat_is_regular_file_attr (char* name
, struct file_attributes
* attr
)
1812 if (attr
->regular
== ATTR_UNSET
)
1813 __gnat_stat_to_attr (-1, name
, attr
);
1815 return attr
->regular
;
1819 __gnat_is_regular_file (char *name
)
1821 struct file_attributes attr
;
1823 __gnat_reset_attributes (&attr
);
1824 return __gnat_is_regular_file_attr (name
, &attr
);
1828 __gnat_is_regular_file_fd (int fd
)
1831 GNAT_STRUCT_STAT statbuf
;
1833 ret
= GNAT_FSTAT (fd
, &statbuf
);
1834 return (!ret
&& S_ISREG (statbuf
.st_mode
));
1838 __gnat_is_directory_attr (char* name
, struct file_attributes
* attr
)
1840 if (attr
->directory
== ATTR_UNSET
)
1841 __gnat_stat_to_attr (-1, name
, attr
);
1843 return attr
->directory
;
1847 __gnat_is_directory (char *name
)
1849 struct file_attributes attr
;
1851 __gnat_reset_attributes (&attr
);
1852 return __gnat_is_directory_attr (name
, &attr
);
1855 #if defined (_WIN32)
1857 /* Returns the same constant as GetDriveType but takes a pathname as
1861 GetDriveTypeFromPath (TCHAR
*wfullpath
)
1863 TCHAR wdrv
[MAX_PATH
];
1864 TCHAR wpath
[MAX_PATH
];
1865 TCHAR wfilename
[MAX_PATH
];
1866 TCHAR wext
[MAX_PATH
];
1868 _tsplitpath (wfullpath
, wdrv
, wpath
, wfilename
, wext
);
1870 if (_tcslen (wdrv
) != 0)
1872 /* we have a drive specified. */
1873 _tcscat (wdrv
, _T("\\"));
1874 return GetDriveType (wdrv
);
1878 /* No drive specified. */
1880 /* Is this a relative path, if so get current drive type. */
1881 if (wpath
[0] != _T('\\') ||
1882 (_tcslen (wpath
) > 2 && wpath
[0] == _T('\\')
1883 && wpath
[1] != _T('\\')))
1884 return GetDriveType (NULL
);
1886 UINT result
= GetDriveType (wpath
);
1888 /* Cannot guess the drive type, is this \\.\ ? */
1890 if (result
== DRIVE_NO_ROOT_DIR
&&
1891 _tcslen (wpath
) >= 4 && wpath
[0] == _T('\\') && wpath
[1] == _T('\\')
1892 && wpath
[2] == _T('.') && wpath
[3] == _T('\\'))
1894 if (_tcslen (wpath
) == 4)
1895 _tcscat (wpath
, wfilename
);
1897 LPTSTR p
= &wpath
[4];
1898 LPTSTR b
= _tcschr (p
, _T('\\'));
1902 /* logical drive \\.\c\dir\file */
1908 _tcscat (p
, _T(":\\"));
1910 return GetDriveType (p
);
1917 /* This MingW section contains code to work with ACL. */
1919 __gnat_check_OWNER_ACL (TCHAR
*wname
,
1920 DWORD CheckAccessDesired
,
1921 GENERIC_MAPPING CheckGenericMapping
)
1923 DWORD dwAccessDesired
, dwAccessAllowed
;
1924 PRIVILEGE_SET PrivilegeSet
;
1925 DWORD dwPrivSetSize
= sizeof (PRIVILEGE_SET
);
1926 BOOL fAccessGranted
= FALSE
;
1927 HANDLE hToken
= NULL
;
1929 PSECURITY_DESCRIPTOR pSD
= NULL
;
1932 (wname
, OWNER_SECURITY_INFORMATION
|
1933 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1936 if ((pSD
= (SECURITY_DESCRIPTOR
*) HeapAlloc
1937 (GetProcessHeap (), HEAP_ZERO_MEMORY
, nLength
)) == NULL
)
1940 /* Obtain the security descriptor. */
1942 if (!GetFileSecurity
1943 (wname
, OWNER_SECURITY_INFORMATION
|
1944 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1945 pSD
, nLength
, &nLength
))
1948 if (!ImpersonateSelf (SecurityImpersonation
))
1951 if (!OpenThreadToken
1952 (GetCurrentThread(), TOKEN_DUPLICATE
| TOKEN_QUERY
, FALSE
, &hToken
))
1955 /* Undoes the effect of ImpersonateSelf. */
1959 /* We want to test for write permissions. */
1961 dwAccessDesired
= CheckAccessDesired
;
1963 MapGenericMask (&dwAccessDesired
, &CheckGenericMapping
);
1966 (pSD
, /* security descriptor to check */
1967 hToken
, /* impersonation token */
1968 dwAccessDesired
, /* requested access rights */
1969 &CheckGenericMapping
, /* pointer to GENERIC_MAPPING */
1970 &PrivilegeSet
, /* receives privileges used in check */
1971 &dwPrivSetSize
, /* size of PrivilegeSet buffer */
1972 &dwAccessAllowed
, /* receives mask of allowed access rights */
1976 CloseHandle (hToken
);
1977 HeapFree (GetProcessHeap (), 0, pSD
);
1978 return fAccessGranted
;
1982 CloseHandle (hToken
);
1983 HeapFree (GetProcessHeap (), 0, pSD
);
1988 __gnat_set_OWNER_ACL (TCHAR
*wname
,
1989 ACCESS_MODE AccessMode
,
1990 DWORD AccessPermissions
)
1992 PACL pOldDACL
= NULL
;
1993 PACL pNewDACL
= NULL
;
1994 PSECURITY_DESCRIPTOR pSD
= NULL
;
1996 TCHAR username
[100];
1999 /* Get current user, he will act as the owner */
2001 if (!GetUserName (username
, &unsize
))
2004 if (GetNamedSecurityInfo
2007 DACL_SECURITY_INFORMATION
,
2008 NULL
, NULL
, &pOldDACL
, NULL
, &pSD
) != ERROR_SUCCESS
)
2011 BuildExplicitAccessWithName
2012 (&ea
, username
, AccessPermissions
, (ACCESS_MODE
) AccessMode
, NO_INHERITANCE
);
2014 if (AccessMode
== SET_ACCESS
)
2016 /* SET_ACCESS, we want to set an explicte set of permissions, do not
2017 merge with current DACL. */
2018 if (SetEntriesInAcl (1, &ea
, NULL
, &pNewDACL
) != ERROR_SUCCESS
)
2022 if (SetEntriesInAcl (1, &ea
, pOldDACL
, &pNewDACL
) != ERROR_SUCCESS
)
2025 if (SetNamedSecurityInfo
2026 (wname
, SE_FILE_OBJECT
,
2027 DACL_SECURITY_INFORMATION
, NULL
, NULL
, pNewDACL
, NULL
) != ERROR_SUCCESS
)
2031 LocalFree (pNewDACL
);
2034 /* Check if it is possible to use ACL for wname, the file must not be on a
2038 __gnat_can_use_acl (TCHAR
*wname
)
2040 return __gnat_use_acl
&& GetDriveTypeFromPath (wname
) != DRIVE_REMOTE
;
2043 #endif /* defined (_WIN32) */
2046 __gnat_is_readable_file_attr (char* name
, struct file_attributes
* attr
)
2048 if (attr
->readable
== ATTR_UNSET
)
2050 #if defined (_WIN32)
2051 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2052 GENERIC_MAPPING GenericMapping
;
2054 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2056 if (__gnat_can_use_acl (wname
))
2058 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
2059 GenericMapping
.GenericRead
= GENERIC_READ
;
2061 __gnat_check_OWNER_ACL (wname
, FILE_READ_DATA
, GenericMapping
);
2064 attr
->readable
= GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
;
2066 __gnat_stat_to_attr (-1, name
, attr
);
2070 return attr
->readable
;
2074 __gnat_is_read_accessible_file (char *name
)
2076 #if defined (_WIN32)
2077 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2079 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2081 return !_waccess (wname
, 4);
2083 #elif defined (__vxworks)
2086 if ((fd
= open (name
, O_RDONLY
, 0)) < 0)
2092 return !access (name
, R_OK
);
2097 __gnat_is_readable_file (char *name
)
2099 struct file_attributes attr
;
2101 __gnat_reset_attributes (&attr
);
2102 return __gnat_is_readable_file_attr (name
, &attr
);
2106 __gnat_is_writable_file_attr (char* name
, struct file_attributes
* attr
)
2108 if (attr
->writable
== ATTR_UNSET
)
2110 #if defined (_WIN32)
2111 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2112 GENERIC_MAPPING GenericMapping
;
2114 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2116 if (__gnat_can_use_acl (wname
))
2118 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
2119 GenericMapping
.GenericWrite
= GENERIC_WRITE
;
2121 attr
->writable
= __gnat_check_OWNER_ACL
2122 (wname
, FILE_WRITE_DATA
| FILE_APPEND_DATA
, GenericMapping
)
2123 && !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
2127 !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
2130 __gnat_stat_to_attr (-1, name
, attr
);
2134 return attr
->writable
;
2138 __gnat_is_writable_file (char *name
)
2140 struct file_attributes attr
;
2142 __gnat_reset_attributes (&attr
);
2143 return __gnat_is_writable_file_attr (name
, &attr
);
2147 __gnat_is_write_accessible_file (char *name
)
2149 #if defined (_WIN32)
2150 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2152 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2154 return !_waccess (wname
, 2);
2156 #elif defined (__vxworks)
2159 if ((fd
= open (name
, O_WRONLY
, 0)) < 0)
2165 return !access (name
, W_OK
);
2170 __gnat_is_executable_file_attr (char* name
, struct file_attributes
* attr
)
2172 if (attr
->executable
== ATTR_UNSET
)
2174 #if defined (_WIN32)
2175 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2176 GENERIC_MAPPING GenericMapping
;
2178 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2180 if (__gnat_can_use_acl (wname
))
2182 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
2183 GenericMapping
.GenericExecute
= GENERIC_EXECUTE
;
2186 __gnat_check_OWNER_ACL (wname
, FILE_EXECUTE
, GenericMapping
);
2190 TCHAR
*l
, *last
= _tcsstr(wname
, _T(".exe"));
2192 /* look for last .exe */
2194 while ((l
= _tcsstr(last
+1, _T(".exe"))))
2198 GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
2199 && (last
- wname
) == (int) (_tcslen (wname
) - 4);
2202 __gnat_stat_to_attr (-1, name
, attr
);
2206 return attr
->regular
&& attr
->executable
;
2210 __gnat_is_executable_file (char *name
)
2212 struct file_attributes attr
;
2214 __gnat_reset_attributes (&attr
);
2215 return __gnat_is_executable_file_attr (name
, &attr
);
2219 __gnat_set_writable (char *name
)
2221 #if defined (_WIN32)
2222 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2224 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2226 if (__gnat_can_use_acl (wname
))
2227 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_WRITE
);
2230 (wname
, GetFileAttributes (wname
) & ~FILE_ATTRIBUTE_READONLY
);
2231 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2232 GNAT_STRUCT_STAT statbuf
;
2234 if (GNAT_STAT (name
, &statbuf
) == 0)
2236 statbuf
.st_mode
= statbuf
.st_mode
| S_IWUSR
;
2237 chmod (name
, statbuf
.st_mode
);
2242 /* must match definition in s-os_lib.ads */
2248 __gnat_set_executable (char *name
, int mode ATTRIBUTE_UNUSED
)
2250 #if defined (_WIN32)
2251 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2253 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2255 if (__gnat_can_use_acl (wname
))
2256 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_EXECUTE
);
2258 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2259 GNAT_STRUCT_STAT statbuf
;
2261 if (GNAT_STAT (name
, &statbuf
) == 0)
2264 statbuf
.st_mode
= statbuf
.st_mode
| S_IXUSR
;
2266 statbuf
.st_mode
= statbuf
.st_mode
| S_IXGRP
;
2267 if (mode
& S_OTHERS
)
2268 statbuf
.st_mode
= statbuf
.st_mode
| S_IXOTH
;
2269 chmod (name
, statbuf
.st_mode
);
2275 __gnat_set_non_writable (char *name
)
2277 #if defined (_WIN32)
2278 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2280 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2282 if (__gnat_can_use_acl (wname
))
2283 __gnat_set_OWNER_ACL
2284 (wname
, DENY_ACCESS
,
2285 FILE_WRITE_DATA
| FILE_APPEND_DATA
|
2286 FILE_WRITE_EA
| FILE_WRITE_ATTRIBUTES
);
2289 (wname
, GetFileAttributes (wname
) | FILE_ATTRIBUTE_READONLY
);
2290 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2291 GNAT_STRUCT_STAT statbuf
;
2293 if (GNAT_STAT (name
, &statbuf
) == 0)
2295 statbuf
.st_mode
= statbuf
.st_mode
& 07577;
2296 chmod (name
, statbuf
.st_mode
);
2302 __gnat_set_readable (char *name
)
2304 #if defined (_WIN32)
2305 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2307 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2309 if (__gnat_can_use_acl (wname
))
2310 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_READ
);
2312 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2313 GNAT_STRUCT_STAT statbuf
;
2315 if (GNAT_STAT (name
, &statbuf
) == 0)
2317 chmod (name
, statbuf
.st_mode
| S_IREAD
);
2323 __gnat_set_non_readable (char *name
)
2325 #if defined (_WIN32)
2326 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2328 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2330 if (__gnat_can_use_acl (wname
))
2331 __gnat_set_OWNER_ACL (wname
, DENY_ACCESS
, FILE_GENERIC_READ
);
2333 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2334 GNAT_STRUCT_STAT statbuf
;
2336 if (GNAT_STAT (name
, &statbuf
) == 0)
2338 chmod (name
, statbuf
.st_mode
& (~S_IREAD
));
2344 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED
,
2345 struct file_attributes
* attr
)
2347 if (attr
->symbolic_link
== ATTR_UNSET
)
2349 #if defined (__vxworks)
2350 attr
->symbolic_link
= 0;
2352 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2354 GNAT_STRUCT_STAT statbuf
;
2355 ret
= GNAT_LSTAT (name
, &statbuf
);
2356 attr
->symbolic_link
= (!ret
&& S_ISLNK (statbuf
.st_mode
));
2358 attr
->symbolic_link
= 0;
2361 return attr
->symbolic_link
;
2365 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED
)
2367 struct file_attributes attr
;
2369 __gnat_reset_attributes (&attr
);
2370 return __gnat_is_symbolic_link_attr (name
, &attr
);
2373 #if defined (__sun__)
2374 /* Using fork on Solaris will duplicate all the threads. fork1, which
2375 duplicates only the active thread, must be used instead, or spawning
2376 subprocess from a program with tasking will lead into numerous problems. */
2381 __gnat_portable_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2383 int status ATTRIBUTE_UNUSED
= 0;
2384 int finished ATTRIBUTE_UNUSED
;
2385 int pid ATTRIBUTE_UNUSED
;
2387 #if defined (__vxworks) || defined(__PikeOS__)
2390 #elif defined (__DJGPP__) || defined (_WIN32)
2391 /* args[0] must be quotes as it could contain a full pathname with spaces */
2392 char *args_0
= args
[0];
2393 args
[0] = (char *)xmalloc (strlen (args_0
) + 3);
2394 strcpy (args
[0], "\"");
2395 strcat (args
[0], args_0
);
2396 strcat (args
[0], "\"");
2398 status
= spawnvp (P_WAIT
, args_0
, (char ** const)args
);
2400 /* restore previous value */
2402 args
[0] = (char *)args_0
;
2418 execv (args
[0], MAYBE_TO_PTR32 (args
));
2420 /* execv() returns only on error */
2425 finished
= waitpid (pid
, &status
, 0);
2427 if (finished
!= pid
|| WIFEXITED (status
) == 0)
2430 return WEXITSTATUS (status
);
2436 /* Create a copy of the given file descriptor.
2437 Return -1 if an error occurred. */
2440 __gnat_dup (int oldfd
)
2442 #if defined (__vxworks) && !defined (__RTP__)
2443 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2451 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2452 Return -1 if an error occurred. */
2455 __gnat_dup2 (int oldfd ATTRIBUTE_UNUSED
, int newfd ATTRIBUTE_UNUSED
)
2457 #if defined (__vxworks) && !defined (__RTP__)
2458 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2461 #elif defined (__PikeOS__)
2462 /* Not supported. */
2464 #elif defined (_WIN32)
2465 /* Special case when oldfd and newfd are identical and are the standard
2466 input, output or error as this makes Windows XP hangs. Note that we
2467 do that only for standard file descriptors that are known to be valid. */
2468 if (oldfd
== newfd
&& newfd
>= 0 && newfd
<= 2)
2471 return dup2 (oldfd
, newfd
);
2473 return dup2 (oldfd
, newfd
);
2478 __gnat_number_of_cpus (void)
2482 #if defined (_SC_NPROCESSORS_ONLN)
2483 cores
= (int) sysconf (_SC_NPROCESSORS_ONLN
);
2485 #elif defined (__QNX__)
2486 cores
= (int) _syspage_ptr
->num_cpu
;
2488 #elif defined (__hpux__)
2489 struct pst_dynamic psd
;
2490 if (pstat_getdynamic (&psd
, sizeof (psd
), 1, 0) != -1)
2491 cores
= (int) psd
.psd_proc_cnt
;
2493 #elif defined (_WIN32)
2494 SYSTEM_INFO sysinfo
;
2495 GetSystemInfo (&sysinfo
);
2496 cores
= (int) sysinfo
.dwNumberOfProcessors
;
2498 #elif defined (_WRS_CONFIG_SMP)
2499 unsigned int vxCpuConfiguredGet (void);
2501 cores
= vxCpuConfiguredGet ();
2508 /* WIN32 code to implement a wait call that wait for any child process. */
2510 #if defined (_WIN32)
2512 /* Synchronization code, to be thread safe. */
2516 /* For the Cert run times on native Windows we use dummy functions
2517 for locking and unlocking tasks since we do not support multiple
2518 threads on this configuration (Cert run time on native Windows). */
2520 static void EnterCS (void) {}
2521 static void LeaveCS (void) {}
2522 static void SignalListChanged (void) {}
2526 CRITICAL_SECTION ProcListCS
;
2527 HANDLE ProcListEvt
= NULL
;
2529 static void EnterCS (void)
2531 EnterCriticalSection(&ProcListCS
);
2534 static void LeaveCS (void)
2536 LeaveCriticalSection(&ProcListCS
);
2539 static void SignalListChanged (void)
2541 SetEvent (ProcListEvt
);
2546 static HANDLE
*HANDLES_LIST
= NULL
;
2547 static int *PID_LIST
= NULL
, plist_length
= 0, plist_max_length
= 0;
2550 add_handle (HANDLE h
, int pid
)
2552 /* -------------------- critical section -------------------- */
2555 if (plist_length
== plist_max_length
)
2557 plist_max_length
+= 100;
2559 (HANDLE
*) xrealloc (HANDLES_LIST
, sizeof (HANDLE
) * plist_max_length
);
2561 (int *) xrealloc (PID_LIST
, sizeof (int) * plist_max_length
);
2564 HANDLES_LIST
[plist_length
] = h
;
2565 PID_LIST
[plist_length
] = pid
;
2568 SignalListChanged();
2570 /* -------------------- critical section -------------------- */
2574 __gnat_win32_remove_handle (HANDLE h
, int pid
)
2579 /* -------------------- critical section -------------------- */
2582 for (j
= 0; j
< plist_length
; j
++)
2584 if ((HANDLES_LIST
[j
] == h
) || (PID_LIST
[j
] == pid
))
2588 HANDLES_LIST
[j
] = HANDLES_LIST
[plist_length
];
2589 PID_LIST
[j
] = PID_LIST
[plist_length
];
2596 /* -------------------- critical section -------------------- */
2599 SignalListChanged();
2605 win32_no_block_spawn (char *command
, char *args
[], HANDLE
*h
, int *pid
)
2609 PROCESS_INFORMATION PI
;
2610 SECURITY_ATTRIBUTES SA
;
2615 /* compute the total command line length */
2619 csize
+= strlen (args
[k
]) + 1;
2623 full_command
= (char *) xmalloc (csize
);
2626 SI
.cb
= sizeof (STARTUPINFO
);
2627 SI
.lpReserved
= NULL
;
2628 SI
.lpReserved2
= NULL
;
2629 SI
.lpDesktop
= NULL
;
2633 SI
.wShowWindow
= SW_HIDE
;
2635 /* Security attributes. */
2636 SA
.nLength
= sizeof (SECURITY_ATTRIBUTES
);
2637 SA
.bInheritHandle
= TRUE
;
2638 SA
.lpSecurityDescriptor
= NULL
;
2640 /* Prepare the command string. */
2641 strcpy (full_command
, command
);
2642 strcat (full_command
, " ");
2647 strcat (full_command
, args
[k
]);
2648 strcat (full_command
, " ");
2653 int wsize
= csize
* 2;
2654 TCHAR
*wcommand
= (TCHAR
*) xmalloc (wsize
);
2656 S2WSC (wcommand
, full_command
, wsize
);
2658 free (full_command
);
2660 result
= CreateProcess
2661 (NULL
, wcommand
, &SA
, NULL
, TRUE
,
2662 GetPriorityClass (GetCurrentProcess()), NULL
, NULL
, &SI
, &PI
);
2669 CloseHandle (PI
.hThread
);
2671 *pid
= PI
.dwProcessId
;
2681 win32_wait (int *status
)
2683 DWORD exitcode
, pid
;
2694 if (plist_length
== 0)
2700 /* -------------------- critical section -------------------- */
2703 /* ??? We can't wait for more than MAXIMUM_WAIT_OBJECTS due to a Win32
2705 if (plist_length
< MAXIMUM_WAIT_OBJECTS
)
2706 hl_len
= plist_length
;
2714 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * hl_len
);
2715 memmove (hl
, HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2716 pidl
= (int *) xmalloc (sizeof (int) * hl_len
);
2717 memmove (pidl
, PID_LIST
, sizeof (int) * hl_len
);
2719 /* Note that index 0 contains the event handle that is signaled when the
2720 process list has changed */
2721 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * (hl_len
+ 1));
2722 hl
[0] = ProcListEvt
;
2723 memmove (&hl
[1], HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2724 pidl
= (int *) xmalloc (sizeof (int) * (hl_len
+ 1));
2725 memmove (&pidl
[1], PID_LIST
, sizeof (int) * hl_len
);
2730 /* -------------------- critical section -------------------- */
2732 res
= WaitForMultipleObjects (hl_len
, hl
, FALSE
, INFINITE
);
2734 /* If there was an error, exit now */
2735 if (res
== WAIT_FAILED
)
2743 /* if the ProcListEvt has been signaled then the list of processes has been
2744 updated to add or remove a handle, just loop over */
2746 if (res
- WAIT_OBJECT_0
== 0)
2753 /* Handle two distinct groups of return codes: finished waits and abandoned
2756 if (res
< WAIT_ABANDONED_0
)
2757 pos
= res
- WAIT_OBJECT_0
;
2759 pos
= res
- WAIT_ABANDONED_0
;
2762 GetExitCodeProcess (h
, &exitcode
);
2765 found
= __gnat_win32_remove_handle (h
, -1);
2770 /* if not found another process waiting has already handled this process */
2777 *status
= (int) exitcode
;
2784 __gnat_portable_no_block_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2787 #if defined (__vxworks) || defined (__PikeOS__)
2788 /* Not supported. */
2791 #elif defined(__DJGPP__)
2792 if (spawnvp (P_WAIT
, args
[0], args
) != 0)
2797 #elif defined (_WIN32)
2802 win32_no_block_spawn (args
[0], args
, &h
, &pid
);
2805 add_handle (h
, pid
);
2818 execv (args
[0], MAYBE_TO_PTR32 (args
));
2820 /* execv() returns only on error */
2830 __gnat_portable_wait (int *process_status
)
2835 #if defined (__vxworks) || defined (__PikeOS__)
2836 /* Not sure what to do here, so do nothing but return zero. */
2838 #elif defined (_WIN32)
2840 pid
= win32_wait (&status
);
2842 #elif defined (__DJGPP__)
2843 /* Child process has already ended in case of DJGPP.
2844 No need to do anything. Just return success. */
2847 pid
= waitpid (-1, &status
, 0);
2848 status
= status
& 0xffff;
2851 *process_status
= status
;
2856 __gnat_portable_no_block_wait (int *process_status
)
2861 #if defined (__vxworks) || defined (__PikeOS__) || defined (_WIN32)
2862 /* Not supported. */
2867 pid
= waitpid (-1, &status
, WNOHANG
);
2868 status
= status
& 0xffff;
2871 *process_status
= status
;
2876 __gnat_os_exit (int status
)
2882 __gnat_current_process_id (void)
2884 #if defined (__vxworks) || defined (__PikeOS__)
2887 #elif defined (_WIN32)
2889 return (int)GetCurrentProcessId();
2893 return (int)getpid();
2897 /* Locate file on path, that matches a predicate */
2900 __gnat_locate_file_with_predicate (char *file_name
, char *path_val
,
2901 int (*predicate
)(char *))
2904 char *file_path
= (char *) alloca (strlen (file_name
) + 1);
2907 /* Return immediately if file_name is empty */
2909 if (*file_name
== '\0')
2912 /* Remove quotes around file_name if present */
2918 strcpy (file_path
, ptr
);
2920 ptr
= file_path
+ strlen (file_path
) - 1;
2925 /* Handle absolute pathnames. */
2927 absolute
= __gnat_is_absolute_path (file_path
, strlen (file_name
));
2931 if (predicate (file_path
))
2932 return xstrdup (file_path
);
2937 /* If file_name include directory separator(s), try it first as
2938 a path name relative to the current directory */
2939 for (ptr
= file_name
; *ptr
&& !IS_DIRECTORY_SEPARATOR(*ptr
); ptr
++)
2944 if (predicate (file_name
))
2945 return xstrdup (file_name
);
2952 /* The result has to be smaller than path_val + file_name. */
2954 (char *) alloca (strlen (path_val
) + strlen (file_name
) + 2);
2958 /* Skip the starting quote */
2960 if (*path_val
== '"')
2963 for (ptr
= file_path
; *path_val
&& *path_val
!= PATH_SEPARATOR
; )
2964 *ptr
++ = *path_val
++;
2966 /* If directory is empty, it is the current directory*/
2968 if (ptr
== file_path
)
2975 /* Skip the ending quote */
2980 if (!IS_DIRECTORY_SEPARATOR(*ptr
))
2981 *++ptr
= DIR_SEPARATOR
;
2983 strcpy (++ptr
, file_name
);
2985 if (predicate (file_path
))
2986 return xstrdup (file_path
);
2991 /* Skip path separator */
3000 /* Locate an executable file, give a Path value. */
3003 __gnat_locate_executable_file (char *file_name
, char *path_val
)
3005 return __gnat_locate_file_with_predicate
3006 (file_name
, path_val
, &__gnat_is_executable_file
);
3009 /* Locate a regular file, give a Path value. */
3012 __gnat_locate_regular_file (char *file_name
, char *path_val
)
3014 return __gnat_locate_file_with_predicate
3015 (file_name
, path_val
, &__gnat_is_regular_file
);
3018 /* Locate an executable given a Path argument. This routine is only used by
3019 gnatbl and should not be used otherwise. Use locate_exec_on_path
3023 __gnat_locate_exec (char *exec_name
, char *path_val
)
3025 const unsigned int len
= strlen (HOST_EXECUTABLE_SUFFIX
);
3028 if (len
> 0 && !strstr (exec_name
, HOST_EXECUTABLE_SUFFIX
))
3030 char *full_exec_name
= (char *) alloca (strlen (exec_name
) + len
+ 1);
3032 strcpy (full_exec_name
, exec_name
);
3033 strcat (full_exec_name
, HOST_EXECUTABLE_SUFFIX
);
3034 ptr
= __gnat_locate_executable_file (full_exec_name
, path_val
);
3037 return __gnat_locate_executable_file (exec_name
, path_val
);
3041 return __gnat_locate_executable_file (exec_name
, path_val
);
3044 /* Locate an executable using the Systems default PATH. */
3047 __gnat_locate_exec_on_path (char *exec_name
)
3051 #if defined (_WIN32)
3052 TCHAR
*wpath_val
= _tgetenv (_T("PATH"));
3054 /* In Win32 systems we expand the PATH as for XP environment
3055 variables are not automatically expanded. We also prepend the
3056 ".;" to the path to match normal NT path search semantics */
3058 #define EXPAND_BUFFER_SIZE 32767
3060 wapath_val
= (TCHAR
*) alloca (EXPAND_BUFFER_SIZE
);
3062 wapath_val
[0] = '.';
3063 wapath_val
[1] = ';';
3065 DWORD res
= ExpandEnvironmentStrings
3066 (wpath_val
, &wapath_val
[2], EXPAND_BUFFER_SIZE
- 2);
3068 if (!res
) wapath_val
[0] = _T('\0');
3070 apath_val
= (char *) alloca (EXPAND_BUFFER_SIZE
);
3072 WS2SC (apath_val
, wapath_val
, EXPAND_BUFFER_SIZE
);
3075 const char *path_val
= getenv ("PATH");
3077 /* If PATH is not defined, proceed with __gnat_locate_exec anyway, so we can
3078 find files that contain directory names. */
3080 if (path_val
== NULL
) path_val
= "";
3081 apath_val
= (char *) alloca (strlen (path_val
) + 1);
3082 strcpy (apath_val
, path_val
);
3085 return __gnat_locate_exec (exec_name
, apath_val
);
3088 /* Dummy functions for Osint import for non-VMS systems.
3089 ??? To be removed. */
3092 __gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED
,
3093 int onlydirs ATTRIBUTE_UNUSED
)
3099 __gnat_to_canonical_file_list_next (void)
3101 static char empty
[] = "";
3106 __gnat_to_canonical_file_list_free (void)
3111 __gnat_to_canonical_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
3117 __gnat_to_canonical_file_spec (char *filespec
)
3123 __gnat_to_canonical_path_spec (char *pathspec
)
3129 __gnat_to_host_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
3135 __gnat_to_host_file_spec (char *filespec
)
3141 __gnat_adjust_os_resource_limits (void)
3145 #if defined (__mips_vxworks)
3149 CACHE_USER_FLUSH (0, ENTIRE_CACHE
);
3153 #if defined (_WIN32)
3154 int __gnat_argument_needs_quote
= 1;
3156 int __gnat_argument_needs_quote
= 0;
3159 /* This option is used to enable/disable object files handling from the
3160 binder file by the GNAT Project module. For example, this is disabled on
3161 Windows (prior to GCC 3.4) as it is already done by the mdll module.
3162 Stating with GCC 3.4 the shared libraries are not based on mdll
3163 anymore as it uses the GCC's -shared option */
3164 #if defined (_WIN32) \
3165 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
3166 int __gnat_prj_add_obj_files
= 0;
3168 int __gnat_prj_add_obj_files
= 1;
3171 /* char used as prefix/suffix for environment variables */
3172 #if defined (_WIN32)
3173 char __gnat_environment_char
= '%';
3175 char __gnat_environment_char
= '$';
3178 /* This functions copy the file attributes from a source file to a
3181 mode = 0 : In this mode copy only the file time stamps (last access and
3182 last modification time stamps).
3184 mode = 1 : In this mode, time stamps and read/write/execute attributes are
3187 mode = 2 : In this mode, only read/write/execute attributes are copied
3189 Returns 0 if operation was successful and -1 in case of error. */
3192 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED
, char *to ATTRIBUTE_UNUSED
,
3193 int mode ATTRIBUTE_UNUSED
)
3195 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
3198 #elif defined (_WIN32)
3199 TCHAR wfrom
[GNAT_MAX_PATH_LEN
+ 2];
3200 TCHAR wto
[GNAT_MAX_PATH_LEN
+ 2];
3202 FILETIME fct
, flat
, flwt
;
3205 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
+ 2);
3206 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
+ 2);
3208 /* Do we need to copy the timestamp ? */
3211 /* retrieve from times */
3214 (wfrom
, GENERIC_READ
, 0, NULL
, OPEN_EXISTING
,
3215 FILE_ATTRIBUTE_NORMAL
, NULL
);
3217 if (hfrom
== INVALID_HANDLE_VALUE
)
3220 res
= GetFileTime (hfrom
, &fct
, &flat
, &flwt
);
3222 CloseHandle (hfrom
);
3227 /* retrieve from times */
3230 (wto
, GENERIC_WRITE
, 0, NULL
, OPEN_EXISTING
,
3231 FILE_ATTRIBUTE_NORMAL
, NULL
);
3233 if (hto
== INVALID_HANDLE_VALUE
)
3236 res
= SetFileTime (hto
, NULL
, &flat
, &flwt
);
3244 /* Do we need to copy the permissions ? */
3245 /* Set file attributes in full mode. */
3249 DWORD attribs
= GetFileAttributes (wfrom
);
3251 if (attribs
== INVALID_FILE_ATTRIBUTES
)
3254 res
= SetFileAttributes (wto
, attribs
);
3262 GNAT_STRUCT_STAT fbuf
;
3264 if (GNAT_STAT (from
, &fbuf
) == -1) {
3268 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 7)
3270 /* VxWorks prior to 7 only has utime. */
3272 /* Do we need to copy the timestamp ? */
3274 struct utimbuf tbuf
;
3276 tbuf
.actime
= fbuf
.st_atime
;
3277 tbuf
.modtime
= fbuf
.st_mtime
;
3279 if (utime (to
, &tbuf
) == -1)
3283 #elif _POSIX_C_SOURCE >= 200809L
3284 struct timespec tbuf
[2];
3287 tbuf
[0] = fbuf
.st_atim
;
3288 tbuf
[1] = fbuf
.st_mtim
;
3290 if (utimensat (AT_FDCWD
, to
, tbuf
, 0) == -1) {
3296 struct timeval tbuf
[2];
3297 /* Do we need to copy timestamp ? */
3300 tbuf
[0].tv_sec
= fbuf
.st_atime
;
3301 tbuf
[1].tv_sec
= fbuf
.st_mtime
;
3303 #if defined(st_mtime)
3304 tbuf
[0].tv_usec
= fbuf
.st_atim
.tv_nsec
/ 1000;
3305 tbuf
[1].tv_usec
= fbuf
.st_mtim
.tv_nsec
/ 1000;
3307 tbuf
[0].tv_usec
= 0;
3308 tbuf
[1].tv_usec
= 0;
3311 if (utimes (to
, tbuf
) == -1) {
3317 /* Do we need to copy file permissions ? */
3318 if (mode
!= 0 && (chmod (to
, fbuf
.st_mode
) == -1)) {
3327 __gnat_lseek (int fd
, long offset
, int whence
)
3329 return (int) lseek (fd
, offset
, whence
);
3332 /* This function returns the major version number of GCC being used. */
3334 get_gcc_version (void)
3339 return (int) (version_string
[0] - '0');
3344 * Set Close_On_Exec as indicated.
3345 * Note: this is used for both GNAT.OS_Lib and GNAT.Sockets.
3349 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED
,
3350 int close_on_exec_p ATTRIBUTE_UNUSED
)
3352 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
3353 int flags
= fcntl (fd
, F_GETFD
, 0);
3356 if (close_on_exec_p
)
3357 flags
|= FD_CLOEXEC
;
3359 flags
&= ~FD_CLOEXEC
;
3360 return fcntl (fd
, F_SETFD
, flags
);
3361 #elif defined(_WIN32)
3362 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
3363 if (h
== (HANDLE
) -1)
3365 if (close_on_exec_p
)
3366 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
, 0);
3367 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
,
3368 HANDLE_FLAG_INHERIT
);
3370 /* TODO: Unimplemented. */
3375 /* Indicates if platforms supports automatic initialization through the
3376 constructor mechanism */
3378 __gnat_binder_supports_auto_init (void)
3383 /* Indicates that Stand-Alone Libraries are automatically initialized through
3384 the constructor mechanism */
3386 __gnat_sals_init_using_constructors (void)
3388 #if defined (__vxworks) || defined (__Lynx__)
3395 #if defined (__linux__) || defined (__ANDROID__)
3396 /* There is no function in the glibc to retrieve the LWP of the current
3397 thread. We need to do a system call in order to retrieve this
3399 #include <sys/syscall.h>
3401 __gnat_lwp_self (void)
3403 return (void *) syscall (__NR_gettid
);
3407 #if defined (__APPLE__)
3408 # if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1060
3409 # include <mach/thread_info.h>
3410 # include <mach/mach_init.h>
3411 # include <mach/thread_act.h>
3413 # include <pthread.h>
3416 /* System-wide thread identifier. Note it could be truncated on 32 bit
3418 Previously was: pthread_mach_thread_np (pthread_self ()). */
3420 __gnat_lwp_self (void)
3422 #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1060
3423 thread_identifier_info_data_t data
;
3424 mach_msg_type_number_t count
= THREAD_IDENTIFIER_INFO_COUNT
;
3427 kret
= thread_info (mach_thread_self (), THREAD_IDENTIFIER_INFO
,
3428 (thread_info_t
) &data
, &count
);
3429 if (kret
== KERN_SUCCESS
)
3430 return (void *)(uintptr_t)data
.thread_id
;
3434 return (void *)pthread_mach_thread_np (pthread_self ());
3439 #if defined (__linux__)
3442 /* glibc versions earlier than 2.7 do not define the routines to handle
3443 dynamically allocated CPU sets. For these targets, we use the static
3448 /* Dynamic cpu sets */
3451 __gnat_cpu_alloc (size_t count
)
3453 return CPU_ALLOC (count
);
3457 __gnat_cpu_alloc_size (size_t count
)
3459 return CPU_ALLOC_SIZE (count
);
3463 __gnat_cpu_free (cpu_set_t
*set
)
3469 __gnat_cpu_zero (size_t count
, cpu_set_t
*set
)
3471 CPU_ZERO_S (count
, set
);
3475 __gnat_cpu_set (int cpu
, size_t count
, cpu_set_t
*set
)
3477 /* Ada handles CPU numbers starting from 1, while C identifies the first
3478 CPU by a 0, so we need to adjust. */
3479 CPU_SET_S (cpu
- 1, count
, set
);
3482 #else /* !CPU_ALLOC */
3484 /* Static cpu sets */
3487 __gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED
)
3489 return (cpu_set_t
*) xmalloc (sizeof (cpu_set_t
));
3493 __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED
)
3495 return sizeof (cpu_set_t
);
3499 __gnat_cpu_free (cpu_set_t
*set
)
3505 __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3511 __gnat_cpu_set (int cpu
, size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3513 /* Ada handles CPU numbers starting from 1, while C identifies the first
3514 CPU by a 0, so we need to adjust. */
3515 CPU_SET (cpu
- 1, set
);
3517 #endif /* !CPU_ALLOC */
3518 #endif /* __linux__ */
3520 /* Return the load address of the executable, or 0 if not known. In the
3521 specific case of error, (void *)-1 can be returned. Beware: this unit may
3522 be in a shared library. As low-level units are needed, we allow #include
3525 #if defined (__APPLE__)
3526 #include <mach-o/dyld.h>
3530 __gnat_get_executable_load_address (void)
3532 #if defined (__APPLE__)
3533 return _dyld_get_image_header (0);
3535 #elif 0 && defined (__linux__)
3536 /* Currently disabled as it needs at least -ldl. */
3537 struct link_map
*map
= _r_debug
.r_map
;
3539 return (const void *)map
->l_addr
;
3541 #elif defined (_WIN32)
3542 return GetModuleHandle (NULL
);
3550 __gnat_kill (int pid
, int sig
)
3556 case 9: // SIGKILL is not declared in Windows headers
3561 h
= OpenProcess (PROCESS_ALL_ACCESS
, FALSE
, pid
);
3563 TerminateProcess (h
, sig
);
3568 #elif defined (__vxworks)
3569 /* Not implemented */
3575 void __gnat_killprocesstree (int pid
, int sig_num
)
3580 memset(&pe
, 0, sizeof(PROCESSENTRY32
));
3581 pe
.dwSize
= sizeof(PROCESSENTRY32
);
3583 HANDLE hSnap
= CreateToolhelp32Snapshot (TH32CS_SNAPPROCESS
, 0);
3585 /* cannot take snapshot, just kill the parent process */
3587 if (hSnap
== INVALID_HANDLE_VALUE
)
3589 __gnat_kill (pid
, sig_num
);
3593 if (Process32First(hSnap
, &pe
))
3595 BOOL bContinue
= TRUE
;
3597 /* kill child processes first */
3601 if (pe
.th32ParentProcessID
== (DWORD
)pid
)
3602 __gnat_killprocesstree (pe
.th32ProcessID
, sig_num
);
3604 bContinue
= Process32Next (hSnap
, &pe
);
3608 CloseHandle (hSnap
);
3612 __gnat_kill (pid
, sig_num
);
3614 #elif defined (__vxworks)
3615 /* not implemented */
3617 #elif defined (__linux__)
3621 /* read all processes' pid and ppid */
3623 dir
= opendir ("/proc");
3625 /* cannot open proc, just kill the parent process */
3629 __gnat_kill (pid
, sig_num
);
3633 /* kill child processes first */
3635 while ((d
= readdir (dir
)) != NULL
)
3637 if ((d
->d_type
& DT_DIR
) == DT_DIR
)
3642 /* read /proc/<PID>/stat */
3644 if (strlen (d
->d_name
) >= sizeof (statfile
) - strlen ("/proc//stat"))
3646 strcpy (statfile
, "/proc/");
3647 strcat (statfile
, d
->d_name
);
3648 strcat (statfile
, "/stat");
3650 FILE *fd
= fopen (statfile
, "r");
3654 const int match
= fscanf (fd
, "%d %*s %*s %d", &_pid
, &_ppid
);
3657 if (match
== 2 && _ppid
== pid
)
3658 __gnat_killprocesstree (_pid
, sig_num
);
3667 __gnat_kill (pid
, sig_num
);
3669 __gnat_kill (pid
, sig_num
);
3671 /* Note on Solaris it is possible to read /proc/<PID>/status.
3672 The 5th and 6th words are the pid and the 7th and 8th the ppid.
3673 See: /usr/include/sys/procfs.h (struct pstatus).