1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
9 * Copyright (C) 1992-2023, 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 #include <TargetConditionals.h>
93 #if defined (__hpux__)
94 #include <sys/param.h>
95 #include <sys/pstat.h>
99 #define __BSD_VISIBLE 1
103 #include <sys/syspage.h>
104 #include <sys/time.h>
111 #include <sys/types.h>
112 #include <sys/stat.h>
117 /* for CPU_SET/CPU_ZERO */
128 #include <sys/stat.h>
132 #if defined (__vxworks) || defined (__ANDROID__)
133 /* S_IREAD and S_IWRITE are not defined in VxWorks or Android */
135 #define S_IREAD (S_IRUSR | S_IRGRP | S_IROTH)
139 #define S_IWRITE (S_IWUSR)
143 /* We don't have libiberty, so use malloc. */
144 #define xmalloc(S) malloc (S)
145 #define xrealloc(V,S) realloc (V,S)
152 /* limits.h is needed for LLONG_MIN. */
163 #if defined (__DJGPP__)
165 /* For isalpha-like tests in the compiler, we're expected to resort to
166 safe-ctype.h/ISALPHA. This isn't available for the runtime library
167 build, so we fallback on ctype.h/isalpha there. */
171 #define ISALPHA isalpha
174 #elif defined (__MINGW32__) || defined (__CYGWIN__)
178 /* Current code page and CCS encoding to use, set in initialize.c. */
179 UINT __gnat_current_codepage
;
180 UINT __gnat_current_ccs_encoding
;
182 #include <sys/utime.h>
184 /* For isalpha-like tests in the compiler, we're expected to resort to
185 safe-ctype.h/ISALPHA. This isn't available for the runtime library
186 build, so we fallback on ctype.h/isalpha there. */
190 #define ISALPHA isalpha
193 #elif defined (__Lynx__)
195 /* Lynx utime.h only defines the entities of interest to us if
196 defined (VMOS_DEV), so ... */
205 /* wait.h processing */
206 #if defined (__vxworks) && defined (__RTP__)
208 #elif defined (__Lynx__)
209 /* ??? We really need wait.h and it includes resource.h on Lynx. GCC
210 has a resource.h header as well, included instead of the lynx
211 version in our setup, causing lots of errors. We don't really need
212 the lynx contents of this file, so just workaround the issue by
213 preventing the inclusion of the GCC header from doing anything. */
214 # define GCC_RESOURCE_H
215 # include <sys/wait.h>
216 #elif defined (__PikeOS__) || defined (__MINGW32__)
217 /* No wait() or waitpid() calls available. */
220 #include <sys/wait.h>
223 #if defined (__DJGPP__)
229 #define DIR_SEPARATOR '\\'
231 #elif defined (_WIN32)
233 /* Cannot redefine abort here. */
236 #define WIN32_LEAN_AND_MEAN
240 #include <tlhelp32.h>
243 #define DIR_SEPARATOR '\\'
252 int __gnat_in_child_after_fork
= 0;
254 #if defined (__APPLE__) && defined (st_mtime)
255 #define st_atim st_atimespec
256 #define st_mtim st_mtimespec
259 /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
260 defined in the current system. On DOS-like systems these flags control
261 whether the file is opened/created in text-translation mode (CR/LF in
262 external file mapped to LF in internal file), but in Unix-like systems,
263 no text translation is required, so these flags have no effect. */
273 #ifndef HOST_EXECUTABLE_SUFFIX
274 #define HOST_EXECUTABLE_SUFFIX ""
277 #ifndef HOST_OBJECT_SUFFIX
278 #define HOST_OBJECT_SUFFIX ".o"
281 #ifndef PATH_SEPARATOR
282 #define PATH_SEPARATOR ':'
285 #ifndef DIR_SEPARATOR
286 #define DIR_SEPARATOR '/'
287 #define IS_DIRECTORY_SEPARATOR(c) ((c) == DIR_SEPARATOR)
289 #define IS_DIRECTORY_SEPARATOR(c) ((c) == '/' || (c) == DIR_SEPARATOR)
292 /* Check for cross-compilation. */
293 #if defined (CROSS_COMPILE) || defined (CROSS_DIRECTORY_STRUCTURE)
295 int __gnat_is_cross_compiler
= 1;
298 int __gnat_is_cross_compiler
= 0;
301 char __gnat_dir_separator
= DIR_SEPARATOR
;
303 char __gnat_path_separator
= PATH_SEPARATOR
;
305 /* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
306 the base filenames that libraries specified with -lsomelib options
307 may have. This is used by GNATMAKE to check whether an executable
308 is up-to-date or not. The syntax is
310 library_template ::= { pattern ; } pattern NUL
311 pattern ::= [ prefix ] * [ postfix ]
313 These should only specify names of static libraries as it makes
314 no sense to determine at link time if dynamic-link libraries are
315 up to date or not. Any libraries that are not found are supposed
318 * if they are needed but not present, the link
321 * otherwise they are libraries in the system paths and so
322 they are considered part of the system and not checked
325 ??? This should be part of a GNAT host-specific compiler
326 file instead of being included in all user applications
327 as well. This is only a temporary work-around for 3.11b. */
329 #ifndef GNAT_LIBRARY_TEMPLATE
330 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
333 const char *__gnat_library_template
= GNAT_LIBRARY_TEMPLATE
;
335 #if defined (__vxworks)
336 #define GNAT_MAX_PATH_LEN PATH_MAX
340 #if defined (__MINGW32__)
343 #include <sys/param.h>
347 #define GNAT_MAX_PATH_LEN MAXPATHLEN
349 #define GNAT_MAX_PATH_LEN 256
354 /* Used for runtime check that Ada constant File_Attributes_Size is no
355 less than the actual size of struct file_attributes (see Osint
357 int __gnat_size_of_file_attributes
= sizeof (struct file_attributes
);
359 void __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
);
361 /* The __gnat_max_path_len variable is used to export the maximum
362 length of a path name to Ada code. max_path_len is also provided
363 for compatibility with older GNAT versions, please do not use
366 int __gnat_max_path_len
= GNAT_MAX_PATH_LEN
;
367 int max_path_len
= GNAT_MAX_PATH_LEN
;
369 /* Control whether we can use ACL on Windows. */
371 int __gnat_use_acl
= 1;
373 /* The following macro HAVE_READDIR_R should be defined if the
374 system provides the routine readdir_r.
375 ... but we never define it anywhere??? */
376 #undef HAVE_READDIR_R
378 #define MAYBE_TO_PTR32(argv) argv
380 static const char ATTR_UNSET
= 127;
382 /* Reset the file attributes as if no system call had been performed */
385 __gnat_reset_attributes (struct file_attributes
* attr
)
387 attr
->exists
= ATTR_UNSET
;
388 attr
->error
= EINVAL
;
390 attr
->writable
= ATTR_UNSET
;
391 attr
->readable
= ATTR_UNSET
;
392 attr
->executable
= ATTR_UNSET
;
394 attr
->regular
= ATTR_UNSET
;
395 attr
->symbolic_link
= ATTR_UNSET
;
396 attr
->directory
= ATTR_UNSET
;
398 attr
->timestamp
= (OS_Time
)-2;
399 attr
->file_length
= -1;
403 __gnat_error_attributes (struct file_attributes
*attr
) {
408 __gnat_current_time (void)
410 time_t res
= time (NULL
);
411 return (OS_Time
) res
;
414 /* Return the current local time as a string in the ISO 8601 format of
415 "YYYY-MM-DD HH:MM:SS.SS". The returned string is 22 + 1 (NULL) characters
419 __gnat_current_time_string (char *result
)
421 const char *format
= "%Y-%m-%d %H:%M:%S";
422 /* Format string necessary to describe the ISO 8601 format */
424 const time_t t_val
= time (NULL
);
426 strftime (result
, 22, format
, localtime (&t_val
));
427 /* Convert the local time into a string following the ISO format, copying
428 at most 22 characters into the result string. */
433 /* The sub-seconds are manually set to zero since type time_t lacks the
434 precision necessary for nanoseconds. */
438 __gnat_to_gm_time (OS_Time
*p_time
, int *p_year
, int *p_month
, int *p_day
,
439 int *p_hours
, int *p_mins
, int *p_secs
)
442 time_t time
= (time_t) *p_time
;
444 res
= gmtime (&time
);
447 *p_year
= res
->tm_year
;
448 *p_month
= res
->tm_mon
;
449 *p_day
= res
->tm_mday
;
450 *p_hours
= res
->tm_hour
;
451 *p_mins
= res
->tm_min
;
452 *p_secs
= res
->tm_sec
;
455 *p_year
= *p_month
= *p_day
= *p_hours
= *p_mins
= *p_secs
= 0;
459 __gnat_to_os_time (OS_Time
*p_time
, int year
, int month
, int day
,
460 int hours
, int mins
, int secs
)
472 /* returns -1 of failing, this is s-os_lib Invalid_Time */
474 *p_time
= (OS_Time
) mktime (&v
);
477 /* Place the contents of the symbolic link named PATH in the buffer BUF,
478 which has size BUFSIZ. If PATH is a symbolic link, then return the number
479 of characters of its content in BUF. Otherwise, return -1.
480 For systems not supporting symbolic links, always return -1. */
483 __gnat_readlink (char *path ATTRIBUTE_UNUSED
,
484 char *buf ATTRIBUTE_UNUSED
,
485 size_t bufsiz ATTRIBUTE_UNUSED
)
487 #if defined (_WIN32) \
488 || defined(__vxworks) || defined (__PikeOS__)
491 return readlink (path
, buf
, bufsiz
);
495 /* Creates a symbolic link named NEWPATH which contains the string OLDPATH.
496 If NEWPATH exists it will NOT be overwritten.
497 For systems not supporting symbolic links, always return -1. */
500 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED
,
501 char *newpath ATTRIBUTE_UNUSED
)
503 #if defined (_WIN32) \
504 || defined(__vxworks) || defined (__PikeOS__)
507 return symlink (oldpath
, newpath
);
511 /* Try to lock a file, return 1 if success. */
513 #if defined (__vxworks) \
514 || defined (_WIN32) || defined (__PikeOS__)
516 /* Version that does not use link. */
519 __gnat_try_lock (char *dir
, char *file
)
523 TCHAR wfull_path
[GNAT_MAX_PATH_LEN
];
524 TCHAR wfile
[GNAT_MAX_PATH_LEN
];
525 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
527 S2WSC (wdir
, dir
, GNAT_MAX_PATH_LEN
);
528 S2WSC (wfile
, file
, GNAT_MAX_PATH_LEN
);
530 /* ??? the code below crash on MingW64 for obscure reasons, a ticket
531 has been opened here:
533 https://sourceforge.net/p/mingw-w64/bugs/414/
535 As a workaround an equivalent set of code has been put in place below.
537 _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
540 _tcscpy (wfull_path
, wdir
);
541 _tcscat (wfull_path
, L
"\\");
542 _tcscat (wfull_path
, wfile
);
544 fd
= _topen (wfull_path
, O_CREAT
| O_EXCL
, 0600);
548 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
549 fd
= open (full_path
, O_CREAT
| O_EXCL
, 0600);
561 /* Version using link(), more secure over NFS. */
562 /* See TN 6913-016 for discussion ??? */
565 __gnat_try_lock (char *dir
, char *file
)
569 GNAT_STRUCT_STAT stat_result
;
572 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
573 sprintf (temp_file
, "%s%cTMP-%ld-%ld",
574 dir
, DIR_SEPARATOR
, (long)getpid(), (long)getppid ());
576 /* Create the temporary file and write the process number. */
577 fd
= open (temp_file
, O_CREAT
| O_WRONLY
, 0600);
583 /* Link it with the new file. */
584 link (temp_file
, full_path
);
586 /* Count the references on the old one. If we have a count of two, then
587 the link did succeed. Remove the temporary file before returning. */
588 __gnat_stat (temp_file
, &stat_result
);
590 return stat_result
.st_nlink
== 2;
594 /* Return the maximum file name length. */
597 __gnat_get_maximum_file_name_length (void)
602 /* Return nonzero if file names are case sensitive. */
604 static int file_names_case_sensitive_cache
= -1;
607 __gnat_get_file_names_case_sensitive (void)
609 if (file_names_case_sensitive_cache
== -1)
611 const char *sensitive
= getenv ("GNAT_FILE_NAME_CASE_SENSITIVE");
613 if (sensitive
!= NULL
614 && (sensitive
[0] == '0' || sensitive
[0] == '1')
615 && sensitive
[1] == '\0')
616 file_names_case_sensitive_cache
= sensitive
[0] - '0';
619 /* By default, we suppose filesystems aren't case sensitive on
621 #if defined (WINNT) || defined (__DJGPP__)
622 file_names_case_sensitive_cache
= 0;
623 #elif defined (__APPLE__)
624 /* By default, macOS volumes are case-insensitive, iOS
625 volumes are case-sensitive. */
627 file_names_case_sensitive_cache
= 1;
629 file_names_case_sensitive_cache
= 0;
631 #else /* Neither Windows nor Apple. */
632 file_names_case_sensitive_cache
= 1;
636 return file_names_case_sensitive_cache
;
639 /* Return nonzero if environment variables are case sensitive. */
642 __gnat_get_env_vars_case_sensitive (void)
644 #if defined (WINNT) || defined (__DJGPP__)
652 __gnat_get_default_identifier_character_set (void)
657 /* Return the current working directory. */
660 __gnat_get_current_dir (char *dir
, int *length
)
662 #if defined (__MINGW32__)
663 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
665 _tgetcwd (wdir
, *length
);
667 WS2SC (dir
, wdir
, GNAT_MAX_PATH_LEN
);
670 char* result
= getcwd (dir
, *length
);
671 /* If the current directory does not exist, set length = 0
672 to indicate error. That can't happen on windows, where
673 you can't delete a directory if it is the current
674 directory of some process. */
682 *length
= strlen (dir
);
684 if (dir
[*length
- 1] != DIR_SEPARATOR
)
686 dir
[*length
] = DIR_SEPARATOR
;
692 /* Return the suffix for object files. */
695 __gnat_get_object_suffix_ptr (int *len
, const char **value
)
697 *value
= HOST_OBJECT_SUFFIX
;
702 *len
= strlen (*value
);
707 /* Return the suffix for executable files. */
710 __gnat_get_executable_suffix_ptr (int *len
, const char **value
)
712 *value
= HOST_EXECUTABLE_SUFFIX
;
717 *len
= strlen (*value
);
722 /* Return the suffix for debuggable files. Usually this is the same as the
723 executable extension. */
726 __gnat_get_debuggable_suffix_ptr (int *len
, const char **value
)
728 *value
= HOST_EXECUTABLE_SUFFIX
;
733 *len
= strlen (*value
);
738 /* Returns the OS filename and corresponding encoding. */
741 __gnat_os_filename (char *filename ATTRIBUTE_UNUSED
,
742 char *w_filename ATTRIBUTE_UNUSED
,
743 char *os_name
, int *o_length
,
744 char *encoding ATTRIBUTE_UNUSED
, int *e_length
)
746 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
747 WS2SC (os_name
, (TCHAR
*)w_filename
, (DWORD
)*o_length
);
748 *o_length
= strlen (os_name
);
749 strcpy (encoding
, "encoding=utf8");
750 *e_length
= strlen (encoding
);
752 strcpy (os_name
, filename
);
753 *o_length
= strlen (filename
);
761 __gnat_unlink (char *path
, int encoding ATTRIBUTE_UNUSED
)
763 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
764 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
766 if (encoding
== Encoding_Unspecified
)
767 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
768 else if (encoding
== Encoding_UTF8
)
769 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
771 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
773 return _tunlink (wpath
);
775 return unlink (path
);
782 __gnat_rename (char *from
, char *to
)
784 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
786 TCHAR wfrom
[GNAT_MAX_PATH_LEN
], wto
[GNAT_MAX_PATH_LEN
];
788 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
);
789 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
);
790 return _trename (wfrom
, wto
);
792 #elif defined (__vxworks) && (_WRS_VXWORKS_MAJOR == 6)
794 /* When used on a dos filesystem under VxWorks 6.9 rename will trigger a
795 S_dosFsLib_FILE_NOT_FOUND errno when the file is not found. Let's map
796 that to ENOENT so Ada.Directory.Rename can detect that and raise the
797 Name_Error exception. */
798 int ret
= rename (from
, to
);
800 if (ret
&& (errno
== S_dosFsLib_FILE_NOT_FOUND
))
807 return rename (from
, to
);
811 /* Changing directory. */
814 __gnat_chdir (char *path
)
816 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
818 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
820 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
821 return _tchdir (wpath
);
828 /* Removing a directory. */
831 __gnat_rmdir (char *path
)
833 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
835 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
837 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
838 return _trmdir (wpath
);
840 #elif defined (VTHREADS)
841 /* rmdir not available */
848 #if defined (_WIN32) || defined (__linux__) || defined (__sun__) \
849 || defined (__FreeBSD__) || defined(__DragonFly__) || defined (__QNX__)
850 #define HAS_TARGET_WCHAR_T
853 #ifdef HAS_TARGET_WCHAR_T
858 __gnat_fputwc(int c
, FILE *stream
)
860 #ifdef HAS_TARGET_WCHAR_T
861 return fputwc ((wchar_t)c
, stream
);
863 return fputc (c
, stream
);
868 __gnat_fopen (char *path
, char *mode
, int encoding ATTRIBUTE_UNUSED
)
870 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
871 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
874 S2WS (wmode
, mode
, 10);
876 if (encoding
== Encoding_Unspecified
)
877 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
878 else if (encoding
== Encoding_UTF8
)
879 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
881 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
883 return _tfopen (wpath
, wmode
);
886 return GNAT_FOPEN (path
, mode
);
891 __gnat_freopen (char *path
,
894 int encoding ATTRIBUTE_UNUSED
)
896 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
897 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
900 S2WS (wmode
, mode
, 10);
902 if (encoding
== Encoding_Unspecified
)
903 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
904 else if (encoding
== Encoding_UTF8
)
905 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
907 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
909 return _tfreopen (wpath
, wmode
, stream
);
911 return freopen (path
, mode
, stream
);
916 __gnat_open_read (char *path
, int fmode
)
919 int o_fmode
= O_BINARY
;
924 #if defined (__vxworks)
925 fd
= open (path
, O_RDONLY
| o_fmode
, 0444);
926 #elif defined (__MINGW32__)
928 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
930 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
931 fd
= _topen (wpath
, O_RDONLY
| o_fmode
, 0444);
934 fd
= GNAT_OPEN (path
, O_RDONLY
| o_fmode
);
937 return fd
< 0 ? -1 : fd
;
940 #if defined (__MINGW32__)
941 #define PERM (S_IREAD | S_IWRITE)
943 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
947 __gnat_open_rw (char *path
, int fmode
)
950 int o_fmode
= O_BINARY
;
955 #if defined (__MINGW32__)
957 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
959 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
960 fd
= _topen (wpath
, O_RDWR
| o_fmode
, PERM
);
963 fd
= GNAT_OPEN (path
, O_RDWR
| o_fmode
, PERM
);
966 return fd
< 0 ? -1 : fd
;
970 __gnat_open_create (char *path
, int fmode
)
973 int o_fmode
= O_BINARY
;
978 #if defined (__MINGW32__)
980 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
982 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
983 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
986 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
989 return fd
< 0 ? -1 : fd
;
993 __gnat_create_output_file (char *path
)
996 #if defined (__MINGW32__)
998 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1000 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1001 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
1004 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
1007 return fd
< 0 ? -1 : fd
;
1011 __gnat_create_output_file_new (char *path
)
1014 #if defined (__MINGW32__)
1016 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1018 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1019 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
1022 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
1025 return fd
< 0 ? -1 : fd
;
1029 __gnat_open_append (char *path
, int fmode
)
1032 int o_fmode
= O_BINARY
;
1037 #if defined (__MINGW32__)
1039 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1041 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1042 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
1045 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
1048 return fd
< 0 ? -1 : fd
;
1051 /* Open a new file. Return error (-1) if the file already exists. */
1054 __gnat_open_new (char *path
, int fmode
)
1057 int o_fmode
= O_BINARY
;
1062 #if defined (__MINGW32__)
1064 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1066 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1067 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1070 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1073 return fd
< 0 ? -1 : fd
;
1076 /* Open a new temp file. Return error (-1) if the file already exists. */
1079 __gnat_open_new_temp (char *path
, int fmode
)
1082 int o_fmode
= O_BINARY
;
1084 strcpy (path
, "GNAT-XXXXXX");
1086 #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
1087 || defined (__linux__) || defined (__GLIBC__) || defined (__ANDROID__) \
1088 || defined (__DragonFly__) || defined (__QNX__)) && !defined (__vxworks)
1089 return mkstemp (path
);
1090 #elif defined (__Lynx__)
1093 if (mktemp (path
) == NULL
)
1100 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1101 return fd
< 0 ? -1 : fd
;
1105 __gnat_open (char *path
, int fmode
)
1109 #if defined (__MINGW32__)
1111 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1113 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1114 fd
= _topen (wpath
, fmode
, PERM
);
1117 fd
= GNAT_OPEN (path
, fmode
, PERM
);
1120 return fd
< 0 ? -1 : fd
;
1123 /****************************************************************
1124 ** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information
1125 ** as possible from it, storing the result in a cache for later reuse
1126 ****************************************************************/
1129 __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
)
1131 GNAT_STRUCT_STAT statbuf
;
1135 /* GNAT_FSTAT returns -1 and sets errno for failure */
1136 ret
= GNAT_FSTAT (fd
, &statbuf
);
1137 error
= ret
? errno
: 0;
1140 /* __gnat_stat returns errno value directly */
1141 error
= __gnat_stat (name
, &statbuf
);
1142 ret
= error
? -1 : 0;
1146 * A missing file is reported as an attr structure with error == 0 and
1150 if (error
== 0 || error
== ENOENT
)
1153 attr
->error
= error
;
1155 attr
->regular
= (!ret
&& S_ISREG (statbuf
.st_mode
));
1156 attr
->directory
= (!ret
&& S_ISDIR (statbuf
.st_mode
));
1159 attr
->file_length
= 0;
1161 /* st_size may be 32 bits, or 64 bits which is converted to long. We
1162 don't return a useful value for files larger than 2 gigabytes in
1164 attr
->file_length
= statbuf
.st_size
; /* all systems */
1166 attr
->exists
= !ret
;
1168 #if !defined (_WIN32)
1169 /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
1170 attr
->readable
= (!ret
&& (statbuf
.st_mode
& S_IRUSR
));
1171 attr
->writable
= (!ret
&& (statbuf
.st_mode
& S_IWUSR
));
1172 attr
->executable
= (!ret
&& (statbuf
.st_mode
& S_IXUSR
));
1176 attr
->timestamp
= (OS_Time
)-1;
1178 attr
->timestamp
= (OS_Time
)statbuf
.st_mtime
;
1182 /****************************************************************
1183 ** Return the number of bytes in the specified file
1184 ****************************************************************/
1187 __gnat_file_length_attr (int fd
, char* name
, struct file_attributes
* attr
)
1189 if (attr
->file_length
== -1) {
1190 __gnat_stat_to_attr (fd
, name
, attr
);
1193 return attr
->file_length
;
1197 __gnat_file_length (int fd
)
1199 struct file_attributes attr
;
1200 __gnat_reset_attributes (&attr
);
1201 return __gnat_file_length_attr (fd
, NULL
, &attr
);
1205 __gnat_file_length_long (int fd
)
1207 struct file_attributes attr
;
1208 __gnat_reset_attributes (&attr
);
1209 return (long)__gnat_file_length_attr (fd
, NULL
, &attr
);
1213 __gnat_named_file_length (char *name
)
1215 struct file_attributes attr
;
1216 __gnat_reset_attributes (&attr
);
1217 return __gnat_file_length_attr (-1, name
, &attr
);
1220 /* Create a temporary filename and put it in string pointed to by
1224 __gnat_tmp_name (char *tmp_filename
)
1226 #if defined (__MINGW32__)
1231 /* tempnam tries to create a temporary file in directory pointed to by
1232 TMP environment variable, in c:\temp if TMP is not set, and in
1233 directory specified by P_tmpdir in stdio.h if c:\temp does not
1234 exist. The filename will be created with the prefix "gnat-". */
1236 sprintf (prefix
, "gnat-%d-", (int)getpid());
1237 pname
= (char *) _tempnam ("c:\\temp", prefix
);
1239 /* if pname is NULL, the file was not created properly, the disk is full
1240 or there is no more free temporary files */
1243 *tmp_filename
= '\0';
1245 /* If pname start with a back slash and not path information it means that
1246 the filename is valid for the current working directory. */
1248 else if (pname
[0] == '\\')
1250 strcpy (tmp_filename
, ".\\");
1251 strcat (tmp_filename
, pname
+1);
1254 strcpy (tmp_filename
, pname
);
1259 #elif defined (__linux__) || defined (__FreeBSD__) || defined (__NetBSD__) \
1260 || defined (__OpenBSD__) || defined (__GLIBC__) || defined (__ANDROID__) \
1261 || defined (__DragonFly__) || defined (__QNX__)
1262 #define MAX_SAFE_PATH 1000
1263 char *tmpdir
= getenv ("TMPDIR");
1265 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1266 a buffer overflow. */
1267 if (tmpdir
== NULL
|| strlen (tmpdir
) > MAX_SAFE_PATH
)
1269 strcpy (tmp_filename
, "/cache/gnat-XXXXXX");
1271 strcpy (tmp_filename
, "/tmp/gnat-XXXXXX");
1274 sprintf (tmp_filename
, "%s/gnat-XXXXXX", tmpdir
);
1276 close (mkstemp(tmp_filename
));
1277 #elif defined (__vxworks) && !defined (VTHREADS)
1281 static ushort_t seed
= 0; /* used to generate unique name */
1283 /* Generate a unique name. */
1284 strcpy (tmp_filename
, "tmp");
1287 savepos
= pos
= tmp_filename
+ strlen (tmp_filename
) + index
;
1295 /* Fill up the name buffer from the last position. */
1297 for (t
= seed
; --index
>= 0; t
>>= 3)
1298 *--pos
= '0' + (t
& 07);
1300 /* Check to see if its unique, if not bump the seed and try again. */
1301 f
= fopen (tmp_filename
, "r");
1309 tmpnam (tmp_filename
);
1313 /* Open directory and returns a DIR pointer. */
1315 DIR* __gnat_opendir (char *name
)
1317 #if defined (__MINGW32__)
1318 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1320 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1321 return (DIR*)_topendir (wname
);
1324 return opendir (name
);
1328 /* Read the next entry in a directory. The returned string points somewhere
1331 #if defined (__sun__)
1332 /* For Solaris, be sure to use the 64-bit version, otherwise NFS reads may
1333 fail with EOVERFLOW if the server uses 64-bit cookies. */
1334 #define dirent dirent64
1335 #define readdir readdir64
1339 __gnat_readdir (DIR *dirp
, char *buffer
, int *len
)
1341 #if defined (__MINGW32__)
1342 struct _tdirent
*dirent
= _treaddir ((_TDIR
*)dirp
);
1346 WS2SC (buffer
, dirent
->d_name
, GNAT_MAX_PATH_LEN
);
1347 *len
= strlen (buffer
);
1354 #elif defined (HAVE_READDIR_R)
1355 /* If possible, try to use the thread-safe version. */
1356 if (readdir_r (dirp
, buffer
) != NULL
)
1358 *len
= strlen (((struct dirent
*) buffer
)->d_name
);
1359 return ((struct dirent
*) buffer
)->d_name
;
1365 struct dirent
*dirent
= (struct dirent
*) readdir (dirp
);
1369 strcpy (buffer
, dirent
->d_name
);
1370 *len
= strlen (buffer
);
1379 /* Close a directory entry. */
1381 int __gnat_closedir (DIR *dirp
)
1383 #if defined (__MINGW32__)
1384 return _tclosedir ((_TDIR
*)dirp
);
1387 return closedir (dirp
);
1391 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1394 __gnat_readdir_is_thread_safe (void)
1396 #ifdef HAVE_READDIR_R
1403 #if defined (_WIN32)
1404 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1405 static const unsigned long long w32_epoch_offset
= 11644473600ULL;
1407 /* Returns the file modification timestamp using Win32 routines which are
1408 immune against daylight saving time change. It is in fact not possible to
1409 use fstat for this purpose as the DST modify the st_mtime field of the
1413 win32_filetime (HANDLE h
)
1418 unsigned long long ull_time
;
1421 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1422 since <Jan 1st 1601>. This function must return the number of seconds
1423 since <Jan 1st 1970>. */
1425 if (GetFileTime (h
, NULL
, NULL
, &t_write
.ft_time
))
1426 return (time_t) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1430 /* As above but starting from a FILETIME. */
1432 f2t (const FILETIME
*ft
, __time64_t
*t
)
1437 unsigned long long ull_time
;
1440 t_write
.ft_time
= *ft
;
1441 *t
= (__time64_t
) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1445 /* Return a GNAT time stamp given a file name. */
1448 __gnat_file_time_name_attr (char* name
, struct file_attributes
* attr
)
1450 if (attr
->timestamp
== (OS_Time
)-2) {
1451 #if defined (_WIN32)
1453 WIN32_FILE_ATTRIBUTE_DATA fad
;
1454 __time64_t ret
= -1;
1455 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1456 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1458 if ((res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
)))
1459 f2t (&fad
.ftLastWriteTime
, &ret
);
1460 attr
->timestamp
= (OS_Time
) ret
;
1462 __gnat_stat_to_attr (-1, name
, attr
);
1465 return attr
->timestamp
;
1469 __gnat_file_time_name (char *name
)
1471 struct file_attributes attr
;
1472 __gnat_reset_attributes (&attr
);
1473 return __gnat_file_time_name_attr (name
, &attr
);
1476 /* Return a GNAT time stamp given a file descriptor. */
1479 __gnat_file_time_fd_attr (int fd
, struct file_attributes
* attr
)
1481 if (attr
->timestamp
== (OS_Time
)-2) {
1482 #if defined (_WIN32)
1483 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
1484 time_t ret
= win32_filetime (h
);
1485 attr
->timestamp
= (OS_Time
) ret
;
1488 __gnat_stat_to_attr (fd
, NULL
, attr
);
1492 return attr
->timestamp
;
1496 __gnat_file_time_fd (int fd
)
1498 struct file_attributes attr
;
1499 __gnat_reset_attributes (&attr
);
1500 return __gnat_file_time_fd_attr (fd
, &attr
);
1503 extern long long __gnat_file_time(char* name
)
1510 /* Number of seconds between <Jan 1st 1970> and <Jan 1st 2150>. */
1511 static const long long ada_epoch_offset
= (136 * 365 + 44 * 366) * 86400LL;
1514 /* Number of 100 nanoseconds between <Jan 1st 1601> and <Jan 1st 2150>. */
1515 static const long long w32_epoch_offset
=
1516 (11644473600LL + ada_epoch_offset
) * 1E7
;
1518 WIN32_FILE_ATTRIBUTE_DATA fad
;
1525 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1528 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1529 name_len
= _tcslen (wname
);
1531 if (name_len
> GNAT_MAX_PATH_LEN
)
1534 if (!GetFileAttributesEx(wname
, GetFileExInfoStandard
, &fad
)) {
1538 t_write
.ft_time
= fad
.ftLastWriteTime
;
1540 #if defined(__GNUG__) && __GNUG__ <= 4
1541 result
= (t_write
.ll_time
- w32_epoch_offset
) * 100;
1543 /* Next code similar to (t_write.ll_time - w32_epoch_offset) * 100
1544 but on overflow returns LLONG_MIN value. */
1546 if (__builtin_ssubll_overflow(t_write
.ll_time
, w32_epoch_offset
, &result
)) {
1550 if (__builtin_smulll_overflow(result
, 100, &result
)) {
1558 if (stat(name
, &sb
) != 0) {
1562 #if defined(__GNUG__) && __GNUG__ <= 4
1563 result
= (sb
.st_mtime
- ada_epoch_offset
) * 1E9
;
1564 #if defined(st_mtime)
1565 result
+= sb
.st_mtim
.tv_nsec
;
1568 /* Next code similar to
1569 (sb.st_mtime - ada_epoch_offset) * 1E9 + sb.st_mtim.tv_nsec
1570 but on overflow returns LLONG_MIN value. */
1572 if (__builtin_ssubll_overflow(sb
.st_mtime
, ada_epoch_offset
, &result
)) {
1576 if (__builtin_smulll_overflow(result
, 1E9
, &result
)) {
1580 #if defined(st_mtime)
1581 if (__builtin_saddll_overflow(result
, sb
.st_mtim
.tv_nsec
, &result
)) {
1590 /* Set the file time stamp. */
1593 __gnat_set_file_time_name (char *name
, OS_Time time_stamp
)
1595 #if defined (__vxworks)
1597 /* Code to implement __gnat_set_file_time_name for these systems. */
1599 #elif defined (_WIN32)
1603 unsigned long long ull_time
;
1605 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1607 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1609 HANDLE h
= CreateFile
1610 (wname
, GENERIC_WRITE
, FILE_SHARE_WRITE
, NULL
,
1611 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
,
1613 if (h
== INVALID_HANDLE_VALUE
)
1615 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1616 t_write
.ull_time
= ((unsigned long long)time_stamp
+ w32_epoch_offset
);
1617 /* Convert to 100 nanosecond units */
1618 t_write
.ull_time
*= 10000000ULL;
1620 SetFileTime(h
, NULL
, NULL
, &t_write
.ft_time
);
1625 struct utimbuf utimbuf
;
1628 /* Set modification time to requested time. */
1629 utimbuf
.modtime
= (time_t) time_stamp
;
1631 /* Set access time to now in local time. */
1633 utimbuf
.actime
= mktime (localtime (&t
));
1635 utime (name
, &utimbuf
);
1639 /* Get the list of installed standard libraries from the
1640 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1644 __gnat_get_libraries_from_registry (void)
1646 char *result
= (char *) xmalloc (1);
1650 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
1653 DWORD name_size
, value_size
;
1660 /* First open the key. */
1661 res
= RegOpenKeyExA (HKEY_LOCAL_MACHINE
, "SOFTWARE", 0, KEY_READ
, ®_key
);
1663 if (res
== ERROR_SUCCESS
)
1664 res
= RegOpenKeyExA (reg_key
, "Ada Core Technologies", 0,
1665 KEY_READ
, ®_key
);
1667 if (res
== ERROR_SUCCESS
)
1668 res
= RegOpenKeyExA (reg_key
, "GNAT", 0, KEY_READ
, ®_key
);
1670 if (res
== ERROR_SUCCESS
)
1671 res
= RegOpenKeyExA (reg_key
, "Standard Libraries", 0, KEY_READ
, ®_key
);
1673 /* If the key exists, read out all the values in it and concatenate them
1675 for (index
= 0; res
== ERROR_SUCCESS
; index
++)
1677 value_size
= name_size
= 256;
1678 res
= RegEnumValueA (reg_key
, index
, name
, &name_size
, 0,
1679 &type
, (LPBYTE
)value
, &value_size
);
1681 if (res
== ERROR_SUCCESS
&& type
== REG_SZ
)
1683 char *old_result
= result
;
1685 result
= (char *) xmalloc (strlen (old_result
) + value_size
+ 2);
1686 strcpy (result
, old_result
);
1687 strcat (result
, value
);
1688 strcat (result
, ";");
1693 /* Remove the trailing ";". */
1695 result
[strlen (result
) - 1] = 0;
1701 /* Query information for the given file NAME and return it in STATBUF.
1702 * Returns 0 for success, or errno value for failure.
1705 __gnat_stat (char *name
, GNAT_STRUCT_STAT
*statbuf
)
1708 WIN32_FILE_ATTRIBUTE_DATA fad
;
1709 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1714 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1715 name_len
= _tcslen (wname
);
1717 if (name_len
> GNAT_MAX_PATH_LEN
)
1720 ZeroMemory (statbuf
, sizeof(GNAT_STRUCT_STAT
));
1722 res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
);
1725 error
= GetLastError();
1727 /* Check file existence using GetFileAttributes() which does not fail on
1728 special Windows files like con:, aux:, nul: etc... */
1730 if (GetFileAttributes(wname
) != INVALID_FILE_ATTRIBUTES
) {
1731 /* Just pretend that it is a regular and readable file */
1732 statbuf
->st_mode
= S_IFREG
| S_IREAD
| S_IWRITE
;
1737 case ERROR_ACCESS_DENIED
:
1738 case ERROR_SHARING_VIOLATION
:
1739 case ERROR_LOCK_VIOLATION
:
1740 case ERROR_SHARING_BUFFER_EXCEEDED
:
1742 case ERROR_BUFFER_OVERFLOW
:
1743 return ENAMETOOLONG
;
1744 case ERROR_NOT_ENOUGH_MEMORY
:
1751 f2t (&fad
.ftCreationTime
, &statbuf
->st_ctime
);
1752 f2t (&fad
.ftLastWriteTime
, &statbuf
->st_mtime
);
1753 f2t (&fad
.ftLastAccessTime
, &statbuf
->st_atime
);
1756 (__int64
)fad
.nFileSizeLow
| (__int64
)fad
.nFileSizeHigh
<< 32;
1758 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1759 statbuf
->st_mode
= S_IREAD
;
1761 if (fad
.dwFileAttributes
& FILE_ATTRIBUTE_DIRECTORY
)
1762 statbuf
->st_mode
|= S_IFDIR
;
1764 statbuf
->st_mode
|= S_IFREG
;
1766 if (!(fad
.dwFileAttributes
& FILE_ATTRIBUTE_READONLY
))
1767 statbuf
->st_mode
|= S_IWRITE
;
1772 return GNAT_STAT (name
, statbuf
) == 0 ? 0 : errno
;
1776 /*************************************************************************
1777 ** Check whether a file exists
1778 *************************************************************************/
1781 __gnat_file_exists_attr (char* name
, struct file_attributes
* attr
)
1783 if (attr
->exists
== ATTR_UNSET
)
1784 __gnat_stat_to_attr (-1, name
, attr
);
1786 return attr
->exists
;
1790 __gnat_file_exists (char *name
)
1792 struct file_attributes attr
;
1793 __gnat_reset_attributes (&attr
);
1794 return __gnat_file_exists_attr (name
, &attr
);
1797 /**********************************************************************
1798 ** Whether name is an absolute path
1799 **********************************************************************/
1802 __gnat_is_absolute_path (char *name
, int length
)
1805 /* On VxWorks systems, an absolute path can be represented (depending on
1806 the host platform) as either /dir/file, or device:/dir/file, or
1807 device:drive_letter:/dir/file. */
1814 for (index
= 0; index
< length
; index
++)
1816 if (name
[index
] == ':' &&
1817 ((name
[index
+ 1] == '/') ||
1818 (isalpha (name
[index
+ 1]) && index
+ 2 <= length
&&
1819 name
[index
+ 2] == '/')))
1822 else if (name
[index
] == '/')
1827 return (length
!= 0) &&
1828 (IS_DIRECTORY_SEPARATOR(*name
)
1829 #if defined (WINNT) || defined(__DJGPP__)
1830 || (length
> 2 && ISALPHA (name
[0]) && name
[1] == ':'
1831 && IS_DIRECTORY_SEPARATOR(name
[2]))
1838 __gnat_is_regular_file_attr (char* name
, struct file_attributes
* attr
)
1840 if (attr
->regular
== ATTR_UNSET
)
1841 __gnat_stat_to_attr (-1, name
, attr
);
1843 return attr
->regular
;
1847 __gnat_is_regular_file (char *name
)
1849 struct file_attributes attr
;
1851 __gnat_reset_attributes (&attr
);
1852 return __gnat_is_regular_file_attr (name
, &attr
);
1856 __gnat_is_regular_file_fd (int fd
)
1859 GNAT_STRUCT_STAT statbuf
;
1861 ret
= GNAT_FSTAT (fd
, &statbuf
);
1862 return (!ret
&& S_ISREG (statbuf
.st_mode
));
1866 __gnat_is_directory_attr (char* name
, struct file_attributes
* attr
)
1868 if (attr
->directory
== ATTR_UNSET
)
1869 __gnat_stat_to_attr (-1, name
, attr
);
1871 return attr
->directory
;
1875 __gnat_is_directory (char *name
)
1877 struct file_attributes attr
;
1879 __gnat_reset_attributes (&attr
);
1880 return __gnat_is_directory_attr (name
, &attr
);
1883 #if defined (_WIN32)
1885 /* Returns the same constant as GetDriveType but takes a pathname as
1889 GetDriveTypeFromPath (TCHAR
*wfullpath
)
1891 TCHAR wdrv
[MAX_PATH
];
1892 TCHAR wpath
[MAX_PATH
];
1893 TCHAR wfilename
[MAX_PATH
];
1894 TCHAR wext
[MAX_PATH
];
1896 _tsplitpath (wfullpath
, wdrv
, wpath
, wfilename
, wext
);
1898 if (_tcslen (wdrv
) != 0)
1900 /* we have a drive specified. */
1901 _tcscat (wdrv
, _T("\\"));
1902 return GetDriveType (wdrv
);
1906 /* No drive specified. */
1908 /* Is this a relative path, if so get current drive type. */
1909 if (wpath
[0] != _T('\\') ||
1910 (_tcslen (wpath
) > 2 && wpath
[0] == _T('\\')
1911 && wpath
[1] != _T('\\')))
1912 return GetDriveType (NULL
);
1914 UINT result
= GetDriveType (wpath
);
1916 /* Cannot guess the drive type, is this \\.\ ? */
1918 if (result
== DRIVE_NO_ROOT_DIR
&&
1919 _tcslen (wpath
) >= 4 && wpath
[0] == _T('\\') && wpath
[1] == _T('\\')
1920 && wpath
[2] == _T('.') && wpath
[3] == _T('\\'))
1922 if (_tcslen (wpath
) == 4)
1923 _tcscat (wpath
, wfilename
);
1925 LPTSTR p
= &wpath
[4];
1926 LPTSTR b
= _tcschr (p
, _T('\\'));
1930 /* logical drive \\.\c\dir\file */
1936 _tcscat (p
, _T(":\\"));
1938 return GetDriveType (p
);
1945 /* This MingW section contains code to work with ACL. */
1947 __gnat_check_OWNER_ACL (TCHAR
*wname
,
1948 DWORD CheckAccessDesired
,
1949 GENERIC_MAPPING CheckGenericMapping
)
1951 DWORD dwAccessDesired
, dwAccessAllowed
;
1952 PRIVILEGE_SET PrivilegeSet
;
1953 DWORD dwPrivSetSize
= sizeof (PRIVILEGE_SET
);
1954 BOOL fAccessGranted
= FALSE
;
1955 HANDLE hToken
= NULL
;
1957 PSECURITY_DESCRIPTOR pSD
= NULL
;
1960 (wname
, OWNER_SECURITY_INFORMATION
|
1961 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1964 if ((pSD
= (SECURITY_DESCRIPTOR
*) HeapAlloc
1965 (GetProcessHeap (), HEAP_ZERO_MEMORY
, nLength
)) == NULL
)
1968 /* Obtain the security descriptor. */
1970 if (!GetFileSecurity
1971 (wname
, OWNER_SECURITY_INFORMATION
|
1972 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1973 pSD
, nLength
, &nLength
))
1976 if (!ImpersonateSelf (SecurityImpersonation
))
1979 if (!OpenThreadToken
1980 (GetCurrentThread(), TOKEN_DUPLICATE
| TOKEN_QUERY
, FALSE
, &hToken
))
1983 /* Undoes the effect of ImpersonateSelf. */
1987 /* We want to test for write permissions. */
1989 dwAccessDesired
= CheckAccessDesired
;
1991 MapGenericMask (&dwAccessDesired
, &CheckGenericMapping
);
1994 (pSD
, /* security descriptor to check */
1995 hToken
, /* impersonation token */
1996 dwAccessDesired
, /* requested access rights */
1997 &CheckGenericMapping
, /* pointer to GENERIC_MAPPING */
1998 &PrivilegeSet
, /* receives privileges used in check */
1999 &dwPrivSetSize
, /* size of PrivilegeSet buffer */
2000 &dwAccessAllowed
, /* receives mask of allowed access rights */
2004 CloseHandle (hToken
);
2005 HeapFree (GetProcessHeap (), 0, pSD
);
2006 return fAccessGranted
;
2010 CloseHandle (hToken
);
2011 HeapFree (GetProcessHeap (), 0, pSD
);
2016 __gnat_set_OWNER_ACL (TCHAR
*wname
,
2017 ACCESS_MODE AccessMode
,
2018 DWORD AccessPermissions
)
2020 PACL pOldDACL
= NULL
;
2021 PACL pNewDACL
= NULL
;
2022 PSECURITY_DESCRIPTOR pSD
= NULL
;
2024 TCHAR username
[100];
2027 /* Get current user, he will act as the owner */
2029 if (!GetUserName (username
, &unsize
))
2032 if (GetNamedSecurityInfo
2035 DACL_SECURITY_INFORMATION
,
2036 NULL
, NULL
, &pOldDACL
, NULL
, &pSD
) != ERROR_SUCCESS
)
2039 BuildExplicitAccessWithName
2040 (&ea
, username
, AccessPermissions
, (ACCESS_MODE
) AccessMode
, NO_INHERITANCE
);
2042 if (AccessMode
== SET_ACCESS
)
2044 /* SET_ACCESS, we want to set an explicte set of permissions, do not
2045 merge with current DACL. */
2046 if (SetEntriesInAcl (1, &ea
, NULL
, &pNewDACL
) != ERROR_SUCCESS
)
2050 if (SetEntriesInAcl (1, &ea
, pOldDACL
, &pNewDACL
) != ERROR_SUCCESS
)
2053 if (SetNamedSecurityInfo
2054 (wname
, SE_FILE_OBJECT
,
2055 DACL_SECURITY_INFORMATION
, NULL
, NULL
, pNewDACL
, NULL
) != ERROR_SUCCESS
)
2059 LocalFree (pNewDACL
);
2062 /* Check if it is possible to use ACL for wname, the file must not be on a
2066 __gnat_can_use_acl (TCHAR
*wname
)
2068 return __gnat_use_acl
&& GetDriveTypeFromPath (wname
) != DRIVE_REMOTE
;
2071 #endif /* defined (_WIN32) */
2074 __gnat_is_readable_file_attr (char* name
, struct file_attributes
* attr
)
2076 if (attr
->readable
== ATTR_UNSET
)
2078 #if defined (_WIN32)
2079 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2080 GENERIC_MAPPING GenericMapping
;
2082 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2084 if (__gnat_can_use_acl (wname
))
2086 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
2087 GenericMapping
.GenericRead
= GENERIC_READ
;
2089 __gnat_check_OWNER_ACL (wname
, FILE_READ_DATA
, GenericMapping
);
2092 attr
->readable
= GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
;
2094 __gnat_stat_to_attr (-1, name
, attr
);
2098 return attr
->readable
;
2102 __gnat_is_read_accessible_file (char *name
)
2104 #if defined (_WIN32)
2105 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2107 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2109 return !_waccess (wname
, 4);
2111 #elif defined (__vxworks)
2114 if ((fd
= open (name
, O_RDONLY
, 0)) < 0)
2120 return !access (name
, R_OK
);
2125 __gnat_is_readable_file (char *name
)
2127 struct file_attributes attr
;
2129 __gnat_reset_attributes (&attr
);
2130 return __gnat_is_readable_file_attr (name
, &attr
);
2134 __gnat_is_writable_file_attr (char* name
, struct file_attributes
* attr
)
2136 if (attr
->writable
== ATTR_UNSET
)
2138 #if defined (_WIN32)
2139 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2140 GENERIC_MAPPING GenericMapping
;
2142 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2144 if (__gnat_can_use_acl (wname
))
2146 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
2147 GenericMapping
.GenericWrite
= GENERIC_WRITE
;
2149 attr
->writable
= __gnat_check_OWNER_ACL
2150 (wname
, FILE_WRITE_DATA
| FILE_APPEND_DATA
, GenericMapping
)
2151 && !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
2155 !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
2158 __gnat_stat_to_attr (-1, name
, attr
);
2162 return attr
->writable
;
2166 __gnat_is_writable_file (char *name
)
2168 struct file_attributes attr
;
2170 __gnat_reset_attributes (&attr
);
2171 return __gnat_is_writable_file_attr (name
, &attr
);
2175 __gnat_is_write_accessible_file (char *name
)
2177 #if defined (_WIN32)
2178 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2180 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2182 return !_waccess (wname
, 2);
2184 #elif defined (__vxworks)
2187 if ((fd
= open (name
, O_WRONLY
, 0)) < 0)
2193 return !access (name
, W_OK
);
2198 __gnat_is_executable_file_attr (char* name
, struct file_attributes
* attr
)
2200 if (attr
->executable
== ATTR_UNSET
)
2202 #if defined (_WIN32)
2203 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2204 GENERIC_MAPPING GenericMapping
;
2206 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2208 if (__gnat_can_use_acl (wname
))
2210 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
2211 GenericMapping
.GenericExecute
= GENERIC_EXECUTE
;
2214 __gnat_check_OWNER_ACL (wname
, FILE_EXECUTE
, GenericMapping
);
2218 TCHAR
*l
, *last
= _tcsstr(wname
, _T(".exe"));
2220 /* look for last .exe */
2222 while ((l
= _tcsstr(last
+1, _T(".exe"))))
2226 GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
2227 && (last
- wname
) == (int) (_tcslen (wname
) - 4);
2230 __gnat_stat_to_attr (-1, name
, attr
);
2234 return attr
->regular
&& attr
->executable
;
2238 __gnat_is_executable_file (char *name
)
2240 struct file_attributes attr
;
2242 __gnat_reset_attributes (&attr
);
2243 return __gnat_is_executable_file_attr (name
, &attr
);
2247 __gnat_set_writable (char *name
)
2249 #if defined (_WIN32)
2250 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2252 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2254 if (__gnat_can_use_acl (wname
))
2255 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_WRITE
);
2258 (wname
, GetFileAttributes (wname
) & ~FILE_ATTRIBUTE_READONLY
);
2259 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2260 GNAT_STRUCT_STAT statbuf
;
2262 if (GNAT_STAT (name
, &statbuf
) == 0)
2264 statbuf
.st_mode
= statbuf
.st_mode
| S_IWUSR
;
2265 chmod (name
, statbuf
.st_mode
);
2270 /* must match definition in s-os_lib.ads */
2276 __gnat_set_executable (char *name
, int mode ATTRIBUTE_UNUSED
)
2278 #if defined (_WIN32)
2279 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2281 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2283 if (__gnat_can_use_acl (wname
))
2284 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_EXECUTE
);
2286 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2287 GNAT_STRUCT_STAT statbuf
;
2289 if (GNAT_STAT (name
, &statbuf
) == 0)
2292 statbuf
.st_mode
= statbuf
.st_mode
| S_IXUSR
;
2294 statbuf
.st_mode
= statbuf
.st_mode
| S_IXGRP
;
2295 if (mode
& S_OTHERS
)
2296 statbuf
.st_mode
= statbuf
.st_mode
| S_IXOTH
;
2297 chmod (name
, statbuf
.st_mode
);
2303 __gnat_set_non_writable (char *name
)
2305 #if defined (_WIN32)
2306 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2308 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2310 if (__gnat_can_use_acl (wname
))
2311 __gnat_set_OWNER_ACL
2312 (wname
, DENY_ACCESS
,
2313 FILE_WRITE_DATA
| FILE_APPEND_DATA
|
2314 FILE_WRITE_EA
| FILE_WRITE_ATTRIBUTES
);
2317 (wname
, GetFileAttributes (wname
) | FILE_ATTRIBUTE_READONLY
);
2318 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2319 GNAT_STRUCT_STAT statbuf
;
2321 if (GNAT_STAT (name
, &statbuf
) == 0)
2323 statbuf
.st_mode
= statbuf
.st_mode
& 07577;
2324 chmod (name
, statbuf
.st_mode
);
2330 __gnat_set_readable (char *name
)
2332 #if defined (_WIN32)
2333 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2335 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2337 if (__gnat_can_use_acl (wname
))
2338 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_READ
);
2340 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2341 GNAT_STRUCT_STAT statbuf
;
2343 if (GNAT_STAT (name
, &statbuf
) == 0)
2345 chmod (name
, statbuf
.st_mode
| S_IREAD
);
2351 __gnat_set_non_readable (char *name
)
2353 #if defined (_WIN32)
2354 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2356 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2358 if (__gnat_can_use_acl (wname
))
2359 __gnat_set_OWNER_ACL (wname
, DENY_ACCESS
, FILE_GENERIC_READ
);
2361 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2362 GNAT_STRUCT_STAT statbuf
;
2364 if (GNAT_STAT (name
, &statbuf
) == 0)
2366 chmod (name
, statbuf
.st_mode
& (~S_IREAD
));
2372 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED
,
2373 struct file_attributes
* attr
)
2375 if (attr
->symbolic_link
== ATTR_UNSET
)
2377 #if defined (__vxworks)
2378 attr
->symbolic_link
= 0;
2380 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2382 GNAT_STRUCT_STAT statbuf
;
2383 ret
= GNAT_LSTAT (name
, &statbuf
);
2384 attr
->symbolic_link
= (!ret
&& S_ISLNK (statbuf
.st_mode
));
2386 attr
->symbolic_link
= 0;
2389 return attr
->symbolic_link
;
2393 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED
)
2395 struct file_attributes attr
;
2397 __gnat_reset_attributes (&attr
);
2398 return __gnat_is_symbolic_link_attr (name
, &attr
);
2401 #if defined (__sun__)
2402 /* Using fork on Solaris will duplicate all the threads. fork1, which
2403 duplicates only the active thread, must be used instead, or spawning
2404 subprocess from a program with tasking will lead into numerous problems. */
2409 __gnat_portable_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2411 int status ATTRIBUTE_UNUSED
= 0;
2412 int finished ATTRIBUTE_UNUSED
;
2413 int pid ATTRIBUTE_UNUSED
;
2415 #if defined (__vxworks) || defined(__PikeOS__)
2418 #elif defined (__DJGPP__) || defined (_WIN32)
2419 /* args[0] must be quotes as it could contain a full pathname with spaces */
2420 char *args_0
= args
[0];
2421 args
[0] = (char *)xmalloc (strlen (args_0
) + 3);
2422 strcpy (args
[0], "\"");
2423 strcat (args
[0], args_0
);
2424 strcat (args
[0], "\"");
2426 status
= spawnvp (P_WAIT
, args_0
, (char ** const)args
);
2428 /* restore previous value */
2430 args
[0] = (char *)args_0
;
2446 execv (args
[0], MAYBE_TO_PTR32 (args
));
2448 /* execv() returns only on error */
2453 finished
= waitpid (pid
, &status
, 0);
2455 if (finished
!= pid
|| WIFEXITED (status
) == 0)
2458 return WEXITSTATUS (status
);
2464 /* Create a copy of the given file descriptor.
2465 Return -1 if an error occurred. */
2468 __gnat_dup (int oldfd
)
2470 #if defined (__vxworks) && !defined (__RTP__)
2471 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2479 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2480 Return -1 if an error occurred. */
2483 __gnat_dup2 (int oldfd ATTRIBUTE_UNUSED
, int newfd ATTRIBUTE_UNUSED
)
2485 #if defined (__vxworks) && !defined (__RTP__)
2486 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2489 #elif defined (__PikeOS__)
2490 /* Not supported. */
2492 #elif defined (_WIN32)
2493 /* Special case when oldfd and newfd are identical and are the standard
2494 input, output or error as this makes Windows XP hangs. Note that we
2495 do that only for standard file descriptors that are known to be valid. */
2496 if (oldfd
== newfd
&& newfd
>= 0 && newfd
<= 2)
2499 return dup2 (oldfd
, newfd
);
2501 return dup2 (oldfd
, newfd
);
2506 __gnat_number_of_cpus (void)
2510 #if defined (_SC_NPROCESSORS_ONLN)
2511 cores
= (int) sysconf (_SC_NPROCESSORS_ONLN
);
2513 #elif defined (__QNX__)
2514 cores
= (int) _syspage_ptr
->num_cpu
;
2516 #elif defined (__hpux__)
2517 struct pst_dynamic psd
;
2518 if (pstat_getdynamic (&psd
, sizeof (psd
), 1, 0) != -1)
2519 cores
= (int) psd
.psd_proc_cnt
;
2521 #elif defined (_WIN32)
2522 SYSTEM_INFO sysinfo
;
2523 GetSystemInfo (&sysinfo
);
2524 cores
= (int) sysinfo
.dwNumberOfProcessors
;
2526 #elif defined (_WRS_CONFIG_SMP)
2527 unsigned int vxCpuConfiguredGet (void);
2529 cores
= vxCpuConfiguredGet ();
2536 /* WIN32 code to implement a wait call that wait for any child process. */
2538 #if defined (_WIN32)
2540 /* Synchronization code, to be thread safe. */
2544 /* For the Cert run times on native Windows we use dummy functions
2545 for locking and unlocking tasks since we do not support multiple
2546 threads on this configuration (Cert run time on native Windows). */
2548 static void EnterCS (void) {}
2549 static void LeaveCS (void) {}
2550 static void SignalListChanged (void) {}
2554 CRITICAL_SECTION ProcListCS
;
2555 HANDLE ProcListEvt
= NULL
;
2557 static void EnterCS (void)
2559 EnterCriticalSection(&ProcListCS
);
2562 static void LeaveCS (void)
2564 LeaveCriticalSection(&ProcListCS
);
2567 static void SignalListChanged (void)
2569 SetEvent (ProcListEvt
);
2574 static HANDLE
*HANDLES_LIST
= NULL
;
2575 static int *PID_LIST
= NULL
, plist_length
= 0, plist_max_length
= 0;
2578 add_handle (HANDLE h
, int pid
)
2580 /* -------------------- critical section -------------------- */
2583 if (plist_length
== plist_max_length
)
2585 plist_max_length
+= 100;
2587 (HANDLE
*) xrealloc (HANDLES_LIST
, sizeof (HANDLE
) * plist_max_length
);
2589 (int *) xrealloc (PID_LIST
, sizeof (int) * plist_max_length
);
2592 HANDLES_LIST
[plist_length
] = h
;
2593 PID_LIST
[plist_length
] = pid
;
2596 SignalListChanged();
2598 /* -------------------- critical section -------------------- */
2602 __gnat_win32_remove_handle (HANDLE h
, int pid
)
2607 /* -------------------- critical section -------------------- */
2610 for (j
= 0; j
< plist_length
; j
++)
2612 if ((HANDLES_LIST
[j
] == h
) || (PID_LIST
[j
] == pid
))
2616 HANDLES_LIST
[j
] = HANDLES_LIST
[plist_length
];
2617 PID_LIST
[j
] = PID_LIST
[plist_length
];
2624 /* -------------------- critical section -------------------- */
2627 SignalListChanged();
2633 win32_no_block_spawn (char *command
, char *args
[], HANDLE
*h
, int *pid
)
2637 PROCESS_INFORMATION PI
;
2638 SECURITY_ATTRIBUTES SA
;
2643 /* compute the total command line length */
2647 csize
+= strlen (args
[k
]) + 1;
2651 full_command
= (char *) xmalloc (csize
);
2654 SI
.cb
= sizeof (STARTUPINFO
);
2655 SI
.lpReserved
= NULL
;
2656 SI
.lpReserved2
= NULL
;
2657 SI
.lpDesktop
= NULL
;
2661 SI
.wShowWindow
= SW_HIDE
;
2663 /* Security attributes. */
2664 SA
.nLength
= sizeof (SECURITY_ATTRIBUTES
);
2665 SA
.bInheritHandle
= TRUE
;
2666 SA
.lpSecurityDescriptor
= NULL
;
2668 /* Prepare the command string. */
2669 strcpy (full_command
, command
);
2670 strcat (full_command
, " ");
2675 strcat (full_command
, args
[k
]);
2676 strcat (full_command
, " ");
2681 int wsize
= csize
* 2;
2682 TCHAR
*wcommand
= (TCHAR
*) xmalloc (wsize
);
2684 S2WSC (wcommand
, full_command
, wsize
);
2686 free (full_command
);
2688 result
= CreateProcess
2689 (NULL
, wcommand
, &SA
, NULL
, TRUE
,
2690 GetPriorityClass (GetCurrentProcess()), NULL
, NULL
, &SI
, &PI
);
2697 CloseHandle (PI
.hThread
);
2699 *pid
= PI
.dwProcessId
;
2709 win32_wait (int *status
)
2711 DWORD exitcode
, pid
;
2722 if (plist_length
== 0)
2728 /* -------------------- critical section -------------------- */
2731 /* ??? We can't wait for more than MAXIMUM_WAIT_OBJECTS due to a Win32
2733 if (plist_length
< MAXIMUM_WAIT_OBJECTS
)
2734 hl_len
= plist_length
;
2742 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * hl_len
);
2743 memmove (hl
, HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2744 pidl
= (int *) xmalloc (sizeof (int) * hl_len
);
2745 memmove (pidl
, PID_LIST
, sizeof (int) * hl_len
);
2747 /* Note that index 0 contains the event handle that is signaled when the
2748 process list has changed */
2749 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * (hl_len
+ 1));
2750 hl
[0] = ProcListEvt
;
2751 memmove (&hl
[1], HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2752 pidl
= (int *) xmalloc (sizeof (int) * (hl_len
+ 1));
2753 memmove (&pidl
[1], PID_LIST
, sizeof (int) * hl_len
);
2758 /* -------------------- critical section -------------------- */
2760 res
= WaitForMultipleObjects (hl_len
, hl
, FALSE
, INFINITE
);
2762 /* If there was an error, exit now */
2763 if (res
== WAIT_FAILED
)
2771 /* if the ProcListEvt has been signaled then the list of processes has been
2772 updated to add or remove a handle, just loop over */
2774 if (res
- WAIT_OBJECT_0
== 0)
2781 /* Handle two distinct groups of return codes: finished waits and abandoned
2784 if (res
< WAIT_ABANDONED_0
)
2785 pos
= res
- WAIT_OBJECT_0
;
2787 pos
= res
- WAIT_ABANDONED_0
;
2790 GetExitCodeProcess (h
, &exitcode
);
2793 found
= __gnat_win32_remove_handle (h
, -1);
2798 /* if not found another process waiting has already handled this process */
2805 *status
= (int) exitcode
;
2812 __gnat_portable_no_block_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2815 #if defined (__vxworks) || defined (__PikeOS__)
2816 /* Not supported. */
2819 #elif defined(__DJGPP__)
2820 if (spawnvp (P_WAIT
, args
[0], args
) != 0)
2825 #elif defined (_WIN32)
2830 win32_no_block_spawn (args
[0], args
, &h
, &pid
);
2833 add_handle (h
, pid
);
2846 execv (args
[0], MAYBE_TO_PTR32 (args
));
2848 /* execv() returns only on error */
2858 __gnat_portable_wait (int *process_status
)
2863 #if defined (__vxworks) || defined (__PikeOS__)
2864 /* Not sure what to do here, so do nothing but return zero. */
2866 #elif defined (_WIN32)
2868 pid
= win32_wait (&status
);
2870 #elif defined (__DJGPP__)
2871 /* Child process has already ended in case of DJGPP.
2872 No need to do anything. Just return success. */
2875 pid
= waitpid (-1, &status
, 0);
2876 status
= status
& 0xffff;
2879 *process_status
= status
;
2884 __gnat_portable_no_block_wait (int *process_status
)
2889 #if defined (__vxworks) || defined (__PikeOS__) || defined (_WIN32)
2890 /* Not supported. */
2895 pid
= waitpid (-1, &status
, WNOHANG
);
2896 status
= status
& 0xffff;
2899 *process_status
= status
;
2904 __gnat_os_exit (int status
)
2910 __gnat_current_process_id (void)
2912 #if defined (__vxworks) || defined (__PikeOS__)
2915 #elif defined (_WIN32)
2917 return (int)GetCurrentProcessId();
2921 return (int)getpid();
2925 /* Locate file on path, that matches a predicate */
2928 __gnat_locate_file_with_predicate (char *file_name
, char *path_val
,
2929 int (*predicate
)(char *))
2932 char *file_path
= (char *) alloca (strlen (file_name
) + 1);
2935 /* Return immediately if file_name is empty */
2937 if (*file_name
== '\0')
2940 /* Remove quotes around file_name if present */
2946 strcpy (file_path
, ptr
);
2948 ptr
= file_path
+ strlen (file_path
) - 1;
2953 /* Handle absolute pathnames. */
2955 absolute
= __gnat_is_absolute_path (file_path
, strlen (file_name
));
2959 if (predicate (file_path
))
2960 return xstrdup (file_path
);
2965 /* If file_name include directory separator(s), try it first as
2966 a path name relative to the current directory */
2967 for (ptr
= file_name
; *ptr
&& !IS_DIRECTORY_SEPARATOR(*ptr
); ptr
++)
2972 if (predicate (file_name
))
2973 return xstrdup (file_name
);
2980 /* The result has to be smaller than path_val + file_name. */
2982 (char *) alloca (strlen (path_val
) + strlen (file_name
) + 2);
2986 /* Skip the starting quote */
2988 if (*path_val
== '"')
2991 for (ptr
= file_path
; *path_val
&& *path_val
!= PATH_SEPARATOR
; )
2992 *ptr
++ = *path_val
++;
2994 /* If directory is empty, it is the current directory*/
2996 if (ptr
== file_path
)
3003 /* Skip the ending quote */
3008 if (!IS_DIRECTORY_SEPARATOR(*ptr
))
3009 *++ptr
= DIR_SEPARATOR
;
3011 strcpy (++ptr
, file_name
);
3013 if (predicate (file_path
))
3014 return xstrdup (file_path
);
3019 /* Skip path separator */
3028 /* Locate an executable file, give a Path value. */
3031 __gnat_locate_executable_file (char *file_name
, char *path_val
)
3033 return __gnat_locate_file_with_predicate
3034 (file_name
, path_val
, &__gnat_is_executable_file
);
3037 /* Locate a regular file, give a Path value. */
3040 __gnat_locate_regular_file (char *file_name
, char *path_val
)
3042 return __gnat_locate_file_with_predicate
3043 (file_name
, path_val
, &__gnat_is_regular_file
);
3046 /* Locate an executable given a Path argument. This routine is only used by
3047 gnatbl and should not be used otherwise. Use locate_exec_on_path
3051 __gnat_locate_exec (char *exec_name
, char *path_val
)
3053 const unsigned int len
= strlen (HOST_EXECUTABLE_SUFFIX
);
3056 if (len
> 0 && !strstr (exec_name
, HOST_EXECUTABLE_SUFFIX
))
3058 char *full_exec_name
= (char *) alloca (strlen (exec_name
) + len
+ 1);
3060 strcpy (full_exec_name
, exec_name
);
3061 strcat (full_exec_name
, HOST_EXECUTABLE_SUFFIX
);
3062 ptr
= __gnat_locate_executable_file (full_exec_name
, path_val
);
3065 return __gnat_locate_executable_file (exec_name
, path_val
);
3069 return __gnat_locate_executable_file (exec_name
, path_val
);
3072 /* Locate an executable using the Systems default PATH. */
3075 __gnat_locate_exec_on_path (char *exec_name
)
3079 #if defined (_WIN32)
3080 TCHAR
*wpath_val
= _tgetenv (_T("PATH"));
3082 /* In Win32 systems we expand the PATH as for XP environment
3083 variables are not automatically expanded. We also prepend the
3084 ".;" to the path to match normal NT path search semantics */
3086 #define EXPAND_BUFFER_SIZE 32767
3088 wapath_val
= (TCHAR
*) alloca (EXPAND_BUFFER_SIZE
);
3090 wapath_val
[0] = '.';
3091 wapath_val
[1] = ';';
3093 DWORD res
= ExpandEnvironmentStrings
3094 (wpath_val
, &wapath_val
[2], EXPAND_BUFFER_SIZE
- 2);
3096 if (!res
) wapath_val
[0] = _T('\0');
3098 apath_val
= (char *) alloca (EXPAND_BUFFER_SIZE
);
3100 WS2SC (apath_val
, wapath_val
, EXPAND_BUFFER_SIZE
);
3103 const char *path_val
= getenv ("PATH");
3105 /* If PATH is not defined, proceed with __gnat_locate_exec anyway, so we can
3106 find files that contain directory names. */
3108 if (path_val
== NULL
) path_val
= "";
3109 apath_val
= (char *) alloca (strlen (path_val
) + 1);
3110 strcpy (apath_val
, path_val
);
3113 return __gnat_locate_exec (exec_name
, apath_val
);
3116 /* Dummy functions for Osint import for non-VMS systems.
3117 ??? To be removed. */
3120 __gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED
,
3121 int onlydirs ATTRIBUTE_UNUSED
)
3127 __gnat_to_canonical_file_list_next (void)
3129 static char empty
[] = "";
3134 __gnat_to_canonical_file_list_free (void)
3139 __gnat_to_canonical_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
3145 __gnat_to_canonical_file_spec (char *filespec
)
3151 __gnat_to_canonical_path_spec (char *pathspec
)
3157 __gnat_to_host_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
3163 __gnat_to_host_file_spec (char *filespec
)
3169 __gnat_adjust_os_resource_limits (void)
3173 #if defined (__mips_vxworks)
3177 CACHE_USER_FLUSH (0, ENTIRE_CACHE
);
3181 #if defined (_WIN32)
3182 int __gnat_argument_needs_quote
= 1;
3184 int __gnat_argument_needs_quote
= 0;
3187 /* This option is used to enable/disable object files handling from the
3188 binder file by the GNAT Project module. For example, this is disabled on
3189 Windows (prior to GCC 3.4) as it is already done by the mdll module.
3190 Stating with GCC 3.4 the shared libraries are not based on mdll
3191 anymore as it uses the GCC's -shared option */
3192 #if defined (_WIN32) \
3193 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
3194 int __gnat_prj_add_obj_files
= 0;
3196 int __gnat_prj_add_obj_files
= 1;
3199 /* char used as prefix/suffix for environment variables */
3200 #if defined (_WIN32)
3201 char __gnat_environment_char
= '%';
3203 char __gnat_environment_char
= '$';
3206 /* This functions copy the file attributes from a source file to a
3209 mode = 0 : In this mode copy only the file time stamps (last access and
3210 last modification time stamps).
3212 mode = 1 : In this mode, time stamps and read/write/execute attributes are
3215 mode = 2 : In this mode, only read/write/execute attributes are copied
3217 Returns 0 if operation was successful and -1 in case of error. */
3220 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED
, char *to ATTRIBUTE_UNUSED
,
3221 int mode ATTRIBUTE_UNUSED
)
3223 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
3226 #elif defined (_WIN32)
3227 TCHAR wfrom
[GNAT_MAX_PATH_LEN
+ 2];
3228 TCHAR wto
[GNAT_MAX_PATH_LEN
+ 2];
3230 FILETIME fct
, flat
, flwt
;
3233 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
+ 2);
3234 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
+ 2);
3236 /* Do we need to copy the timestamp ? */
3239 /* retrieve from times */
3242 (wfrom
, GENERIC_READ
, 0, NULL
, OPEN_EXISTING
,
3243 FILE_ATTRIBUTE_NORMAL
, NULL
);
3245 if (hfrom
== INVALID_HANDLE_VALUE
)
3248 res
= GetFileTime (hfrom
, &fct
, &flat
, &flwt
);
3250 CloseHandle (hfrom
);
3255 /* retrieve from times */
3258 (wto
, GENERIC_WRITE
, 0, NULL
, OPEN_EXISTING
,
3259 FILE_ATTRIBUTE_NORMAL
, NULL
);
3261 if (hto
== INVALID_HANDLE_VALUE
)
3264 res
= SetFileTime (hto
, NULL
, &flat
, &flwt
);
3272 /* Do we need to copy the permissions ? */
3273 /* Set file attributes in full mode. */
3277 DWORD attribs
= GetFileAttributes (wfrom
);
3279 if (attribs
== INVALID_FILE_ATTRIBUTES
)
3282 res
= SetFileAttributes (wto
, attribs
);
3290 GNAT_STRUCT_STAT fbuf
;
3292 if (GNAT_STAT (from
, &fbuf
) == -1) {
3296 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 7)
3298 /* VxWorks prior to 7 only has utime. */
3300 /* Do we need to copy the timestamp ? */
3302 struct utimbuf tbuf
;
3304 tbuf
.actime
= fbuf
.st_atime
;
3305 tbuf
.modtime
= fbuf
.st_mtime
;
3307 if (utime (to
, &tbuf
) == -1)
3311 #elif _POSIX_C_SOURCE >= 200809L
3312 struct timespec tbuf
[2];
3315 tbuf
[0] = fbuf
.st_atim
;
3316 tbuf
[1] = fbuf
.st_mtim
;
3318 if (utimensat (AT_FDCWD
, to
, tbuf
, 0) == -1) {
3324 struct timeval tbuf
[2];
3325 /* Do we need to copy timestamp ? */
3328 tbuf
[0].tv_sec
= fbuf
.st_atime
;
3329 tbuf
[1].tv_sec
= fbuf
.st_mtime
;
3331 #if defined(st_mtime)
3332 tbuf
[0].tv_usec
= fbuf
.st_atim
.tv_nsec
/ 1000;
3333 tbuf
[1].tv_usec
= fbuf
.st_mtim
.tv_nsec
/ 1000;
3335 tbuf
[0].tv_usec
= 0;
3336 tbuf
[1].tv_usec
= 0;
3339 if (utimes (to
, tbuf
) == -1) {
3345 /* Do we need to copy file permissions ? */
3346 if (mode
!= 0 && (chmod (to
, fbuf
.st_mode
) == -1)) {
3355 __gnat_lseek (int fd
, long offset
, int whence
)
3357 return (int) lseek (fd
, offset
, whence
);
3360 /* This function returns the major version number of GCC being used. */
3362 get_gcc_version (void)
3367 return (int) (version_string
[0] - '0');
3372 * Set Close_On_Exec as indicated.
3373 * Note: this is used for both GNAT.OS_Lib and GNAT.Sockets.
3377 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED
,
3378 int close_on_exec_p ATTRIBUTE_UNUSED
)
3380 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
3381 int flags
= fcntl (fd
, F_GETFD
, 0);
3384 if (close_on_exec_p
)
3385 flags
|= FD_CLOEXEC
;
3387 flags
&= ~FD_CLOEXEC
;
3388 return fcntl (fd
, F_SETFD
, flags
);
3389 #elif defined(_WIN32)
3390 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
3391 if (h
== (HANDLE
) -1)
3393 if (close_on_exec_p
)
3394 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
, 0);
3395 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
,
3396 HANDLE_FLAG_INHERIT
);
3398 /* TODO: Unimplemented. */
3403 /* Indicates if platforms supports automatic initialization through the
3404 constructor mechanism */
3406 __gnat_binder_supports_auto_init (void)
3411 /* Indicates that Stand-Alone Libraries are automatically initialized through
3412 the constructor mechanism */
3414 __gnat_sals_init_using_constructors (void)
3416 #if defined (__vxworks) || defined (__Lynx__)
3423 #if defined (__linux__) || defined (__ANDROID__)
3424 /* There is no function in the glibc to retrieve the LWP of the current
3425 thread. We need to do a system call in order to retrieve this
3427 #include <sys/syscall.h>
3429 __gnat_lwp_self (void)
3431 return (void *) syscall (__NR_gettid
);
3435 #if defined (__APPLE__)
3436 # if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1060
3437 # include <mach/thread_info.h>
3438 # include <mach/mach_init.h>
3439 # include <mach/thread_act.h>
3441 # include <pthread.h>
3444 /* System-wide thread identifier. Note it could be truncated on 32 bit
3446 Previously was: pthread_mach_thread_np (pthread_self ()). */
3448 __gnat_lwp_self (void)
3450 #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1060
3451 thread_identifier_info_data_t data
;
3452 mach_msg_type_number_t count
= THREAD_IDENTIFIER_INFO_COUNT
;
3455 kret
= thread_info (mach_thread_self (), THREAD_IDENTIFIER_INFO
,
3456 (thread_info_t
) &data
, &count
);
3457 if (kret
== KERN_SUCCESS
)
3458 return (void *)(uintptr_t)data
.thread_id
;
3462 return (void *)pthread_mach_thread_np (pthread_self ());
3467 #if defined (__linux__)
3470 /* glibc versions earlier than 2.7 do not define the routines to handle
3471 dynamically allocated CPU sets. For these targets, we use the static
3476 /* Dynamic cpu sets */
3479 __gnat_cpu_alloc (size_t count
)
3481 return CPU_ALLOC (count
);
3485 __gnat_cpu_alloc_size (size_t count
)
3487 return CPU_ALLOC_SIZE (count
);
3491 __gnat_cpu_free (cpu_set_t
*set
)
3497 __gnat_cpu_zero (size_t count
, cpu_set_t
*set
)
3499 CPU_ZERO_S (count
, set
);
3503 __gnat_cpu_set (int cpu
, size_t count
, cpu_set_t
*set
)
3505 /* Ada handles CPU numbers starting from 1, while C identifies the first
3506 CPU by a 0, so we need to adjust. */
3507 CPU_SET_S (cpu
- 1, count
, set
);
3510 #else /* !CPU_ALLOC */
3512 /* Static cpu sets */
3515 __gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED
)
3517 return (cpu_set_t
*) xmalloc (sizeof (cpu_set_t
));
3521 __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED
)
3523 return sizeof (cpu_set_t
);
3527 __gnat_cpu_free (cpu_set_t
*set
)
3533 __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3539 __gnat_cpu_set (int cpu
, size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3541 /* Ada handles CPU numbers starting from 1, while C identifies the first
3542 CPU by a 0, so we need to adjust. */
3543 CPU_SET (cpu
- 1, set
);
3545 #endif /* !CPU_ALLOC */
3546 #endif /* __linux__ */
3548 /* Return the load address of the executable, or 0 if not known. In the
3549 specific case of error, (void *)-1 can be returned. Beware: this unit may
3550 be in a shared library. As low-level units are needed, we allow #include
3553 #if defined (__APPLE__)
3554 #include <mach-o/dyld.h>
3555 #elif defined (__linux__)
3556 #include <features.h>
3561 __gnat_get_executable_load_address (void)
3563 #if defined (__APPLE__)
3564 return _dyld_get_image_header (0);
3566 #elif defined (__linux__) && (defined (__GLIBC__) || defined (__UCLIBC__))
3567 struct link_map
*map
= _r_debug
.r_map
;
3568 return (const void *)map
->l_addr
;
3570 #elif defined (_WIN32)
3571 return GetModuleHandle (NULL
);
3579 __gnat_kill (int pid
, int sig
)
3585 case 9: // SIGKILL is not declared in Windows headers
3590 h
= OpenProcess (PROCESS_ALL_ACCESS
, FALSE
, pid
);
3592 TerminateProcess (h
, sig
);
3597 #elif defined (__vxworks)
3598 /* Not implemented */
3604 void __gnat_killprocesstree (int pid
, int sig_num
)
3609 memset(&pe
, 0, sizeof(PROCESSENTRY32
));
3610 pe
.dwSize
= sizeof(PROCESSENTRY32
);
3612 HANDLE hSnap
= CreateToolhelp32Snapshot (TH32CS_SNAPPROCESS
, 0);
3614 /* cannot take snapshot, just kill the parent process */
3616 if (hSnap
== INVALID_HANDLE_VALUE
)
3618 __gnat_kill (pid
, sig_num
);
3622 if (Process32First(hSnap
, &pe
))
3624 BOOL bContinue
= TRUE
;
3626 /* kill child processes first */
3630 if (pe
.th32ParentProcessID
== (DWORD
)pid
)
3631 __gnat_killprocesstree (pe
.th32ProcessID
, sig_num
);
3633 bContinue
= Process32Next (hSnap
, &pe
);
3637 CloseHandle (hSnap
);
3641 __gnat_kill (pid
, sig_num
);
3643 #elif defined (__vxworks)
3644 /* not implemented */
3646 #elif defined (__linux__)
3650 /* read all processes' pid and ppid */
3652 dir
= opendir ("/proc");
3654 /* cannot open proc, just kill the parent process */
3658 __gnat_kill (pid
, sig_num
);
3662 /* kill child processes first */
3664 while ((d
= readdir (dir
)) != NULL
)
3666 if ((d
->d_type
& DT_DIR
) == DT_DIR
)
3671 /* read /proc/<PID>/stat */
3673 if (strlen (d
->d_name
) >= sizeof (statfile
) - strlen ("/proc//stat"))
3675 strcpy (statfile
, "/proc/");
3676 strcat (statfile
, d
->d_name
);
3677 strcat (statfile
, "/stat");
3679 FILE *fd
= fopen (statfile
, "r");
3683 const int match
= fscanf (fd
, "%d %*s %*s %d", &_pid
, &_ppid
);
3686 if (match
== 2 && _ppid
== pid
)
3687 __gnat_killprocesstree (_pid
, sig_num
);
3696 __gnat_kill (pid
, sig_num
);
3698 __gnat_kill (pid
, sig_num
);
3700 /* Note on Solaris it is possible to read /proc/<PID>/status.
3701 The 5th and 6th words are the pid and the 7th and 8th the ppid.
3702 See: /usr/include/sys/procfs.h (struct pstatus).