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 #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)
230 /* Cannot redefine abort here. */
233 #define WIN32_LEAN_AND_MEAN
237 #include <tlhelp32.h>
240 #define DIR_SEPARATOR '\\'
248 int __gnat_in_child_after_fork
= 0;
250 #if defined (__APPLE__) && defined (st_mtime)
251 #define st_atim st_atimespec
252 #define st_mtim st_mtimespec
255 /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
256 defined in the current system. On DOS-like systems these flags control
257 whether the file is opened/created in text-translation mode (CR/LF in
258 external file mapped to LF in internal file), but in Unix-like systems,
259 no text translation is required, so these flags have no effect. */
269 #ifndef HOST_EXECUTABLE_SUFFIX
270 #define HOST_EXECUTABLE_SUFFIX ""
273 #ifndef HOST_OBJECT_SUFFIX
274 #define HOST_OBJECT_SUFFIX ".o"
277 #ifndef PATH_SEPARATOR
278 #define PATH_SEPARATOR ':'
281 #ifndef DIR_SEPARATOR
282 #define DIR_SEPARATOR '/'
283 #define IS_DIRECTORY_SEPARATOR(c) ((c) == DIR_SEPARATOR)
285 #define IS_DIRECTORY_SEPARATOR(c) ((c) == '/' || (c) == DIR_SEPARATOR)
288 /* Check for cross-compilation. */
289 #if defined (CROSS_COMPILE) || defined (CROSS_DIRECTORY_STRUCTURE)
291 int __gnat_is_cross_compiler
= 1;
294 int __gnat_is_cross_compiler
= 0;
297 char __gnat_dir_separator
= DIR_SEPARATOR
;
299 char __gnat_path_separator
= PATH_SEPARATOR
;
301 /* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
302 the base filenames that libraries specified with -lsomelib options
303 may have. This is used by GNATMAKE to check whether an executable
304 is up-to-date or not. The syntax is
306 library_template ::= { pattern ; } pattern NUL
307 pattern ::= [ prefix ] * [ postfix ]
309 These should only specify names of static libraries as it makes
310 no sense to determine at link time if dynamic-link libraries are
311 up to date or not. Any libraries that are not found are supposed
314 * if they are needed but not present, the link
317 * otherwise they are libraries in the system paths and so
318 they are considered part of the system and not checked
321 ??? This should be part of a GNAT host-specific compiler
322 file instead of being included in all user applications
323 as well. This is only a temporary work-around for 3.11b. */
325 #ifndef GNAT_LIBRARY_TEMPLATE
326 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
329 const char *__gnat_library_template
= GNAT_LIBRARY_TEMPLATE
;
331 #if defined (__vxworks)
332 #define GNAT_MAX_PATH_LEN PATH_MAX
336 #if defined (__MINGW32__)
339 #include <sys/param.h>
343 #define GNAT_MAX_PATH_LEN MAXPATHLEN
345 #define GNAT_MAX_PATH_LEN 256
350 /* Used for runtime check that Ada constant File_Attributes_Size is no
351 less than the actual size of struct file_attributes (see Osint
353 int __gnat_size_of_file_attributes
= sizeof (struct file_attributes
);
355 void __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
);
357 /* The __gnat_max_path_len variable is used to export the maximum
358 length of a path name to Ada code. max_path_len is also provided
359 for compatibility with older GNAT versions, please do not use
362 int __gnat_max_path_len
= GNAT_MAX_PATH_LEN
;
363 int max_path_len
= GNAT_MAX_PATH_LEN
;
365 /* Control whether we can use ACL on Windows. */
367 int __gnat_use_acl
= 1;
369 /* The following macro HAVE_READDIR_R should be defined if the
370 system provides the routine readdir_r.
371 ... but we never define it anywhere??? */
372 #undef HAVE_READDIR_R
374 #define MAYBE_TO_PTR32(argv) argv
376 static const char ATTR_UNSET
= 127;
378 /* Reset the file attributes as if no system call had been performed */
381 __gnat_reset_attributes (struct file_attributes
* attr
)
383 attr
->exists
= ATTR_UNSET
;
384 attr
->error
= EINVAL
;
386 attr
->writable
= ATTR_UNSET
;
387 attr
->readable
= ATTR_UNSET
;
388 attr
->executable
= ATTR_UNSET
;
390 attr
->regular
= ATTR_UNSET
;
391 attr
->symbolic_link
= ATTR_UNSET
;
392 attr
->directory
= ATTR_UNSET
;
394 attr
->timestamp
= (OS_Time
)-2;
395 attr
->file_length
= -1;
399 __gnat_error_attributes (struct file_attributes
*attr
) {
404 __gnat_current_time (void)
406 time_t res
= time (NULL
);
407 return (OS_Time
) res
;
410 /* Return the current local time as a string in the ISO 8601 format of
411 "YYYY-MM-DD HH:MM:SS.SS". The returned string is 22 + 1 (NULL) characters
415 __gnat_current_time_string (char *result
)
417 const char *format
= "%Y-%m-%d %H:%M:%S";
418 /* Format string necessary to describe the ISO 8601 format */
420 const time_t t_val
= time (NULL
);
422 strftime (result
, 22, format
, localtime (&t_val
));
423 /* Convert the local time into a string following the ISO format, copying
424 at most 22 characters into the result string. */
429 /* The sub-seconds are manually set to zero since type time_t lacks the
430 precision necessary for nanoseconds. */
434 __gnat_to_gm_time (OS_Time
*p_time
, int *p_year
, int *p_month
, int *p_day
,
435 int *p_hours
, int *p_mins
, int *p_secs
)
438 time_t time
= (time_t) *p_time
;
440 res
= gmtime (&time
);
443 *p_year
= res
->tm_year
;
444 *p_month
= res
->tm_mon
;
445 *p_day
= res
->tm_mday
;
446 *p_hours
= res
->tm_hour
;
447 *p_mins
= res
->tm_min
;
448 *p_secs
= res
->tm_sec
;
451 *p_year
= *p_month
= *p_day
= *p_hours
= *p_mins
= *p_secs
= 0;
455 __gnat_to_os_time (OS_Time
*p_time
, int year
, int month
, int day
,
456 int hours
, int mins
, int secs
)
468 /* returns -1 of failing, this is s-os_lib Invalid_Time */
470 *p_time
= (OS_Time
) mktime (&v
);
473 /* Place the contents of the symbolic link named PATH in the buffer BUF,
474 which has size BUFSIZ. If PATH is a symbolic link, then return the number
475 of characters of its content in BUF. Otherwise, return -1.
476 For systems not supporting symbolic links, always return -1. */
479 __gnat_readlink (char *path ATTRIBUTE_UNUSED
,
480 char *buf ATTRIBUTE_UNUSED
,
481 size_t bufsiz ATTRIBUTE_UNUSED
)
483 #if defined (_WIN32) \
484 || defined(__vxworks) || defined (__PikeOS__)
487 return readlink (path
, buf
, bufsiz
);
491 /* Creates a symbolic link named NEWPATH which contains the string OLDPATH.
492 If NEWPATH exists it will NOT be overwritten.
493 For systems not supporting symbolic links, always return -1. */
496 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED
,
497 char *newpath ATTRIBUTE_UNUSED
)
499 #if defined (_WIN32) \
500 || defined(__vxworks) || defined (__PikeOS__)
503 return symlink (oldpath
, newpath
);
507 /* Try to lock a file, return 1 if success. */
509 #if defined (__vxworks) \
510 || defined (_WIN32) || defined (__PikeOS__)
512 /* Version that does not use link. */
515 __gnat_try_lock (char *dir
, char *file
)
519 TCHAR wfull_path
[GNAT_MAX_PATH_LEN
];
520 TCHAR wfile
[GNAT_MAX_PATH_LEN
];
521 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
523 S2WSC (wdir
, dir
, GNAT_MAX_PATH_LEN
);
524 S2WSC (wfile
, file
, GNAT_MAX_PATH_LEN
);
526 /* ??? the code below crash on MingW64 for obscure reasons, a ticket
527 has been opened here:
529 https://sourceforge.net/p/mingw-w64/bugs/414/
531 As a workaround an equivalent set of code has been put in place below.
533 _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
536 _tcscpy (wfull_path
, wdir
);
537 _tcscat (wfull_path
, L
"\\");
538 _tcscat (wfull_path
, wfile
);
540 fd
= _topen (wfull_path
, O_CREAT
| O_EXCL
, 0600);
544 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
545 fd
= open (full_path
, O_CREAT
| O_EXCL
, 0600);
557 /* Version using link(), more secure over NFS. */
558 /* See TN 6913-016 for discussion ??? */
561 __gnat_try_lock (char *dir
, char *file
)
565 GNAT_STRUCT_STAT stat_result
;
568 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
569 sprintf (temp_file
, "%s%cTMP-%ld-%ld",
570 dir
, DIR_SEPARATOR
, (long)getpid(), (long)getppid ());
572 /* Create the temporary file and write the process number. */
573 fd
= open (temp_file
, O_CREAT
| O_WRONLY
, 0600);
579 /* Link it with the new file. */
580 link (temp_file
, full_path
);
582 /* Count the references on the old one. If we have a count of two, then
583 the link did succeed. Remove the temporary file before returning. */
584 __gnat_stat (temp_file
, &stat_result
);
586 return stat_result
.st_nlink
== 2;
590 /* Return the maximum file name length. */
593 __gnat_get_maximum_file_name_length (void)
598 /* Return nonzero if file names are case sensitive. */
600 static int file_names_case_sensitive_cache
= -1;
603 __gnat_get_file_names_case_sensitive (void)
605 if (file_names_case_sensitive_cache
== -1)
607 const char *sensitive
= getenv ("GNAT_FILE_NAME_CASE_SENSITIVE");
609 if (sensitive
!= NULL
610 && (sensitive
[0] == '0' || sensitive
[0] == '1')
611 && sensitive
[1] == '\0')
612 file_names_case_sensitive_cache
= sensitive
[0] - '0';
615 /* By default, we suppose filesystems aren't case sensitive on
616 Windows and Darwin (but they are on arm-darwin). */
617 #if defined (WINNT) || defined (__DJGPP__) \
618 || (defined (__APPLE__) && !(defined (__arm__) || defined (__arm64__)))
619 file_names_case_sensitive_cache
= 0;
621 file_names_case_sensitive_cache
= 1;
625 return file_names_case_sensitive_cache
;
628 /* Return nonzero if environment variables are case sensitive. */
631 __gnat_get_env_vars_case_sensitive (void)
633 #if defined (WINNT) || defined (__DJGPP__)
641 __gnat_get_default_identifier_character_set (void)
646 /* Return the current working directory. */
649 __gnat_get_current_dir (char *dir
, int *length
)
651 #if defined (__MINGW32__)
652 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
654 _tgetcwd (wdir
, *length
);
656 WS2SC (dir
, wdir
, GNAT_MAX_PATH_LEN
);
659 char* result
= getcwd (dir
, *length
);
660 /* If the current directory does not exist, set length = 0
661 to indicate error. That can't happen on windows, where
662 you can't delete a directory if it is the current
663 directory of some process. */
671 *length
= strlen (dir
);
673 if (dir
[*length
- 1] != DIR_SEPARATOR
)
675 dir
[*length
] = DIR_SEPARATOR
;
681 /* Return the suffix for object files. */
684 __gnat_get_object_suffix_ptr (int *len
, const char **value
)
686 *value
= HOST_OBJECT_SUFFIX
;
691 *len
= strlen (*value
);
696 /* Return the suffix for executable files. */
699 __gnat_get_executable_suffix_ptr (int *len
, const char **value
)
701 *value
= HOST_EXECUTABLE_SUFFIX
;
706 *len
= strlen (*value
);
711 /* Return the suffix for debuggable files. Usually this is the same as the
712 executable extension. */
715 __gnat_get_debuggable_suffix_ptr (int *len
, const char **value
)
717 *value
= HOST_EXECUTABLE_SUFFIX
;
722 *len
= strlen (*value
);
727 /* Returns the OS filename and corresponding encoding. */
730 __gnat_os_filename (char *filename ATTRIBUTE_UNUSED
,
731 char *w_filename ATTRIBUTE_UNUSED
,
732 char *os_name
, int *o_length
,
733 char *encoding ATTRIBUTE_UNUSED
, int *e_length
)
735 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
736 WS2SC (os_name
, (TCHAR
*)w_filename
, (DWORD
)*o_length
);
737 *o_length
= strlen (os_name
);
738 strcpy (encoding
, "encoding=utf8");
739 *e_length
= strlen (encoding
);
741 strcpy (os_name
, filename
);
742 *o_length
= strlen (filename
);
750 __gnat_unlink (char *path
)
752 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
754 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
756 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
757 return _tunlink (wpath
);
760 return unlink (path
);
767 __gnat_rename (char *from
, char *to
)
769 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
771 TCHAR wfrom
[GNAT_MAX_PATH_LEN
], wto
[GNAT_MAX_PATH_LEN
];
773 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
);
774 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
);
775 return _trename (wfrom
, wto
);
777 #elif defined (__vxworks) && (_WRS_VXWORKS_MAJOR == 6)
779 /* When used on a dos filesystem under VxWorks 6.9 rename will trigger a
780 S_dosFsLib_FILE_NOT_FOUND errno when the file is not found. Let's map
781 that to ENOENT so Ada.Directory.Rename can detect that and raise the
782 Name_Error exception. */
783 int ret
= rename (from
, to
);
785 if (ret
&& (errno
== S_dosFsLib_FILE_NOT_FOUND
))
792 return rename (from
, to
);
796 /* Changing directory. */
799 __gnat_chdir (char *path
)
801 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
803 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
805 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
806 return _tchdir (wpath
);
813 /* Removing a directory. */
816 __gnat_rmdir (char *path
)
818 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
820 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
822 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
823 return _trmdir (wpath
);
825 #elif defined (VTHREADS)
826 /* rmdir not available */
833 #if defined (_WIN32) || defined (__linux__) || defined (__sun__) \
834 || defined (__FreeBSD__) || defined(__DragonFly__) || defined (__QNX__)
835 #define HAS_TARGET_WCHAR_T
838 #ifdef HAS_TARGET_WCHAR_T
843 __gnat_fputwc(int c
, FILE *stream
)
845 #ifdef HAS_TARGET_WCHAR_T
846 return fputwc ((wchar_t)c
, stream
);
848 return fputc (c
, stream
);
853 __gnat_fopen (char *path
, char *mode
, int encoding ATTRIBUTE_UNUSED
)
855 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
856 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
859 S2WS (wmode
, mode
, 10);
861 if (encoding
== Encoding_Unspecified
)
862 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
863 else if (encoding
== Encoding_UTF8
)
864 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
866 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
868 return _tfopen (wpath
, wmode
);
871 return GNAT_FOPEN (path
, mode
);
876 __gnat_freopen (char *path
,
879 int encoding ATTRIBUTE_UNUSED
)
881 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
882 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
885 S2WS (wmode
, mode
, 10);
887 if (encoding
== Encoding_Unspecified
)
888 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
889 else if (encoding
== Encoding_UTF8
)
890 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
892 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
894 return _tfreopen (wpath
, wmode
, stream
);
896 return freopen (path
, mode
, stream
);
901 __gnat_open_read (char *path
, int fmode
)
904 int o_fmode
= O_BINARY
;
909 #if defined (__vxworks)
910 fd
= open (path
, O_RDONLY
| o_fmode
, 0444);
911 #elif defined (__MINGW32__)
913 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
915 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
916 fd
= _topen (wpath
, O_RDONLY
| o_fmode
, 0444);
919 fd
= GNAT_OPEN (path
, O_RDONLY
| o_fmode
);
922 return fd
< 0 ? -1 : fd
;
925 #if defined (__MINGW32__)
926 #define PERM (S_IREAD | S_IWRITE)
928 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
932 __gnat_open_rw (char *path
, int fmode
)
935 int o_fmode
= O_BINARY
;
940 #if defined (__MINGW32__)
942 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
944 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
945 fd
= _topen (wpath
, O_RDWR
| o_fmode
, PERM
);
948 fd
= GNAT_OPEN (path
, O_RDWR
| o_fmode
, PERM
);
951 return fd
< 0 ? -1 : fd
;
955 __gnat_open_create (char *path
, int fmode
)
958 int o_fmode
= O_BINARY
;
963 #if defined (__MINGW32__)
965 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
967 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
968 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
971 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
974 return fd
< 0 ? -1 : fd
;
978 __gnat_create_output_file (char *path
)
981 #if defined (__MINGW32__)
983 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
985 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
986 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
989 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
992 return fd
< 0 ? -1 : fd
;
996 __gnat_create_output_file_new (char *path
)
999 #if defined (__MINGW32__)
1001 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1003 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1004 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
1007 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
1010 return fd
< 0 ? -1 : fd
;
1014 __gnat_open_append (char *path
, int fmode
)
1017 int o_fmode
= O_BINARY
;
1022 #if defined (__MINGW32__)
1024 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1026 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1027 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
1030 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
1033 return fd
< 0 ? -1 : fd
;
1036 /* Open a new file. Return error (-1) if the file already exists. */
1039 __gnat_open_new (char *path
, int fmode
)
1042 int o_fmode
= O_BINARY
;
1047 #if defined (__MINGW32__)
1049 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1051 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1052 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1055 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1058 return fd
< 0 ? -1 : fd
;
1061 /* Open a new temp file. Return error (-1) if the file already exists. */
1064 __gnat_open_new_temp (char *path
, int fmode
)
1067 int o_fmode
= O_BINARY
;
1069 strcpy (path
, "GNAT-XXXXXX");
1071 #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
1072 || defined (__linux__) || defined (__GLIBC__) || defined (__ANDROID__) \
1073 || defined (__DragonFly__) || defined (__QNX__)) && !defined (__vxworks)
1074 return mkstemp (path
);
1075 #elif defined (__Lynx__)
1078 if (mktemp (path
) == NULL
)
1085 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1086 return fd
< 0 ? -1 : fd
;
1090 __gnat_open (char *path
, int fmode
)
1094 #if defined (__MINGW32__)
1096 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1098 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1099 fd
= _topen (wpath
, fmode
, PERM
);
1102 fd
= GNAT_OPEN (path
, fmode
, PERM
);
1105 return fd
< 0 ? -1 : fd
;
1108 /****************************************************************
1109 ** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information
1110 ** as possible from it, storing the result in a cache for later reuse
1111 ****************************************************************/
1114 __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
)
1116 GNAT_STRUCT_STAT statbuf
;
1120 /* GNAT_FSTAT returns -1 and sets errno for failure */
1121 ret
= GNAT_FSTAT (fd
, &statbuf
);
1122 error
= ret
? errno
: 0;
1125 /* __gnat_stat returns errno value directly */
1126 error
= __gnat_stat (name
, &statbuf
);
1127 ret
= error
? -1 : 0;
1131 * A missing file is reported as an attr structure with error == 0 and
1135 if (error
== 0 || error
== ENOENT
)
1138 attr
->error
= error
;
1140 attr
->regular
= (!ret
&& S_ISREG (statbuf
.st_mode
));
1141 attr
->directory
= (!ret
&& S_ISDIR (statbuf
.st_mode
));
1144 attr
->file_length
= 0;
1146 /* st_size may be 32 bits, or 64 bits which is converted to long. We
1147 don't return a useful value for files larger than 2 gigabytes in
1149 attr
->file_length
= statbuf
.st_size
; /* all systems */
1151 attr
->exists
= !ret
;
1153 #if !defined (_WIN32)
1154 /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
1155 attr
->readable
= (!ret
&& (statbuf
.st_mode
& S_IRUSR
));
1156 attr
->writable
= (!ret
&& (statbuf
.st_mode
& S_IWUSR
));
1157 attr
->executable
= (!ret
&& (statbuf
.st_mode
& S_IXUSR
));
1161 attr
->timestamp
= (OS_Time
)-1;
1163 attr
->timestamp
= (OS_Time
)statbuf
.st_mtime
;
1167 /****************************************************************
1168 ** Return the number of bytes in the specified file
1169 ****************************************************************/
1172 __gnat_file_length_attr (int fd
, char* name
, struct file_attributes
* attr
)
1174 if (attr
->file_length
== -1) {
1175 __gnat_stat_to_attr (fd
, name
, attr
);
1178 return attr
->file_length
;
1182 __gnat_file_length (int fd
)
1184 struct file_attributes attr
;
1185 __gnat_reset_attributes (&attr
);
1186 return __gnat_file_length_attr (fd
, NULL
, &attr
);
1190 __gnat_file_length_long (int fd
)
1192 struct file_attributes attr
;
1193 __gnat_reset_attributes (&attr
);
1194 return (long)__gnat_file_length_attr (fd
, NULL
, &attr
);
1198 __gnat_named_file_length (char *name
)
1200 struct file_attributes attr
;
1201 __gnat_reset_attributes (&attr
);
1202 return __gnat_file_length_attr (-1, name
, &attr
);
1205 /* Create a temporary filename and put it in string pointed to by
1209 __gnat_tmp_name (char *tmp_filename
)
1211 #if defined (__MINGW32__)
1216 /* tempnam tries to create a temporary file in directory pointed to by
1217 TMP environment variable, in c:\temp if TMP is not set, and in
1218 directory specified by P_tmpdir in stdio.h if c:\temp does not
1219 exist. The filename will be created with the prefix "gnat-". */
1221 sprintf (prefix
, "gnat-%d-", (int)getpid());
1222 pname
= (char *) _tempnam ("c:\\temp", prefix
);
1224 /* if pname is NULL, the file was not created properly, the disk is full
1225 or there is no more free temporary files */
1228 *tmp_filename
= '\0';
1230 /* If pname start with a back slash and not path information it means that
1231 the filename is valid for the current working directory. */
1233 else if (pname
[0] == '\\')
1235 strcpy (tmp_filename
, ".\\");
1236 strcat (tmp_filename
, pname
+1);
1239 strcpy (tmp_filename
, pname
);
1244 #elif defined (__linux__) || defined (__FreeBSD__) || defined (__NetBSD__) \
1245 || defined (__OpenBSD__) || defined (__GLIBC__) || defined (__ANDROID__) \
1246 || defined (__DragonFly__) || defined (__QNX__)
1247 #define MAX_SAFE_PATH 1000
1248 char *tmpdir
= getenv ("TMPDIR");
1250 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1251 a buffer overflow. */
1252 if (tmpdir
== NULL
|| strlen (tmpdir
) > MAX_SAFE_PATH
)
1254 strcpy (tmp_filename
, "/cache/gnat-XXXXXX");
1256 strcpy (tmp_filename
, "/tmp/gnat-XXXXXX");
1259 sprintf (tmp_filename
, "%s/gnat-XXXXXX", tmpdir
);
1261 close (mkstemp(tmp_filename
));
1262 #elif defined (__vxworks) && !defined (VTHREADS)
1266 static ushort_t seed
= 0; /* used to generate unique name */
1268 /* Generate a unique name. */
1269 strcpy (tmp_filename
, "tmp");
1272 savepos
= pos
= tmp_filename
+ strlen (tmp_filename
) + index
;
1280 /* Fill up the name buffer from the last position. */
1282 for (t
= seed
; --index
>= 0; t
>>= 3)
1283 *--pos
= '0' + (t
& 07);
1285 /* Check to see if its unique, if not bump the seed and try again. */
1286 f
= fopen (tmp_filename
, "r");
1294 tmpnam (tmp_filename
);
1298 /* Open directory and returns a DIR pointer. */
1300 DIR* __gnat_opendir (char *name
)
1302 #if defined (__MINGW32__)
1303 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1305 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1306 return (DIR*)_topendir (wname
);
1309 return opendir (name
);
1313 /* Read the next entry in a directory. The returned string points somewhere
1316 #if defined (__sun__)
1317 /* For Solaris, be sure to use the 64-bit version, otherwise NFS reads may
1318 fail with EOVERFLOW if the server uses 64-bit cookies. */
1319 #define dirent dirent64
1320 #define readdir readdir64
1324 __gnat_readdir (DIR *dirp
, char *buffer
, int *len
)
1326 #if defined (__MINGW32__)
1327 struct _tdirent
*dirent
= _treaddir ((_TDIR
*)dirp
);
1331 WS2SC (buffer
, dirent
->d_name
, GNAT_MAX_PATH_LEN
);
1332 *len
= strlen (buffer
);
1339 #elif defined (HAVE_READDIR_R)
1340 /* If possible, try to use the thread-safe version. */
1341 if (readdir_r (dirp
, buffer
) != NULL
)
1343 *len
= strlen (((struct dirent
*) buffer
)->d_name
);
1344 return ((struct dirent
*) buffer
)->d_name
;
1350 struct dirent
*dirent
= (struct dirent
*) readdir (dirp
);
1354 strcpy (buffer
, dirent
->d_name
);
1355 *len
= strlen (buffer
);
1364 /* Close a directory entry. */
1366 int __gnat_closedir (DIR *dirp
)
1368 #if defined (__MINGW32__)
1369 return _tclosedir ((_TDIR
*)dirp
);
1372 return closedir (dirp
);
1376 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1379 __gnat_readdir_is_thread_safe (void)
1381 #ifdef HAVE_READDIR_R
1388 #if defined (_WIN32)
1389 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1390 static const unsigned long long w32_epoch_offset
= 11644473600ULL;
1392 /* Returns the file modification timestamp using Win32 routines which are
1393 immune against daylight saving time change. It is in fact not possible to
1394 use fstat for this purpose as the DST modify the st_mtime field of the
1398 win32_filetime (HANDLE h
)
1403 unsigned long long ull_time
;
1406 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1407 since <Jan 1st 1601>. This function must return the number of seconds
1408 since <Jan 1st 1970>. */
1410 if (GetFileTime (h
, NULL
, NULL
, &t_write
.ft_time
))
1411 return (time_t) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1415 /* As above but starting from a FILETIME. */
1417 f2t (const FILETIME
*ft
, __time64_t
*t
)
1422 unsigned long long ull_time
;
1425 t_write
.ft_time
= *ft
;
1426 *t
= (__time64_t
) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1430 /* Return a GNAT time stamp given a file name. */
1433 __gnat_file_time_name_attr (char* name
, struct file_attributes
* attr
)
1435 if (attr
->timestamp
== (OS_Time
)-2) {
1436 #if defined (_WIN32)
1438 WIN32_FILE_ATTRIBUTE_DATA fad
;
1439 __time64_t ret
= -1;
1440 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1441 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1443 if ((res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
)))
1444 f2t (&fad
.ftLastWriteTime
, &ret
);
1445 attr
->timestamp
= (OS_Time
) ret
;
1447 __gnat_stat_to_attr (-1, name
, attr
);
1450 return attr
->timestamp
;
1454 __gnat_file_time_name (char *name
)
1456 struct file_attributes attr
;
1457 __gnat_reset_attributes (&attr
);
1458 return __gnat_file_time_name_attr (name
, &attr
);
1461 /* Return a GNAT time stamp given a file descriptor. */
1464 __gnat_file_time_fd_attr (int fd
, struct file_attributes
* attr
)
1466 if (attr
->timestamp
== (OS_Time
)-2) {
1467 #if defined (_WIN32)
1468 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
1469 time_t ret
= win32_filetime (h
);
1470 attr
->timestamp
= (OS_Time
) ret
;
1473 __gnat_stat_to_attr (fd
, NULL
, attr
);
1477 return attr
->timestamp
;
1481 __gnat_file_time_fd (int fd
)
1483 struct file_attributes attr
;
1484 __gnat_reset_attributes (&attr
);
1485 return __gnat_file_time_fd_attr (fd
, &attr
);
1488 extern long long __gnat_file_time(char* name
)
1495 /* Number of seconds between <Jan 1st 1970> and <Jan 1st 2150>. */
1496 static const long long ada_epoch_offset
= (136 * 365 + 44 * 366) * 86400LL;
1499 /* Number of 100 nanoseconds between <Jan 1st 1601> and <Jan 1st 2150>. */
1500 static const long long w32_epoch_offset
=
1501 (11644473600LL + ada_epoch_offset
) * 1E7
;
1503 WIN32_FILE_ATTRIBUTE_DATA fad
;
1510 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1513 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1514 name_len
= _tcslen (wname
);
1516 if (name_len
> GNAT_MAX_PATH_LEN
)
1519 if (!GetFileAttributesEx(wname
, GetFileExInfoStandard
, &fad
)) {
1523 t_write
.ft_time
= fad
.ftLastWriteTime
;
1525 #if defined(__GNUG__) && __GNUG__ <= 4
1526 result
= (t_write
.ll_time
- w32_epoch_offset
) * 100;
1528 /* Next code similar to (t_write.ll_time - w32_epoch_offset) * 100
1529 but on overflow returns LLONG_MIN value. */
1531 if (__builtin_ssubll_overflow(t_write
.ll_time
, w32_epoch_offset
, &result
)) {
1535 if (__builtin_smulll_overflow(result
, 100, &result
)) {
1543 if (stat(name
, &sb
) != 0) {
1547 #if defined(__GNUG__) && __GNUG__ <= 4
1548 result
= (sb
.st_mtime
- ada_epoch_offset
) * 1E9
;
1549 #if defined(st_mtime)
1550 result
+= sb
.st_mtim
.tv_nsec
;
1553 /* Next code similar to
1554 (sb.st_mtime - ada_epoch_offset) * 1E9 + sb.st_mtim.tv_nsec
1555 but on overflow returns LLONG_MIN value. */
1557 if (__builtin_ssubll_overflow(sb
.st_mtime
, ada_epoch_offset
, &result
)) {
1561 if (__builtin_smulll_overflow(result
, 1E9
, &result
)) {
1565 #if defined(st_mtime)
1566 if (__builtin_saddll_overflow(result
, sb
.st_mtim
.tv_nsec
, &result
)) {
1575 /* Set the file time stamp. */
1578 __gnat_set_file_time_name (char *name
, OS_Time time_stamp
)
1580 #if defined (__vxworks)
1582 /* Code to implement __gnat_set_file_time_name for these systems. */
1584 #elif defined (_WIN32)
1588 unsigned long long ull_time
;
1590 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1592 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1594 HANDLE h
= CreateFile
1595 (wname
, GENERIC_WRITE
, FILE_SHARE_WRITE
, NULL
,
1596 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
,
1598 if (h
== INVALID_HANDLE_VALUE
)
1600 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1601 t_write
.ull_time
= ((unsigned long long)time_stamp
+ w32_epoch_offset
);
1602 /* Convert to 100 nanosecond units */
1603 t_write
.ull_time
*= 10000000ULL;
1605 SetFileTime(h
, NULL
, NULL
, &t_write
.ft_time
);
1610 struct utimbuf utimbuf
;
1613 /* Set modification time to requested time. */
1614 utimbuf
.modtime
= (time_t) time_stamp
;
1616 /* Set access time to now in local time. */
1618 utimbuf
.actime
= mktime (localtime (&t
));
1620 utime (name
, &utimbuf
);
1624 /* Get the list of installed standard libraries from the
1625 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1629 __gnat_get_libraries_from_registry (void)
1631 char *result
= (char *) xmalloc (1);
1635 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
1638 DWORD name_size
, value_size
;
1645 /* First open the key. */
1646 res
= RegOpenKeyExA (HKEY_LOCAL_MACHINE
, "SOFTWARE", 0, KEY_READ
, ®_key
);
1648 if (res
== ERROR_SUCCESS
)
1649 res
= RegOpenKeyExA (reg_key
, "Ada Core Technologies", 0,
1650 KEY_READ
, ®_key
);
1652 if (res
== ERROR_SUCCESS
)
1653 res
= RegOpenKeyExA (reg_key
, "GNAT", 0, KEY_READ
, ®_key
);
1655 if (res
== ERROR_SUCCESS
)
1656 res
= RegOpenKeyExA (reg_key
, "Standard Libraries", 0, KEY_READ
, ®_key
);
1658 /* If the key exists, read out all the values in it and concatenate them
1660 for (index
= 0; res
== ERROR_SUCCESS
; index
++)
1662 value_size
= name_size
= 256;
1663 res
= RegEnumValueA (reg_key
, index
, name
, &name_size
, 0,
1664 &type
, (LPBYTE
)value
, &value_size
);
1666 if (res
== ERROR_SUCCESS
&& type
== REG_SZ
)
1668 char *old_result
= result
;
1670 result
= (char *) xmalloc (strlen (old_result
) + value_size
+ 2);
1671 strcpy (result
, old_result
);
1672 strcat (result
, value
);
1673 strcat (result
, ";");
1678 /* Remove the trailing ";". */
1680 result
[strlen (result
) - 1] = 0;
1686 /* Query information for the given file NAME and return it in STATBUF.
1687 * Returns 0 for success, or errno value for failure.
1690 __gnat_stat (char *name
, GNAT_STRUCT_STAT
*statbuf
)
1693 WIN32_FILE_ATTRIBUTE_DATA fad
;
1694 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1699 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1700 name_len
= _tcslen (wname
);
1702 if (name_len
> GNAT_MAX_PATH_LEN
)
1705 ZeroMemory (statbuf
, sizeof(GNAT_STRUCT_STAT
));
1707 res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
);
1710 error
= GetLastError();
1712 /* Check file existence using GetFileAttributes() which does not fail on
1713 special Windows files like con:, aux:, nul: etc... */
1715 if (GetFileAttributes(wname
) != INVALID_FILE_ATTRIBUTES
) {
1716 /* Just pretend that it is a regular and readable file */
1717 statbuf
->st_mode
= S_IFREG
| S_IREAD
| S_IWRITE
;
1722 case ERROR_ACCESS_DENIED
:
1723 case ERROR_SHARING_VIOLATION
:
1724 case ERROR_LOCK_VIOLATION
:
1725 case ERROR_SHARING_BUFFER_EXCEEDED
:
1727 case ERROR_BUFFER_OVERFLOW
:
1728 return ENAMETOOLONG
;
1729 case ERROR_NOT_ENOUGH_MEMORY
:
1736 f2t (&fad
.ftCreationTime
, &statbuf
->st_ctime
);
1737 f2t (&fad
.ftLastWriteTime
, &statbuf
->st_mtime
);
1738 f2t (&fad
.ftLastAccessTime
, &statbuf
->st_atime
);
1741 (__int64
)fad
.nFileSizeLow
| (__int64
)fad
.nFileSizeHigh
<< 32;
1743 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1744 statbuf
->st_mode
= S_IREAD
;
1746 if (fad
.dwFileAttributes
& FILE_ATTRIBUTE_DIRECTORY
)
1747 statbuf
->st_mode
|= S_IFDIR
;
1749 statbuf
->st_mode
|= S_IFREG
;
1751 if (!(fad
.dwFileAttributes
& FILE_ATTRIBUTE_READONLY
))
1752 statbuf
->st_mode
|= S_IWRITE
;
1757 return GNAT_STAT (name
, statbuf
) == 0 ? 0 : errno
;
1761 /*************************************************************************
1762 ** Check whether a file exists
1763 *************************************************************************/
1766 __gnat_file_exists_attr (char* name
, struct file_attributes
* attr
)
1768 if (attr
->exists
== ATTR_UNSET
)
1769 __gnat_stat_to_attr (-1, name
, attr
);
1771 return attr
->exists
;
1775 __gnat_file_exists (char *name
)
1777 struct file_attributes attr
;
1778 __gnat_reset_attributes (&attr
);
1779 return __gnat_file_exists_attr (name
, &attr
);
1782 /**********************************************************************
1783 ** Whether name is an absolute path
1784 **********************************************************************/
1787 __gnat_is_absolute_path (char *name
, int length
)
1790 /* On VxWorks systems, an absolute path can be represented (depending on
1791 the host platform) as either /dir/file, or device:/dir/file, or
1792 device:drive_letter:/dir/file. */
1799 for (index
= 0; index
< length
; index
++)
1801 if (name
[index
] == ':' &&
1802 ((name
[index
+ 1] == '/') ||
1803 (isalpha (name
[index
+ 1]) && index
+ 2 <= length
&&
1804 name
[index
+ 2] == '/')))
1807 else if (name
[index
] == '/')
1812 return (length
!= 0) &&
1813 (IS_DIRECTORY_SEPARATOR(*name
)
1814 #if defined (WINNT) || defined(__DJGPP__)
1815 || (length
> 2 && ISALPHA (name
[0]) && name
[1] == ':'
1816 && IS_DIRECTORY_SEPARATOR(name
[2]))
1823 __gnat_is_regular_file_attr (char* name
, struct file_attributes
* attr
)
1825 if (attr
->regular
== ATTR_UNSET
)
1826 __gnat_stat_to_attr (-1, name
, attr
);
1828 return attr
->regular
;
1832 __gnat_is_regular_file (char *name
)
1834 struct file_attributes attr
;
1836 __gnat_reset_attributes (&attr
);
1837 return __gnat_is_regular_file_attr (name
, &attr
);
1841 __gnat_is_regular_file_fd (int fd
)
1844 GNAT_STRUCT_STAT statbuf
;
1846 ret
= GNAT_FSTAT (fd
, &statbuf
);
1847 return (!ret
&& S_ISREG (statbuf
.st_mode
));
1851 __gnat_is_directory_attr (char* name
, struct file_attributes
* attr
)
1853 if (attr
->directory
== ATTR_UNSET
)
1854 __gnat_stat_to_attr (-1, name
, attr
);
1856 return attr
->directory
;
1860 __gnat_is_directory (char *name
)
1862 struct file_attributes attr
;
1864 __gnat_reset_attributes (&attr
);
1865 return __gnat_is_directory_attr (name
, &attr
);
1868 #if defined (_WIN32)
1870 /* Returns the same constant as GetDriveType but takes a pathname as
1874 GetDriveTypeFromPath (TCHAR
*wfullpath
)
1876 TCHAR wdrv
[MAX_PATH
];
1877 TCHAR wpath
[MAX_PATH
];
1878 TCHAR wfilename
[MAX_PATH
];
1879 TCHAR wext
[MAX_PATH
];
1881 _tsplitpath (wfullpath
, wdrv
, wpath
, wfilename
, wext
);
1883 if (_tcslen (wdrv
) != 0)
1885 /* we have a drive specified. */
1886 _tcscat (wdrv
, _T("\\"));
1887 return GetDriveType (wdrv
);
1891 /* No drive specified. */
1893 /* Is this a relative path, if so get current drive type. */
1894 if (wpath
[0] != _T('\\') ||
1895 (_tcslen (wpath
) > 2 && wpath
[0] == _T('\\')
1896 && wpath
[1] != _T('\\')))
1897 return GetDriveType (NULL
);
1899 UINT result
= GetDriveType (wpath
);
1901 /* Cannot guess the drive type, is this \\.\ ? */
1903 if (result
== DRIVE_NO_ROOT_DIR
&&
1904 _tcslen (wpath
) >= 4 && wpath
[0] == _T('\\') && wpath
[1] == _T('\\')
1905 && wpath
[2] == _T('.') && wpath
[3] == _T('\\'))
1907 if (_tcslen (wpath
) == 4)
1908 _tcscat (wpath
, wfilename
);
1910 LPTSTR p
= &wpath
[4];
1911 LPTSTR b
= _tcschr (p
, _T('\\'));
1915 /* logical drive \\.\c\dir\file */
1921 _tcscat (p
, _T(":\\"));
1923 return GetDriveType (p
);
1930 /* This MingW section contains code to work with ACL. */
1932 __gnat_check_OWNER_ACL (TCHAR
*wname
,
1933 DWORD CheckAccessDesired
,
1934 GENERIC_MAPPING CheckGenericMapping
)
1936 DWORD dwAccessDesired
, dwAccessAllowed
;
1937 PRIVILEGE_SET PrivilegeSet
;
1938 DWORD dwPrivSetSize
= sizeof (PRIVILEGE_SET
);
1939 BOOL fAccessGranted
= FALSE
;
1940 HANDLE hToken
= NULL
;
1942 PSECURITY_DESCRIPTOR pSD
= NULL
;
1945 (wname
, OWNER_SECURITY_INFORMATION
|
1946 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1949 if ((pSD
= (SECURITY_DESCRIPTOR
*) HeapAlloc
1950 (GetProcessHeap (), HEAP_ZERO_MEMORY
, nLength
)) == NULL
)
1953 /* Obtain the security descriptor. */
1955 if (!GetFileSecurity
1956 (wname
, OWNER_SECURITY_INFORMATION
|
1957 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1958 pSD
, nLength
, &nLength
))
1961 if (!ImpersonateSelf (SecurityImpersonation
))
1964 if (!OpenThreadToken
1965 (GetCurrentThread(), TOKEN_DUPLICATE
| TOKEN_QUERY
, FALSE
, &hToken
))
1968 /* Undoes the effect of ImpersonateSelf. */
1972 /* We want to test for write permissions. */
1974 dwAccessDesired
= CheckAccessDesired
;
1976 MapGenericMask (&dwAccessDesired
, &CheckGenericMapping
);
1979 (pSD
, /* security descriptor to check */
1980 hToken
, /* impersonation token */
1981 dwAccessDesired
, /* requested access rights */
1982 &CheckGenericMapping
, /* pointer to GENERIC_MAPPING */
1983 &PrivilegeSet
, /* receives privileges used in check */
1984 &dwPrivSetSize
, /* size of PrivilegeSet buffer */
1985 &dwAccessAllowed
, /* receives mask of allowed access rights */
1989 CloseHandle (hToken
);
1990 HeapFree (GetProcessHeap (), 0, pSD
);
1991 return fAccessGranted
;
1995 CloseHandle (hToken
);
1996 HeapFree (GetProcessHeap (), 0, pSD
);
2001 __gnat_set_OWNER_ACL (TCHAR
*wname
,
2002 ACCESS_MODE AccessMode
,
2003 DWORD AccessPermissions
)
2005 PACL pOldDACL
= NULL
;
2006 PACL pNewDACL
= NULL
;
2007 PSECURITY_DESCRIPTOR pSD
= NULL
;
2009 TCHAR username
[100];
2012 /* Get current user, he will act as the owner */
2014 if (!GetUserName (username
, &unsize
))
2017 if (GetNamedSecurityInfo
2020 DACL_SECURITY_INFORMATION
,
2021 NULL
, NULL
, &pOldDACL
, NULL
, &pSD
) != ERROR_SUCCESS
)
2024 BuildExplicitAccessWithName
2025 (&ea
, username
, AccessPermissions
, (ACCESS_MODE
) AccessMode
, NO_INHERITANCE
);
2027 if (AccessMode
== SET_ACCESS
)
2029 /* SET_ACCESS, we want to set an explicte set of permissions, do not
2030 merge with current DACL. */
2031 if (SetEntriesInAcl (1, &ea
, NULL
, &pNewDACL
) != ERROR_SUCCESS
)
2035 if (SetEntriesInAcl (1, &ea
, pOldDACL
, &pNewDACL
) != ERROR_SUCCESS
)
2038 if (SetNamedSecurityInfo
2039 (wname
, SE_FILE_OBJECT
,
2040 DACL_SECURITY_INFORMATION
, NULL
, NULL
, pNewDACL
, NULL
) != ERROR_SUCCESS
)
2044 LocalFree (pNewDACL
);
2047 /* Check if it is possible to use ACL for wname, the file must not be on a
2051 __gnat_can_use_acl (TCHAR
*wname
)
2053 return __gnat_use_acl
&& GetDriveTypeFromPath (wname
) != DRIVE_REMOTE
;
2056 #endif /* defined (_WIN32) */
2059 __gnat_is_readable_file_attr (char* name
, struct file_attributes
* attr
)
2061 if (attr
->readable
== ATTR_UNSET
)
2063 #if defined (_WIN32)
2064 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2065 GENERIC_MAPPING GenericMapping
;
2067 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2069 if (__gnat_can_use_acl (wname
))
2071 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
2072 GenericMapping
.GenericRead
= GENERIC_READ
;
2074 __gnat_check_OWNER_ACL (wname
, FILE_READ_DATA
, GenericMapping
);
2077 attr
->readable
= GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
;
2079 __gnat_stat_to_attr (-1, name
, attr
);
2083 return attr
->readable
;
2087 __gnat_is_read_accessible_file (char *name
)
2089 #if defined (_WIN32)
2090 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2092 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2094 return !_waccess (wname
, 4);
2096 #elif defined (__vxworks)
2099 if ((fd
= open (name
, O_RDONLY
, 0)) < 0)
2105 return !access (name
, R_OK
);
2110 __gnat_is_readable_file (char *name
)
2112 struct file_attributes attr
;
2114 __gnat_reset_attributes (&attr
);
2115 return __gnat_is_readable_file_attr (name
, &attr
);
2119 __gnat_is_writable_file_attr (char* name
, struct file_attributes
* attr
)
2121 if (attr
->writable
== ATTR_UNSET
)
2123 #if defined (_WIN32)
2124 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2125 GENERIC_MAPPING GenericMapping
;
2127 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2129 if (__gnat_can_use_acl (wname
))
2131 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
2132 GenericMapping
.GenericWrite
= GENERIC_WRITE
;
2134 attr
->writable
= __gnat_check_OWNER_ACL
2135 (wname
, FILE_WRITE_DATA
| FILE_APPEND_DATA
, GenericMapping
)
2136 && !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
2140 !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
2143 __gnat_stat_to_attr (-1, name
, attr
);
2147 return attr
->writable
;
2151 __gnat_is_writable_file (char *name
)
2153 struct file_attributes attr
;
2155 __gnat_reset_attributes (&attr
);
2156 return __gnat_is_writable_file_attr (name
, &attr
);
2160 __gnat_is_write_accessible_file (char *name
)
2162 #if defined (_WIN32)
2163 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2165 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2167 return !_waccess (wname
, 2);
2169 #elif defined (__vxworks)
2172 if ((fd
= open (name
, O_WRONLY
, 0)) < 0)
2178 return !access (name
, W_OK
);
2183 __gnat_is_executable_file_attr (char* name
, struct file_attributes
* attr
)
2185 if (attr
->executable
== ATTR_UNSET
)
2187 #if defined (_WIN32)
2188 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2189 GENERIC_MAPPING GenericMapping
;
2191 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2193 if (__gnat_can_use_acl (wname
))
2195 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
2196 GenericMapping
.GenericExecute
= GENERIC_EXECUTE
;
2199 __gnat_check_OWNER_ACL (wname
, FILE_EXECUTE
, GenericMapping
);
2203 TCHAR
*l
, *last
= _tcsstr(wname
, _T(".exe"));
2205 /* look for last .exe */
2207 while ((l
= _tcsstr(last
+1, _T(".exe"))))
2211 GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
2212 && (last
- wname
) == (int) (_tcslen (wname
) - 4);
2215 __gnat_stat_to_attr (-1, name
, attr
);
2219 return attr
->regular
&& attr
->executable
;
2223 __gnat_is_executable_file (char *name
)
2225 struct file_attributes attr
;
2227 __gnat_reset_attributes (&attr
);
2228 return __gnat_is_executable_file_attr (name
, &attr
);
2232 __gnat_set_writable (char *name
)
2234 #if defined (_WIN32)
2235 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2237 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2239 if (__gnat_can_use_acl (wname
))
2240 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_WRITE
);
2243 (wname
, GetFileAttributes (wname
) & ~FILE_ATTRIBUTE_READONLY
);
2244 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2245 GNAT_STRUCT_STAT statbuf
;
2247 if (GNAT_STAT (name
, &statbuf
) == 0)
2249 statbuf
.st_mode
= statbuf
.st_mode
| S_IWUSR
;
2250 chmod (name
, statbuf
.st_mode
);
2255 /* must match definition in s-os_lib.ads */
2261 __gnat_set_executable (char *name
, int mode ATTRIBUTE_UNUSED
)
2263 #if defined (_WIN32)
2264 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2266 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2268 if (__gnat_can_use_acl (wname
))
2269 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_EXECUTE
);
2271 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2272 GNAT_STRUCT_STAT statbuf
;
2274 if (GNAT_STAT (name
, &statbuf
) == 0)
2277 statbuf
.st_mode
= statbuf
.st_mode
| S_IXUSR
;
2279 statbuf
.st_mode
= statbuf
.st_mode
| S_IXGRP
;
2280 if (mode
& S_OTHERS
)
2281 statbuf
.st_mode
= statbuf
.st_mode
| S_IXOTH
;
2282 chmod (name
, statbuf
.st_mode
);
2288 __gnat_set_non_writable (char *name
)
2290 #if defined (_WIN32)
2291 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2293 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2295 if (__gnat_can_use_acl (wname
))
2296 __gnat_set_OWNER_ACL
2297 (wname
, DENY_ACCESS
,
2298 FILE_WRITE_DATA
| FILE_APPEND_DATA
|
2299 FILE_WRITE_EA
| FILE_WRITE_ATTRIBUTES
);
2302 (wname
, GetFileAttributes (wname
) | FILE_ATTRIBUTE_READONLY
);
2303 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2304 GNAT_STRUCT_STAT statbuf
;
2306 if (GNAT_STAT (name
, &statbuf
) == 0)
2308 statbuf
.st_mode
= statbuf
.st_mode
& 07577;
2309 chmod (name
, statbuf
.st_mode
);
2315 __gnat_set_readable (char *name
)
2317 #if defined (_WIN32)
2318 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2320 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2322 if (__gnat_can_use_acl (wname
))
2323 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_READ
);
2325 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2326 GNAT_STRUCT_STAT statbuf
;
2328 if (GNAT_STAT (name
, &statbuf
) == 0)
2330 chmod (name
, statbuf
.st_mode
| S_IREAD
);
2336 __gnat_set_non_readable (char *name
)
2338 #if defined (_WIN32)
2339 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2341 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2343 if (__gnat_can_use_acl (wname
))
2344 __gnat_set_OWNER_ACL (wname
, DENY_ACCESS
, FILE_GENERIC_READ
);
2346 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2347 GNAT_STRUCT_STAT statbuf
;
2349 if (GNAT_STAT (name
, &statbuf
) == 0)
2351 chmod (name
, statbuf
.st_mode
& (~S_IREAD
));
2357 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED
,
2358 struct file_attributes
* attr
)
2360 if (attr
->symbolic_link
== ATTR_UNSET
)
2362 #if defined (__vxworks)
2363 attr
->symbolic_link
= 0;
2365 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2367 GNAT_STRUCT_STAT statbuf
;
2368 ret
= GNAT_LSTAT (name
, &statbuf
);
2369 attr
->symbolic_link
= (!ret
&& S_ISLNK (statbuf
.st_mode
));
2371 attr
->symbolic_link
= 0;
2374 return attr
->symbolic_link
;
2378 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED
)
2380 struct file_attributes attr
;
2382 __gnat_reset_attributes (&attr
);
2383 return __gnat_is_symbolic_link_attr (name
, &attr
);
2386 #if defined (__sun__)
2387 /* Using fork on Solaris will duplicate all the threads. fork1, which
2388 duplicates only the active thread, must be used instead, or spawning
2389 subprocess from a program with tasking will lead into numerous problems. */
2394 __gnat_portable_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2396 int status ATTRIBUTE_UNUSED
= 0;
2397 int finished ATTRIBUTE_UNUSED
;
2398 int pid ATTRIBUTE_UNUSED
;
2400 #if defined (__vxworks) || defined(__PikeOS__)
2403 #elif defined (__DJGPP__) || defined (_WIN32)
2404 /* args[0] must be quotes as it could contain a full pathname with spaces */
2405 char *args_0
= args
[0];
2406 args
[0] = (char *)xmalloc (strlen (args_0
) + 3);
2407 strcpy (args
[0], "\"");
2408 strcat (args
[0], args_0
);
2409 strcat (args
[0], "\"");
2411 status
= spawnvp (P_WAIT
, args_0
, (char ** const)args
);
2413 /* restore previous value */
2415 args
[0] = (char *)args_0
;
2431 execv (args
[0], MAYBE_TO_PTR32 (args
));
2433 /* execv() returns only on error */
2438 finished
= waitpid (pid
, &status
, 0);
2440 if (finished
!= pid
|| WIFEXITED (status
) == 0)
2443 return WEXITSTATUS (status
);
2449 /* Create a copy of the given file descriptor.
2450 Return -1 if an error occurred. */
2453 __gnat_dup (int oldfd
)
2455 #if defined (__vxworks) && !defined (__RTP__)
2456 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2464 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2465 Return -1 if an error occurred. */
2468 __gnat_dup2 (int oldfd ATTRIBUTE_UNUSED
, int newfd ATTRIBUTE_UNUSED
)
2470 #if defined (__vxworks) && !defined (__RTP__)
2471 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2474 #elif defined (__PikeOS__)
2475 /* Not supported. */
2477 #elif defined (_WIN32)
2478 /* Special case when oldfd and newfd are identical and are the standard
2479 input, output or error as this makes Windows XP hangs. Note that we
2480 do that only for standard file descriptors that are known to be valid. */
2481 if (oldfd
== newfd
&& newfd
>= 0 && newfd
<= 2)
2484 return dup2 (oldfd
, newfd
);
2486 return dup2 (oldfd
, newfd
);
2491 __gnat_number_of_cpus (void)
2495 #if defined (_SC_NPROCESSORS_ONLN)
2496 cores
= (int) sysconf (_SC_NPROCESSORS_ONLN
);
2498 #elif defined (__QNX__)
2499 cores
= (int) _syspage_ptr
->num_cpu
;
2501 #elif defined (__hpux__)
2502 struct pst_dynamic psd
;
2503 if (pstat_getdynamic (&psd
, sizeof (psd
), 1, 0) != -1)
2504 cores
= (int) psd
.psd_proc_cnt
;
2506 #elif defined (_WIN32)
2507 SYSTEM_INFO sysinfo
;
2508 GetSystemInfo (&sysinfo
);
2509 cores
= (int) sysinfo
.dwNumberOfProcessors
;
2511 #elif defined (_WRS_CONFIG_SMP)
2512 unsigned int vxCpuConfiguredGet (void);
2514 cores
= vxCpuConfiguredGet ();
2521 /* WIN32 code to implement a wait call that wait for any child process. */
2523 #if defined (_WIN32)
2525 /* Synchronization code, to be thread safe. */
2529 /* For the Cert run times on native Windows we use dummy functions
2530 for locking and unlocking tasks since we do not support multiple
2531 threads on this configuration (Cert run time on native Windows). */
2533 static void EnterCS (void) {}
2534 static void LeaveCS (void) {}
2535 static void SignalListChanged (void) {}
2539 CRITICAL_SECTION ProcListCS
;
2540 HANDLE ProcListEvt
= NULL
;
2542 static void EnterCS (void)
2544 EnterCriticalSection(&ProcListCS
);
2547 static void LeaveCS (void)
2549 LeaveCriticalSection(&ProcListCS
);
2552 static void SignalListChanged (void)
2554 SetEvent (ProcListEvt
);
2559 static HANDLE
*HANDLES_LIST
= NULL
;
2560 static int *PID_LIST
= NULL
, plist_length
= 0, plist_max_length
= 0;
2563 add_handle (HANDLE h
, int pid
)
2565 /* -------------------- critical section -------------------- */
2568 if (plist_length
== plist_max_length
)
2570 plist_max_length
+= 100;
2572 (HANDLE
*) xrealloc (HANDLES_LIST
, sizeof (HANDLE
) * plist_max_length
);
2574 (int *) xrealloc (PID_LIST
, sizeof (int) * plist_max_length
);
2577 HANDLES_LIST
[plist_length
] = h
;
2578 PID_LIST
[plist_length
] = pid
;
2581 SignalListChanged();
2583 /* -------------------- critical section -------------------- */
2587 __gnat_win32_remove_handle (HANDLE h
, int pid
)
2592 /* -------------------- critical section -------------------- */
2595 for (j
= 0; j
< plist_length
; j
++)
2597 if ((HANDLES_LIST
[j
] == h
) || (PID_LIST
[j
] == pid
))
2601 HANDLES_LIST
[j
] = HANDLES_LIST
[plist_length
];
2602 PID_LIST
[j
] = PID_LIST
[plist_length
];
2609 /* -------------------- critical section -------------------- */
2612 SignalListChanged();
2618 win32_no_block_spawn (char *command
, char *args
[], HANDLE
*h
, int *pid
)
2622 PROCESS_INFORMATION PI
;
2623 SECURITY_ATTRIBUTES SA
;
2628 /* compute the total command line length */
2632 csize
+= strlen (args
[k
]) + 1;
2636 full_command
= (char *) xmalloc (csize
);
2639 SI
.cb
= sizeof (STARTUPINFO
);
2640 SI
.lpReserved
= NULL
;
2641 SI
.lpReserved2
= NULL
;
2642 SI
.lpDesktop
= NULL
;
2646 SI
.wShowWindow
= SW_HIDE
;
2648 /* Security attributes. */
2649 SA
.nLength
= sizeof (SECURITY_ATTRIBUTES
);
2650 SA
.bInheritHandle
= TRUE
;
2651 SA
.lpSecurityDescriptor
= NULL
;
2653 /* Prepare the command string. */
2654 strcpy (full_command
, command
);
2655 strcat (full_command
, " ");
2660 strcat (full_command
, args
[k
]);
2661 strcat (full_command
, " ");
2666 int wsize
= csize
* 2;
2667 TCHAR
*wcommand
= (TCHAR
*) xmalloc (wsize
);
2669 S2WSC (wcommand
, full_command
, wsize
);
2671 free (full_command
);
2673 result
= CreateProcess
2674 (NULL
, wcommand
, &SA
, NULL
, TRUE
,
2675 GetPriorityClass (GetCurrentProcess()), NULL
, NULL
, &SI
, &PI
);
2682 CloseHandle (PI
.hThread
);
2684 *pid
= PI
.dwProcessId
;
2694 win32_wait (int *status
)
2696 DWORD exitcode
, pid
;
2707 if (plist_length
== 0)
2713 /* -------------------- critical section -------------------- */
2716 /* ??? We can't wait for more than MAXIMUM_WAIT_OBJECTS due to a Win32
2718 if (plist_length
< MAXIMUM_WAIT_OBJECTS
)
2719 hl_len
= plist_length
;
2727 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * hl_len
);
2728 memmove (hl
, HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2729 pidl
= (int *) xmalloc (sizeof (int) * hl_len
);
2730 memmove (pidl
, PID_LIST
, sizeof (int) * hl_len
);
2732 /* Note that index 0 contains the event handle that is signaled when the
2733 process list has changed */
2734 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * (hl_len
+ 1));
2735 hl
[0] = ProcListEvt
;
2736 memmove (&hl
[1], HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2737 pidl
= (int *) xmalloc (sizeof (int) * (hl_len
+ 1));
2738 memmove (&pidl
[1], PID_LIST
, sizeof (int) * hl_len
);
2743 /* -------------------- critical section -------------------- */
2745 res
= WaitForMultipleObjects (hl_len
, hl
, FALSE
, INFINITE
);
2747 /* If there was an error, exit now */
2748 if (res
== WAIT_FAILED
)
2756 /* if the ProcListEvt has been signaled then the list of processes has been
2757 updated to add or remove a handle, just loop over */
2759 if (res
- WAIT_OBJECT_0
== 0)
2766 /* Handle two distinct groups of return codes: finished waits and abandoned
2769 if (res
< WAIT_ABANDONED_0
)
2770 pos
= res
- WAIT_OBJECT_0
;
2772 pos
= res
- WAIT_ABANDONED_0
;
2775 GetExitCodeProcess (h
, &exitcode
);
2778 found
= __gnat_win32_remove_handle (h
, -1);
2783 /* if not found another process waiting has already handled this process */
2790 *status
= (int) exitcode
;
2797 __gnat_portable_no_block_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2800 #if defined (__vxworks) || defined (__PikeOS__)
2801 /* Not supported. */
2804 #elif defined(__DJGPP__)
2805 if (spawnvp (P_WAIT
, args
[0], args
) != 0)
2810 #elif defined (_WIN32)
2815 win32_no_block_spawn (args
[0], args
, &h
, &pid
);
2818 add_handle (h
, pid
);
2831 execv (args
[0], MAYBE_TO_PTR32 (args
));
2833 /* execv() returns only on error */
2843 __gnat_portable_wait (int *process_status
)
2848 #if defined (__vxworks) || defined (__PikeOS__)
2849 /* Not sure what to do here, so do nothing but return zero. */
2851 #elif defined (_WIN32)
2853 pid
= win32_wait (&status
);
2855 #elif defined (__DJGPP__)
2856 /* Child process has already ended in case of DJGPP.
2857 No need to do anything. Just return success. */
2860 pid
= waitpid (-1, &status
, 0);
2861 status
= status
& 0xffff;
2864 *process_status
= status
;
2869 __gnat_portable_no_block_wait (int *process_status
)
2874 #if defined (__vxworks) || defined (__PikeOS__) || defined (_WIN32)
2875 /* Not supported. */
2880 pid
= waitpid (-1, &status
, WNOHANG
);
2881 status
= status
& 0xffff;
2884 *process_status
= status
;
2889 __gnat_os_exit (int status
)
2895 __gnat_current_process_id (void)
2897 #if defined (__vxworks) || defined (__PikeOS__)
2900 #elif defined (_WIN32)
2902 return (int)GetCurrentProcessId();
2906 return (int)getpid();
2910 /* Locate file on path, that matches a predicate */
2913 __gnat_locate_file_with_predicate (char *file_name
, char *path_val
,
2914 int (*predicate
)(char *))
2917 char *file_path
= (char *) alloca (strlen (file_name
) + 1);
2920 /* Return immediately if file_name is empty */
2922 if (*file_name
== '\0')
2925 /* Remove quotes around file_name if present */
2931 strcpy (file_path
, ptr
);
2933 ptr
= file_path
+ strlen (file_path
) - 1;
2938 /* Handle absolute pathnames. */
2940 absolute
= __gnat_is_absolute_path (file_path
, strlen (file_name
));
2944 if (predicate (file_path
))
2945 return xstrdup (file_path
);
2950 /* If file_name include directory separator(s), try it first as
2951 a path name relative to the current directory */
2952 for (ptr
= file_name
; *ptr
&& !IS_DIRECTORY_SEPARATOR(*ptr
); ptr
++)
2957 if (predicate (file_name
))
2958 return xstrdup (file_name
);
2965 /* The result has to be smaller than path_val + file_name. */
2967 (char *) alloca (strlen (path_val
) + strlen (file_name
) + 2);
2971 /* Skip the starting quote */
2973 if (*path_val
== '"')
2976 for (ptr
= file_path
; *path_val
&& *path_val
!= PATH_SEPARATOR
; )
2977 *ptr
++ = *path_val
++;
2979 /* If directory is empty, it is the current directory*/
2981 if (ptr
== file_path
)
2988 /* Skip the ending quote */
2993 if (!IS_DIRECTORY_SEPARATOR(*ptr
))
2994 *++ptr
= DIR_SEPARATOR
;
2996 strcpy (++ptr
, file_name
);
2998 if (predicate (file_path
))
2999 return xstrdup (file_path
);
3004 /* Skip path separator */
3013 /* Locate an executable file, give a Path value. */
3016 __gnat_locate_executable_file (char *file_name
, char *path_val
)
3018 return __gnat_locate_file_with_predicate
3019 (file_name
, path_val
, &__gnat_is_executable_file
);
3022 /* Locate a regular file, give a Path value. */
3025 __gnat_locate_regular_file (char *file_name
, char *path_val
)
3027 return __gnat_locate_file_with_predicate
3028 (file_name
, path_val
, &__gnat_is_regular_file
);
3031 /* Locate an executable given a Path argument. This routine is only used by
3032 gnatbl and should not be used otherwise. Use locate_exec_on_path
3036 __gnat_locate_exec (char *exec_name
, char *path_val
)
3038 const unsigned int len
= strlen (HOST_EXECUTABLE_SUFFIX
);
3041 if (len
> 0 && !strstr (exec_name
, HOST_EXECUTABLE_SUFFIX
))
3043 char *full_exec_name
= (char *) alloca (strlen (exec_name
) + len
+ 1);
3045 strcpy (full_exec_name
, exec_name
);
3046 strcat (full_exec_name
, HOST_EXECUTABLE_SUFFIX
);
3047 ptr
= __gnat_locate_executable_file (full_exec_name
, path_val
);
3050 return __gnat_locate_executable_file (exec_name
, path_val
);
3054 return __gnat_locate_executable_file (exec_name
, path_val
);
3057 /* Locate an executable using the Systems default PATH. */
3060 __gnat_locate_exec_on_path (char *exec_name
)
3064 #if defined (_WIN32)
3065 TCHAR
*wpath_val
= _tgetenv (_T("PATH"));
3067 /* In Win32 systems we expand the PATH as for XP environment
3068 variables are not automatically expanded. We also prepend the
3069 ".;" to the path to match normal NT path search semantics */
3071 #define EXPAND_BUFFER_SIZE 32767
3073 wapath_val
= (TCHAR
*) alloca (EXPAND_BUFFER_SIZE
);
3075 wapath_val
[0] = '.';
3076 wapath_val
[1] = ';';
3078 DWORD res
= ExpandEnvironmentStrings
3079 (wpath_val
, &wapath_val
[2], EXPAND_BUFFER_SIZE
- 2);
3081 if (!res
) wapath_val
[0] = _T('\0');
3083 apath_val
= (char *) alloca (EXPAND_BUFFER_SIZE
);
3085 WS2SC (apath_val
, wapath_val
, EXPAND_BUFFER_SIZE
);
3088 const char *path_val
= getenv ("PATH");
3090 /* If PATH is not defined, proceed with __gnat_locate_exec anyway, so we can
3091 find files that contain directory names. */
3093 if (path_val
== NULL
) path_val
= "";
3094 apath_val
= (char *) alloca (strlen (path_val
) + 1);
3095 strcpy (apath_val
, path_val
);
3098 return __gnat_locate_exec (exec_name
, apath_val
);
3101 /* Dummy functions for Osint import for non-VMS systems.
3102 ??? To be removed. */
3105 __gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED
,
3106 int onlydirs ATTRIBUTE_UNUSED
)
3112 __gnat_to_canonical_file_list_next (void)
3114 static char empty
[] = "";
3119 __gnat_to_canonical_file_list_free (void)
3124 __gnat_to_canonical_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
3130 __gnat_to_canonical_file_spec (char *filespec
)
3136 __gnat_to_canonical_path_spec (char *pathspec
)
3142 __gnat_to_host_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
3148 __gnat_to_host_file_spec (char *filespec
)
3154 __gnat_adjust_os_resource_limits (void)
3158 #if defined (__mips_vxworks)
3162 CACHE_USER_FLUSH (0, ENTIRE_CACHE
);
3166 #if defined (_WIN32)
3167 int __gnat_argument_needs_quote
= 1;
3169 int __gnat_argument_needs_quote
= 0;
3172 /* This option is used to enable/disable object files handling from the
3173 binder file by the GNAT Project module. For example, this is disabled on
3174 Windows (prior to GCC 3.4) as it is already done by the mdll module.
3175 Stating with GCC 3.4 the shared libraries are not based on mdll
3176 anymore as it uses the GCC's -shared option */
3177 #if defined (_WIN32) \
3178 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
3179 int __gnat_prj_add_obj_files
= 0;
3181 int __gnat_prj_add_obj_files
= 1;
3184 /* char used as prefix/suffix for environment variables */
3185 #if defined (_WIN32)
3186 char __gnat_environment_char
= '%';
3188 char __gnat_environment_char
= '$';
3191 /* This functions copy the file attributes from a source file to a
3194 mode = 0 : In this mode copy only the file time stamps (last access and
3195 last modification time stamps).
3197 mode = 1 : In this mode, time stamps and read/write/execute attributes are
3200 mode = 2 : In this mode, only read/write/execute attributes are copied
3202 Returns 0 if operation was successful and -1 in case of error. */
3205 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED
, char *to ATTRIBUTE_UNUSED
,
3206 int mode ATTRIBUTE_UNUSED
)
3208 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
3211 #elif defined (_WIN32)
3212 TCHAR wfrom
[GNAT_MAX_PATH_LEN
+ 2];
3213 TCHAR wto
[GNAT_MAX_PATH_LEN
+ 2];
3215 FILETIME fct
, flat
, flwt
;
3218 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
+ 2);
3219 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
+ 2);
3221 /* Do we need to copy the timestamp ? */
3224 /* retrieve from times */
3227 (wfrom
, GENERIC_READ
, 0, NULL
, OPEN_EXISTING
,
3228 FILE_ATTRIBUTE_NORMAL
, NULL
);
3230 if (hfrom
== INVALID_HANDLE_VALUE
)
3233 res
= GetFileTime (hfrom
, &fct
, &flat
, &flwt
);
3235 CloseHandle (hfrom
);
3240 /* retrieve from times */
3243 (wto
, GENERIC_WRITE
, 0, NULL
, OPEN_EXISTING
,
3244 FILE_ATTRIBUTE_NORMAL
, NULL
);
3246 if (hto
== INVALID_HANDLE_VALUE
)
3249 res
= SetFileTime (hto
, NULL
, &flat
, &flwt
);
3257 /* Do we need to copy the permissions ? */
3258 /* Set file attributes in full mode. */
3262 DWORD attribs
= GetFileAttributes (wfrom
);
3264 if (attribs
== INVALID_FILE_ATTRIBUTES
)
3267 res
= SetFileAttributes (wto
, attribs
);
3275 GNAT_STRUCT_STAT fbuf
;
3277 if (GNAT_STAT (from
, &fbuf
) == -1) {
3281 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 7)
3283 /* VxWorks prior to 7 only has utime. */
3285 /* Do we need to copy the timestamp ? */
3287 struct utimbuf tbuf
;
3289 tbuf
.actime
= fbuf
.st_atime
;
3290 tbuf
.modtime
= fbuf
.st_mtime
;
3292 if (utime (to
, &tbuf
) == -1)
3296 #elif _POSIX_C_SOURCE >= 200809L
3297 struct timespec tbuf
[2];
3300 tbuf
[0] = fbuf
.st_atim
;
3301 tbuf
[1] = fbuf
.st_mtim
;
3303 if (utimensat (AT_FDCWD
, to
, tbuf
, 0) == -1) {
3309 struct timeval tbuf
[2];
3310 /* Do we need to copy timestamp ? */
3313 tbuf
[0].tv_sec
= fbuf
.st_atime
;
3314 tbuf
[1].tv_sec
= fbuf
.st_mtime
;
3316 #if defined(st_mtime)
3317 tbuf
[0].tv_usec
= fbuf
.st_atim
.tv_nsec
/ 1000;
3318 tbuf
[1].tv_usec
= fbuf
.st_mtim
.tv_nsec
/ 1000;
3320 tbuf
[0].tv_usec
= 0;
3321 tbuf
[1].tv_usec
= 0;
3324 if (utimes (to
, tbuf
) == -1) {
3330 /* Do we need to copy file permissions ? */
3331 if (mode
!= 0 && (chmod (to
, fbuf
.st_mode
) == -1)) {
3340 __gnat_lseek (int fd
, long offset
, int whence
)
3342 return (int) lseek (fd
, offset
, whence
);
3345 /* This function returns the major version number of GCC being used. */
3347 get_gcc_version (void)
3352 return (int) (version_string
[0] - '0');
3357 * Set Close_On_Exec as indicated.
3358 * Note: this is used for both GNAT.OS_Lib and GNAT.Sockets.
3362 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED
,
3363 int close_on_exec_p ATTRIBUTE_UNUSED
)
3365 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
3366 int flags
= fcntl (fd
, F_GETFD
, 0);
3369 if (close_on_exec_p
)
3370 flags
|= FD_CLOEXEC
;
3372 flags
&= ~FD_CLOEXEC
;
3373 return fcntl (fd
, F_SETFD
, flags
);
3374 #elif defined(_WIN32)
3375 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
3376 if (h
== (HANDLE
) -1)
3378 if (close_on_exec_p
)
3379 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
, 0);
3380 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
,
3381 HANDLE_FLAG_INHERIT
);
3383 /* TODO: Unimplemented. */
3388 /* Indicates if platforms supports automatic initialization through the
3389 constructor mechanism */
3391 __gnat_binder_supports_auto_init (void)
3396 /* Indicates that Stand-Alone Libraries are automatically initialized through
3397 the constructor mechanism */
3399 __gnat_sals_init_using_constructors (void)
3401 #if defined (__vxworks) || defined (__Lynx__)
3408 #if defined (__linux__) || defined (__ANDROID__)
3409 /* There is no function in the glibc to retrieve the LWP of the current
3410 thread. We need to do a system call in order to retrieve this
3412 #include <sys/syscall.h>
3414 __gnat_lwp_self (void)
3416 return (void *) syscall (__NR_gettid
);
3420 #if defined (__APPLE__)
3421 # if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1060
3422 # include <mach/thread_info.h>
3423 # include <mach/mach_init.h>
3424 # include <mach/thread_act.h>
3426 # include <pthread.h>
3429 /* System-wide thread identifier. Note it could be truncated on 32 bit
3431 Previously was: pthread_mach_thread_np (pthread_self ()). */
3433 __gnat_lwp_self (void)
3435 #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1060
3436 thread_identifier_info_data_t data
;
3437 mach_msg_type_number_t count
= THREAD_IDENTIFIER_INFO_COUNT
;
3440 kret
= thread_info (mach_thread_self (), THREAD_IDENTIFIER_INFO
,
3441 (thread_info_t
) &data
, &count
);
3442 if (kret
== KERN_SUCCESS
)
3443 return (void *)(uintptr_t)data
.thread_id
;
3447 return (void *)pthread_mach_thread_np (pthread_self ());
3452 #if defined (__linux__)
3455 /* glibc versions earlier than 2.7 do not define the routines to handle
3456 dynamically allocated CPU sets. For these targets, we use the static
3461 /* Dynamic cpu sets */
3464 __gnat_cpu_alloc (size_t count
)
3466 return CPU_ALLOC (count
);
3470 __gnat_cpu_alloc_size (size_t count
)
3472 return CPU_ALLOC_SIZE (count
);
3476 __gnat_cpu_free (cpu_set_t
*set
)
3482 __gnat_cpu_zero (size_t count
, cpu_set_t
*set
)
3484 CPU_ZERO_S (count
, set
);
3488 __gnat_cpu_set (int cpu
, size_t count
, cpu_set_t
*set
)
3490 /* Ada handles CPU numbers starting from 1, while C identifies the first
3491 CPU by a 0, so we need to adjust. */
3492 CPU_SET_S (cpu
- 1, count
, set
);
3495 #else /* !CPU_ALLOC */
3497 /* Static cpu sets */
3500 __gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED
)
3502 return (cpu_set_t
*) xmalloc (sizeof (cpu_set_t
));
3506 __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED
)
3508 return sizeof (cpu_set_t
);
3512 __gnat_cpu_free (cpu_set_t
*set
)
3518 __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3524 __gnat_cpu_set (int cpu
, size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3526 /* Ada handles CPU numbers starting from 1, while C identifies the first
3527 CPU by a 0, so we need to adjust. */
3528 CPU_SET (cpu
- 1, set
);
3530 #endif /* !CPU_ALLOC */
3531 #endif /* __linux__ */
3533 /* Return the load address of the executable, or 0 if not known. In the
3534 specific case of error, (void *)-1 can be returned. Beware: this unit may
3535 be in a shared library. As low-level units are needed, we allow #include
3538 #if defined (__APPLE__)
3539 #include <mach-o/dyld.h>
3540 #elif defined (__linux__)
3541 #include <features.h>
3546 __gnat_get_executable_load_address (void)
3548 #if defined (__APPLE__)
3549 return _dyld_get_image_header (0);
3551 #elif defined (__linux__) && (defined (__GLIBC__) || defined (__UCLIBC__))
3552 struct link_map
*map
= _r_debug
.r_map
;
3553 return (const void *)map
->l_addr
;
3555 #elif defined (_WIN32)
3556 return GetModuleHandle (NULL
);
3564 __gnat_kill (int pid
, int sig
)
3570 case 9: // SIGKILL is not declared in Windows headers
3575 h
= OpenProcess (PROCESS_ALL_ACCESS
, FALSE
, pid
);
3577 TerminateProcess (h
, sig
);
3582 #elif defined (__vxworks)
3583 /* Not implemented */
3589 void __gnat_killprocesstree (int pid
, int sig_num
)
3594 memset(&pe
, 0, sizeof(PROCESSENTRY32
));
3595 pe
.dwSize
= sizeof(PROCESSENTRY32
);
3597 HANDLE hSnap
= CreateToolhelp32Snapshot (TH32CS_SNAPPROCESS
, 0);
3599 /* cannot take snapshot, just kill the parent process */
3601 if (hSnap
== INVALID_HANDLE_VALUE
)
3603 __gnat_kill (pid
, sig_num
);
3607 if (Process32First(hSnap
, &pe
))
3609 BOOL bContinue
= TRUE
;
3611 /* kill child processes first */
3615 if (pe
.th32ParentProcessID
== (DWORD
)pid
)
3616 __gnat_killprocesstree (pe
.th32ProcessID
, sig_num
);
3618 bContinue
= Process32Next (hSnap
, &pe
);
3622 CloseHandle (hSnap
);
3626 __gnat_kill (pid
, sig_num
);
3628 #elif defined (__vxworks)
3629 /* not implemented */
3631 #elif defined (__linux__)
3635 /* read all processes' pid and ppid */
3637 dir
= opendir ("/proc");
3639 /* cannot open proc, just kill the parent process */
3643 __gnat_kill (pid
, sig_num
);
3647 /* kill child processes first */
3649 while ((d
= readdir (dir
)) != NULL
)
3651 if ((d
->d_type
& DT_DIR
) == DT_DIR
)
3656 /* read /proc/<PID>/stat */
3658 if (strlen (d
->d_name
) >= sizeof (statfile
) - strlen ("/proc//stat"))
3660 strcpy (statfile
, "/proc/");
3661 strcat (statfile
, d
->d_name
);
3662 strcat (statfile
, "/stat");
3664 FILE *fd
= fopen (statfile
, "r");
3668 const int match
= fscanf (fd
, "%d %*s %*s %d", &_pid
, &_ppid
);
3671 if (match
== 2 && _ppid
== pid
)
3672 __gnat_killprocesstree (_pid
, sig_num
);
3681 __gnat_kill (pid
, sig_num
);
3683 __gnat_kill (pid
, sig_num
);
3685 /* Note on Solaris it is possible to read /proc/<PID>/status.
3686 The 5th and 6th words are the pid and the 7th and 8th the ppid.
3687 See: /usr/include/sys/procfs.h (struct pstatus).