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 if (!GetFileAttributesExA(name
, GetFileExInfoStandard
, &fad
)) {
1514 t_write
.ft_time
= fad
.ftLastWriteTime
;
1516 #if defined(__GNUG__) && __GNUG__ <= 4
1517 result
= (t_write
.ll_time
- w32_epoch_offset
) * 100;
1519 /* Next code similar to (t_write.ll_time - w32_epoch_offset) * 100
1520 but on overflow returns LLONG_MIN value. */
1522 if (__builtin_ssubll_overflow(t_write
.ll_time
, w32_epoch_offset
, &result
)) {
1526 if (__builtin_smulll_overflow(result
, 100, &result
)) {
1534 if (stat(name
, &sb
) != 0) {
1538 #if defined(__GNUG__) && __GNUG__ <= 4
1539 result
= (sb
.st_mtime
- ada_epoch_offset
) * 1E9
;
1540 #if defined(st_mtime)
1541 result
+= sb
.st_mtim
.tv_nsec
;
1544 /* Next code similar to
1545 (sb.st_mtime - ada_epoch_offset) * 1E9 + sb.st_mtim.tv_nsec
1546 but on overflow returns LLONG_MIN value. */
1548 if (__builtin_ssubll_overflow(sb
.st_mtime
, ada_epoch_offset
, &result
)) {
1552 if (__builtin_smulll_overflow(result
, 1E9
, &result
)) {
1556 #if defined(st_mtime)
1557 if (__builtin_saddll_overflow(result
, sb
.st_mtim
.tv_nsec
, &result
)) {
1566 /* Set the file time stamp. */
1569 __gnat_set_file_time_name (char *name
, OS_Time time_stamp
)
1571 #if defined (__vxworks)
1573 /* Code to implement __gnat_set_file_time_name for these systems. */
1575 #elif defined (_WIN32)
1579 unsigned long long ull_time
;
1581 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1583 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1585 HANDLE h
= CreateFile
1586 (wname
, GENERIC_WRITE
, FILE_SHARE_WRITE
, NULL
,
1587 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
,
1589 if (h
== INVALID_HANDLE_VALUE
)
1591 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1592 t_write
.ull_time
= ((unsigned long long)time_stamp
+ w32_epoch_offset
);
1593 /* Convert to 100 nanosecond units */
1594 t_write
.ull_time
*= 10000000ULL;
1596 SetFileTime(h
, NULL
, NULL
, &t_write
.ft_time
);
1601 struct utimbuf utimbuf
;
1604 /* Set modification time to requested time. */
1605 utimbuf
.modtime
= (time_t) time_stamp
;
1607 /* Set access time to now in local time. */
1609 utimbuf
.actime
= mktime (localtime (&t
));
1611 utime (name
, &utimbuf
);
1615 /* Get the list of installed standard libraries from the
1616 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1620 __gnat_get_libraries_from_registry (void)
1622 char *result
= (char *) xmalloc (1);
1626 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
1629 DWORD name_size
, value_size
;
1636 /* First open the key. */
1637 res
= RegOpenKeyExA (HKEY_LOCAL_MACHINE
, "SOFTWARE", 0, KEY_READ
, ®_key
);
1639 if (res
== ERROR_SUCCESS
)
1640 res
= RegOpenKeyExA (reg_key
, "Ada Core Technologies", 0,
1641 KEY_READ
, ®_key
);
1643 if (res
== ERROR_SUCCESS
)
1644 res
= RegOpenKeyExA (reg_key
, "GNAT", 0, KEY_READ
, ®_key
);
1646 if (res
== ERROR_SUCCESS
)
1647 res
= RegOpenKeyExA (reg_key
, "Standard Libraries", 0, KEY_READ
, ®_key
);
1649 /* If the key exists, read out all the values in it and concatenate them
1651 for (index
= 0; res
== ERROR_SUCCESS
; index
++)
1653 value_size
= name_size
= 256;
1654 res
= RegEnumValueA (reg_key
, index
, name
, &name_size
, 0,
1655 &type
, (LPBYTE
)value
, &value_size
);
1657 if (res
== ERROR_SUCCESS
&& type
== REG_SZ
)
1659 char *old_result
= result
;
1661 result
= (char *) xmalloc (strlen (old_result
) + value_size
+ 2);
1662 strcpy (result
, old_result
);
1663 strcat (result
, value
);
1664 strcat (result
, ";");
1669 /* Remove the trailing ";". */
1671 result
[strlen (result
) - 1] = 0;
1677 /* Query information for the given file NAME and return it in STATBUF.
1678 * Returns 0 for success, or errno value for failure.
1681 __gnat_stat (char *name
, GNAT_STRUCT_STAT
*statbuf
)
1684 WIN32_FILE_ATTRIBUTE_DATA fad
;
1685 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1690 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1691 name_len
= _tcslen (wname
);
1693 if (name_len
> GNAT_MAX_PATH_LEN
)
1696 ZeroMemory (statbuf
, sizeof(GNAT_STRUCT_STAT
));
1698 res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
);
1701 error
= GetLastError();
1703 /* Check file existence using GetFileAttributes() which does not fail on
1704 special Windows files like con:, aux:, nul: etc... */
1706 if (GetFileAttributes(wname
) != INVALID_FILE_ATTRIBUTES
) {
1707 /* Just pretend that it is a regular and readable file */
1708 statbuf
->st_mode
= S_IFREG
| S_IREAD
| S_IWRITE
;
1713 case ERROR_ACCESS_DENIED
:
1714 case ERROR_SHARING_VIOLATION
:
1715 case ERROR_LOCK_VIOLATION
:
1716 case ERROR_SHARING_BUFFER_EXCEEDED
:
1718 case ERROR_BUFFER_OVERFLOW
:
1719 return ENAMETOOLONG
;
1720 case ERROR_NOT_ENOUGH_MEMORY
:
1727 f2t (&fad
.ftCreationTime
, &statbuf
->st_ctime
);
1728 f2t (&fad
.ftLastWriteTime
, &statbuf
->st_mtime
);
1729 f2t (&fad
.ftLastAccessTime
, &statbuf
->st_atime
);
1732 (__int64
)fad
.nFileSizeLow
| (__int64
)fad
.nFileSizeHigh
<< 32;
1734 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1735 statbuf
->st_mode
= S_IREAD
;
1737 if (fad
.dwFileAttributes
& FILE_ATTRIBUTE_DIRECTORY
)
1738 statbuf
->st_mode
|= S_IFDIR
;
1740 statbuf
->st_mode
|= S_IFREG
;
1742 if (!(fad
.dwFileAttributes
& FILE_ATTRIBUTE_READONLY
))
1743 statbuf
->st_mode
|= S_IWRITE
;
1748 return GNAT_STAT (name
, statbuf
) == 0 ? 0 : errno
;
1752 /*************************************************************************
1753 ** Check whether a file exists
1754 *************************************************************************/
1757 __gnat_file_exists_attr (char* name
, struct file_attributes
* attr
)
1759 if (attr
->exists
== ATTR_UNSET
)
1760 __gnat_stat_to_attr (-1, name
, attr
);
1762 return attr
->exists
;
1766 __gnat_file_exists (char *name
)
1768 struct file_attributes attr
;
1769 __gnat_reset_attributes (&attr
);
1770 return __gnat_file_exists_attr (name
, &attr
);
1773 /**********************************************************************
1774 ** Whether name is an absolute path
1775 **********************************************************************/
1778 __gnat_is_absolute_path (char *name
, int length
)
1781 /* On VxWorks systems, an absolute path can be represented (depending on
1782 the host platform) as either /dir/file, or device:/dir/file, or
1783 device:drive_letter:/dir/file. */
1790 for (index
= 0; index
< length
; index
++)
1792 if (name
[index
] == ':' &&
1793 ((name
[index
+ 1] == '/') ||
1794 (isalpha (name
[index
+ 1]) && index
+ 2 <= length
&&
1795 name
[index
+ 2] == '/')))
1798 else if (name
[index
] == '/')
1803 return (length
!= 0) &&
1804 (IS_DIRECTORY_SEPARATOR(*name
)
1805 #if defined (WINNT) || defined(__DJGPP__)
1806 || (length
> 2 && ISALPHA (name
[0]) && name
[1] == ':'
1807 && IS_DIRECTORY_SEPARATOR(name
[2]))
1814 __gnat_is_regular_file_attr (char* name
, struct file_attributes
* attr
)
1816 if (attr
->regular
== ATTR_UNSET
)
1817 __gnat_stat_to_attr (-1, name
, attr
);
1819 return attr
->regular
;
1823 __gnat_is_regular_file (char *name
)
1825 struct file_attributes attr
;
1827 __gnat_reset_attributes (&attr
);
1828 return __gnat_is_regular_file_attr (name
, &attr
);
1832 __gnat_is_regular_file_fd (int fd
)
1835 GNAT_STRUCT_STAT statbuf
;
1837 ret
= GNAT_FSTAT (fd
, &statbuf
);
1838 return (!ret
&& S_ISREG (statbuf
.st_mode
));
1842 __gnat_is_directory_attr (char* name
, struct file_attributes
* attr
)
1844 if (attr
->directory
== ATTR_UNSET
)
1845 __gnat_stat_to_attr (-1, name
, attr
);
1847 return attr
->directory
;
1851 __gnat_is_directory (char *name
)
1853 struct file_attributes attr
;
1855 __gnat_reset_attributes (&attr
);
1856 return __gnat_is_directory_attr (name
, &attr
);
1859 #if defined (_WIN32)
1861 /* Returns the same constant as GetDriveType but takes a pathname as
1865 GetDriveTypeFromPath (TCHAR
*wfullpath
)
1867 TCHAR wdrv
[MAX_PATH
];
1868 TCHAR wpath
[MAX_PATH
];
1869 TCHAR wfilename
[MAX_PATH
];
1870 TCHAR wext
[MAX_PATH
];
1872 _tsplitpath (wfullpath
, wdrv
, wpath
, wfilename
, wext
);
1874 if (_tcslen (wdrv
) != 0)
1876 /* we have a drive specified. */
1877 _tcscat (wdrv
, _T("\\"));
1878 return GetDriveType (wdrv
);
1882 /* No drive specified. */
1884 /* Is this a relative path, if so get current drive type. */
1885 if (wpath
[0] != _T('\\') ||
1886 (_tcslen (wpath
) > 2 && wpath
[0] == _T('\\')
1887 && wpath
[1] != _T('\\')))
1888 return GetDriveType (NULL
);
1890 UINT result
= GetDriveType (wpath
);
1892 /* Cannot guess the drive type, is this \\.\ ? */
1894 if (result
== DRIVE_NO_ROOT_DIR
&&
1895 _tcslen (wpath
) >= 4 && wpath
[0] == _T('\\') && wpath
[1] == _T('\\')
1896 && wpath
[2] == _T('.') && wpath
[3] == _T('\\'))
1898 if (_tcslen (wpath
) == 4)
1899 _tcscat (wpath
, wfilename
);
1901 LPTSTR p
= &wpath
[4];
1902 LPTSTR b
= _tcschr (p
, _T('\\'));
1906 /* logical drive \\.\c\dir\file */
1912 _tcscat (p
, _T(":\\"));
1914 return GetDriveType (p
);
1921 /* This MingW section contains code to work with ACL. */
1923 __gnat_check_OWNER_ACL (TCHAR
*wname
,
1924 DWORD CheckAccessDesired
,
1925 GENERIC_MAPPING CheckGenericMapping
)
1927 DWORD dwAccessDesired
, dwAccessAllowed
;
1928 PRIVILEGE_SET PrivilegeSet
;
1929 DWORD dwPrivSetSize
= sizeof (PRIVILEGE_SET
);
1930 BOOL fAccessGranted
= FALSE
;
1931 HANDLE hToken
= NULL
;
1933 PSECURITY_DESCRIPTOR pSD
= NULL
;
1936 (wname
, OWNER_SECURITY_INFORMATION
|
1937 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1940 if ((pSD
= (SECURITY_DESCRIPTOR
*) HeapAlloc
1941 (GetProcessHeap (), HEAP_ZERO_MEMORY
, nLength
)) == NULL
)
1944 /* Obtain the security descriptor. */
1946 if (!GetFileSecurity
1947 (wname
, OWNER_SECURITY_INFORMATION
|
1948 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1949 pSD
, nLength
, &nLength
))
1952 if (!ImpersonateSelf (SecurityImpersonation
))
1955 if (!OpenThreadToken
1956 (GetCurrentThread(), TOKEN_DUPLICATE
| TOKEN_QUERY
, FALSE
, &hToken
))
1959 /* Undoes the effect of ImpersonateSelf. */
1963 /* We want to test for write permissions. */
1965 dwAccessDesired
= CheckAccessDesired
;
1967 MapGenericMask (&dwAccessDesired
, &CheckGenericMapping
);
1970 (pSD
, /* security descriptor to check */
1971 hToken
, /* impersonation token */
1972 dwAccessDesired
, /* requested access rights */
1973 &CheckGenericMapping
, /* pointer to GENERIC_MAPPING */
1974 &PrivilegeSet
, /* receives privileges used in check */
1975 &dwPrivSetSize
, /* size of PrivilegeSet buffer */
1976 &dwAccessAllowed
, /* receives mask of allowed access rights */
1980 CloseHandle (hToken
);
1981 HeapFree (GetProcessHeap (), 0, pSD
);
1982 return fAccessGranted
;
1986 CloseHandle (hToken
);
1987 HeapFree (GetProcessHeap (), 0, pSD
);
1992 __gnat_set_OWNER_ACL (TCHAR
*wname
,
1993 ACCESS_MODE AccessMode
,
1994 DWORD AccessPermissions
)
1996 PACL pOldDACL
= NULL
;
1997 PACL pNewDACL
= NULL
;
1998 PSECURITY_DESCRIPTOR pSD
= NULL
;
2000 TCHAR username
[100];
2003 /* Get current user, he will act as the owner */
2005 if (!GetUserName (username
, &unsize
))
2008 if (GetNamedSecurityInfo
2011 DACL_SECURITY_INFORMATION
,
2012 NULL
, NULL
, &pOldDACL
, NULL
, &pSD
) != ERROR_SUCCESS
)
2015 BuildExplicitAccessWithName
2016 (&ea
, username
, AccessPermissions
, (ACCESS_MODE
) AccessMode
, NO_INHERITANCE
);
2018 if (AccessMode
== SET_ACCESS
)
2020 /* SET_ACCESS, we want to set an explicte set of permissions, do not
2021 merge with current DACL. */
2022 if (SetEntriesInAcl (1, &ea
, NULL
, &pNewDACL
) != ERROR_SUCCESS
)
2026 if (SetEntriesInAcl (1, &ea
, pOldDACL
, &pNewDACL
) != ERROR_SUCCESS
)
2029 if (SetNamedSecurityInfo
2030 (wname
, SE_FILE_OBJECT
,
2031 DACL_SECURITY_INFORMATION
, NULL
, NULL
, pNewDACL
, NULL
) != ERROR_SUCCESS
)
2035 LocalFree (pNewDACL
);
2038 /* Check if it is possible to use ACL for wname, the file must not be on a
2042 __gnat_can_use_acl (TCHAR
*wname
)
2044 return __gnat_use_acl
&& GetDriveTypeFromPath (wname
) != DRIVE_REMOTE
;
2047 #endif /* defined (_WIN32) */
2050 __gnat_is_readable_file_attr (char* name
, struct file_attributes
* attr
)
2052 if (attr
->readable
== ATTR_UNSET
)
2054 #if defined (_WIN32)
2055 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2056 GENERIC_MAPPING GenericMapping
;
2058 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2060 if (__gnat_can_use_acl (wname
))
2062 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
2063 GenericMapping
.GenericRead
= GENERIC_READ
;
2065 __gnat_check_OWNER_ACL (wname
, FILE_READ_DATA
, GenericMapping
);
2068 attr
->readable
= GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
;
2070 __gnat_stat_to_attr (-1, name
, attr
);
2074 return attr
->readable
;
2078 __gnat_is_read_accessible_file (char *name
)
2080 #if defined (_WIN32)
2081 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2083 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2085 return !_waccess (wname
, 4);
2087 #elif defined (__vxworks)
2090 if ((fd
= open (name
, O_RDONLY
, 0)) < 0)
2096 return !access (name
, R_OK
);
2101 __gnat_is_readable_file (char *name
)
2103 struct file_attributes attr
;
2105 __gnat_reset_attributes (&attr
);
2106 return __gnat_is_readable_file_attr (name
, &attr
);
2110 __gnat_is_writable_file_attr (char* name
, struct file_attributes
* attr
)
2112 if (attr
->writable
== ATTR_UNSET
)
2114 #if defined (_WIN32)
2115 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2116 GENERIC_MAPPING GenericMapping
;
2118 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2120 if (__gnat_can_use_acl (wname
))
2122 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
2123 GenericMapping
.GenericWrite
= GENERIC_WRITE
;
2125 attr
->writable
= __gnat_check_OWNER_ACL
2126 (wname
, FILE_WRITE_DATA
| FILE_APPEND_DATA
, GenericMapping
)
2127 && !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
2131 !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
2134 __gnat_stat_to_attr (-1, name
, attr
);
2138 return attr
->writable
;
2142 __gnat_is_writable_file (char *name
)
2144 struct file_attributes attr
;
2146 __gnat_reset_attributes (&attr
);
2147 return __gnat_is_writable_file_attr (name
, &attr
);
2151 __gnat_is_write_accessible_file (char *name
)
2153 #if defined (_WIN32)
2154 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2156 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2158 return !_waccess (wname
, 2);
2160 #elif defined (__vxworks)
2163 if ((fd
= open (name
, O_WRONLY
, 0)) < 0)
2169 return !access (name
, W_OK
);
2174 __gnat_is_executable_file_attr (char* name
, struct file_attributes
* attr
)
2176 if (attr
->executable
== ATTR_UNSET
)
2178 #if defined (_WIN32)
2179 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2180 GENERIC_MAPPING GenericMapping
;
2182 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2184 if (__gnat_can_use_acl (wname
))
2186 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
2187 GenericMapping
.GenericExecute
= GENERIC_EXECUTE
;
2190 __gnat_check_OWNER_ACL (wname
, FILE_EXECUTE
, GenericMapping
);
2194 TCHAR
*l
, *last
= _tcsstr(wname
, _T(".exe"));
2196 /* look for last .exe */
2198 while ((l
= _tcsstr(last
+1, _T(".exe"))))
2202 GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
2203 && (last
- wname
) == (int) (_tcslen (wname
) - 4);
2206 __gnat_stat_to_attr (-1, name
, attr
);
2210 return attr
->regular
&& attr
->executable
;
2214 __gnat_is_executable_file (char *name
)
2216 struct file_attributes attr
;
2218 __gnat_reset_attributes (&attr
);
2219 return __gnat_is_executable_file_attr (name
, &attr
);
2223 __gnat_set_writable (char *name
)
2225 #if defined (_WIN32)
2226 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2228 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2230 if (__gnat_can_use_acl (wname
))
2231 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_WRITE
);
2234 (wname
, GetFileAttributes (wname
) & ~FILE_ATTRIBUTE_READONLY
);
2235 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2236 GNAT_STRUCT_STAT statbuf
;
2238 if (GNAT_STAT (name
, &statbuf
) == 0)
2240 statbuf
.st_mode
= statbuf
.st_mode
| S_IWUSR
;
2241 chmod (name
, statbuf
.st_mode
);
2246 /* must match definition in s-os_lib.ads */
2252 __gnat_set_executable (char *name
, int mode ATTRIBUTE_UNUSED
)
2254 #if defined (_WIN32)
2255 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2257 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2259 if (__gnat_can_use_acl (wname
))
2260 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_EXECUTE
);
2262 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2263 GNAT_STRUCT_STAT statbuf
;
2265 if (GNAT_STAT (name
, &statbuf
) == 0)
2268 statbuf
.st_mode
= statbuf
.st_mode
| S_IXUSR
;
2270 statbuf
.st_mode
= statbuf
.st_mode
| S_IXGRP
;
2271 if (mode
& S_OTHERS
)
2272 statbuf
.st_mode
= statbuf
.st_mode
| S_IXOTH
;
2273 chmod (name
, statbuf
.st_mode
);
2279 __gnat_set_non_writable (char *name
)
2281 #if defined (_WIN32)
2282 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2284 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2286 if (__gnat_can_use_acl (wname
))
2287 __gnat_set_OWNER_ACL
2288 (wname
, DENY_ACCESS
,
2289 FILE_WRITE_DATA
| FILE_APPEND_DATA
|
2290 FILE_WRITE_EA
| FILE_WRITE_ATTRIBUTES
);
2293 (wname
, GetFileAttributes (wname
) | FILE_ATTRIBUTE_READONLY
);
2294 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2295 GNAT_STRUCT_STAT statbuf
;
2297 if (GNAT_STAT (name
, &statbuf
) == 0)
2299 statbuf
.st_mode
= statbuf
.st_mode
& 07577;
2300 chmod (name
, statbuf
.st_mode
);
2306 __gnat_set_readable (char *name
)
2308 #if defined (_WIN32)
2309 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2311 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2313 if (__gnat_can_use_acl (wname
))
2314 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_READ
);
2316 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2317 GNAT_STRUCT_STAT statbuf
;
2319 if (GNAT_STAT (name
, &statbuf
) == 0)
2321 chmod (name
, statbuf
.st_mode
| S_IREAD
);
2327 __gnat_set_non_readable (char *name
)
2329 #if defined (_WIN32)
2330 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2332 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2334 if (__gnat_can_use_acl (wname
))
2335 __gnat_set_OWNER_ACL (wname
, DENY_ACCESS
, FILE_GENERIC_READ
);
2337 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2338 GNAT_STRUCT_STAT statbuf
;
2340 if (GNAT_STAT (name
, &statbuf
) == 0)
2342 chmod (name
, statbuf
.st_mode
& (~S_IREAD
));
2348 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED
,
2349 struct file_attributes
* attr
)
2351 if (attr
->symbolic_link
== ATTR_UNSET
)
2353 #if defined (__vxworks)
2354 attr
->symbolic_link
= 0;
2356 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2358 GNAT_STRUCT_STAT statbuf
;
2359 ret
= GNAT_LSTAT (name
, &statbuf
);
2360 attr
->symbolic_link
= (!ret
&& S_ISLNK (statbuf
.st_mode
));
2362 attr
->symbolic_link
= 0;
2365 return attr
->symbolic_link
;
2369 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED
)
2371 struct file_attributes attr
;
2373 __gnat_reset_attributes (&attr
);
2374 return __gnat_is_symbolic_link_attr (name
, &attr
);
2377 #if defined (__sun__)
2378 /* Using fork on Solaris will duplicate all the threads. fork1, which
2379 duplicates only the active thread, must be used instead, or spawning
2380 subprocess from a program with tasking will lead into numerous problems. */
2385 __gnat_portable_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2387 int status ATTRIBUTE_UNUSED
= 0;
2388 int finished ATTRIBUTE_UNUSED
;
2389 int pid ATTRIBUTE_UNUSED
;
2391 #if defined (__vxworks) || defined(__PikeOS__)
2394 #elif defined (__DJGPP__) || defined (_WIN32)
2395 /* args[0] must be quotes as it could contain a full pathname with spaces */
2396 char *args_0
= args
[0];
2397 args
[0] = (char *)xmalloc (strlen (args_0
) + 3);
2398 strcpy (args
[0], "\"");
2399 strcat (args
[0], args_0
);
2400 strcat (args
[0], "\"");
2402 status
= spawnvp (P_WAIT
, args_0
, (char ** const)args
);
2404 /* restore previous value */
2406 args
[0] = (char *)args_0
;
2422 execv (args
[0], MAYBE_TO_PTR32 (args
));
2424 /* execv() returns only on error */
2429 finished
= waitpid (pid
, &status
, 0);
2431 if (finished
!= pid
|| WIFEXITED (status
) == 0)
2434 return WEXITSTATUS (status
);
2440 /* Create a copy of the given file descriptor.
2441 Return -1 if an error occurred. */
2444 __gnat_dup (int oldfd
)
2446 #if defined (__vxworks) && !defined (__RTP__)
2447 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2455 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2456 Return -1 if an error occurred. */
2459 __gnat_dup2 (int oldfd ATTRIBUTE_UNUSED
, int newfd ATTRIBUTE_UNUSED
)
2461 #if defined (__vxworks) && !defined (__RTP__)
2462 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2465 #elif defined (__PikeOS__)
2466 /* Not supported. */
2468 #elif defined (_WIN32)
2469 /* Special case when oldfd and newfd are identical and are the standard
2470 input, output or error as this makes Windows XP hangs. Note that we
2471 do that only for standard file descriptors that are known to be valid. */
2472 if (oldfd
== newfd
&& newfd
>= 0 && newfd
<= 2)
2475 return dup2 (oldfd
, newfd
);
2477 return dup2 (oldfd
, newfd
);
2482 __gnat_number_of_cpus (void)
2486 #if defined (_SC_NPROCESSORS_ONLN)
2487 cores
= (int) sysconf (_SC_NPROCESSORS_ONLN
);
2489 #elif defined (__QNX__)
2490 cores
= (int) _syspage_ptr
->num_cpu
;
2492 #elif defined (__hpux__)
2493 struct pst_dynamic psd
;
2494 if (pstat_getdynamic (&psd
, sizeof (psd
), 1, 0) != -1)
2495 cores
= (int) psd
.psd_proc_cnt
;
2497 #elif defined (_WIN32)
2498 SYSTEM_INFO sysinfo
;
2499 GetSystemInfo (&sysinfo
);
2500 cores
= (int) sysinfo
.dwNumberOfProcessors
;
2502 #elif defined (_WRS_CONFIG_SMP)
2503 unsigned int vxCpuConfiguredGet (void);
2505 cores
= vxCpuConfiguredGet ();
2512 /* WIN32 code to implement a wait call that wait for any child process. */
2514 #if defined (_WIN32)
2516 /* Synchronization code, to be thread safe. */
2520 /* For the Cert run times on native Windows we use dummy functions
2521 for locking and unlocking tasks since we do not support multiple
2522 threads on this configuration (Cert run time on native Windows). */
2524 static void EnterCS (void) {}
2525 static void LeaveCS (void) {}
2526 static void SignalListChanged (void) {}
2530 CRITICAL_SECTION ProcListCS
;
2531 HANDLE ProcListEvt
= NULL
;
2533 static void EnterCS (void)
2535 EnterCriticalSection(&ProcListCS
);
2538 static void LeaveCS (void)
2540 LeaveCriticalSection(&ProcListCS
);
2543 static void SignalListChanged (void)
2545 SetEvent (ProcListEvt
);
2550 static HANDLE
*HANDLES_LIST
= NULL
;
2551 static int *PID_LIST
= NULL
, plist_length
= 0, plist_max_length
= 0;
2554 add_handle (HANDLE h
, int pid
)
2556 /* -------------------- critical section -------------------- */
2559 if (plist_length
== plist_max_length
)
2561 plist_max_length
+= 100;
2563 (HANDLE
*) xrealloc (HANDLES_LIST
, sizeof (HANDLE
) * plist_max_length
);
2565 (int *) xrealloc (PID_LIST
, sizeof (int) * plist_max_length
);
2568 HANDLES_LIST
[plist_length
] = h
;
2569 PID_LIST
[plist_length
] = pid
;
2572 SignalListChanged();
2574 /* -------------------- critical section -------------------- */
2578 __gnat_win32_remove_handle (HANDLE h
, int pid
)
2583 /* -------------------- critical section -------------------- */
2586 for (j
= 0; j
< plist_length
; j
++)
2588 if ((HANDLES_LIST
[j
] == h
) || (PID_LIST
[j
] == pid
))
2592 HANDLES_LIST
[j
] = HANDLES_LIST
[plist_length
];
2593 PID_LIST
[j
] = PID_LIST
[plist_length
];
2600 /* -------------------- critical section -------------------- */
2603 SignalListChanged();
2609 win32_no_block_spawn (char *command
, char *args
[], HANDLE
*h
, int *pid
)
2613 PROCESS_INFORMATION PI
;
2614 SECURITY_ATTRIBUTES SA
;
2619 /* compute the total command line length */
2623 csize
+= strlen (args
[k
]) + 1;
2627 full_command
= (char *) xmalloc (csize
);
2630 SI
.cb
= sizeof (STARTUPINFO
);
2631 SI
.lpReserved
= NULL
;
2632 SI
.lpReserved2
= NULL
;
2633 SI
.lpDesktop
= NULL
;
2637 SI
.wShowWindow
= SW_HIDE
;
2639 /* Security attributes. */
2640 SA
.nLength
= sizeof (SECURITY_ATTRIBUTES
);
2641 SA
.bInheritHandle
= TRUE
;
2642 SA
.lpSecurityDescriptor
= NULL
;
2644 /* Prepare the command string. */
2645 strcpy (full_command
, command
);
2646 strcat (full_command
, " ");
2651 strcat (full_command
, args
[k
]);
2652 strcat (full_command
, " ");
2657 int wsize
= csize
* 2;
2658 TCHAR
*wcommand
= (TCHAR
*) xmalloc (wsize
);
2660 S2WSC (wcommand
, full_command
, wsize
);
2662 free (full_command
);
2664 result
= CreateProcess
2665 (NULL
, wcommand
, &SA
, NULL
, TRUE
,
2666 GetPriorityClass (GetCurrentProcess()), NULL
, NULL
, &SI
, &PI
);
2673 CloseHandle (PI
.hThread
);
2675 *pid
= PI
.dwProcessId
;
2685 win32_wait (int *status
)
2687 DWORD exitcode
, pid
;
2698 if (plist_length
== 0)
2704 /* -------------------- critical section -------------------- */
2707 /* ??? We can't wait for more than MAXIMUM_WAIT_OBJECTS due to a Win32
2709 if (plist_length
< MAXIMUM_WAIT_OBJECTS
)
2710 hl_len
= plist_length
;
2718 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * hl_len
);
2719 memmove (hl
, HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2720 pidl
= (int *) xmalloc (sizeof (int) * hl_len
);
2721 memmove (pidl
, PID_LIST
, sizeof (int) * hl_len
);
2723 /* Note that index 0 contains the event handle that is signaled when the
2724 process list has changed */
2725 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * (hl_len
+ 1));
2726 hl
[0] = ProcListEvt
;
2727 memmove (&hl
[1], HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2728 pidl
= (int *) xmalloc (sizeof (int) * (hl_len
+ 1));
2729 memmove (&pidl
[1], PID_LIST
, sizeof (int) * hl_len
);
2734 /* -------------------- critical section -------------------- */
2736 res
= WaitForMultipleObjects (hl_len
, hl
, FALSE
, INFINITE
);
2738 /* If there was an error, exit now */
2739 if (res
== WAIT_FAILED
)
2747 /* if the ProcListEvt has been signaled then the list of processes has been
2748 updated to add or remove a handle, just loop over */
2750 if (res
- WAIT_OBJECT_0
== 0)
2757 /* Handle two distinct groups of return codes: finished waits and abandoned
2760 if (res
< WAIT_ABANDONED_0
)
2761 pos
= res
- WAIT_OBJECT_0
;
2763 pos
= res
- WAIT_ABANDONED_0
;
2766 GetExitCodeProcess (h
, &exitcode
);
2769 found
= __gnat_win32_remove_handle (h
, -1);
2774 /* if not found another process waiting has already handled this process */
2781 *status
= (int) exitcode
;
2788 __gnat_portable_no_block_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2791 #if defined (__vxworks) || defined (__PikeOS__)
2792 /* Not supported. */
2795 #elif defined(__DJGPP__)
2796 if (spawnvp (P_WAIT
, args
[0], args
) != 0)
2801 #elif defined (_WIN32)
2806 win32_no_block_spawn (args
[0], args
, &h
, &pid
);
2809 add_handle (h
, pid
);
2822 execv (args
[0], MAYBE_TO_PTR32 (args
));
2824 /* execv() returns only on error */
2834 __gnat_portable_wait (int *process_status
)
2839 #if defined (__vxworks) || defined (__PikeOS__)
2840 /* Not sure what to do here, so do nothing but return zero. */
2842 #elif defined (_WIN32)
2844 pid
= win32_wait (&status
);
2846 #elif defined (__DJGPP__)
2847 /* Child process has already ended in case of DJGPP.
2848 No need to do anything. Just return success. */
2851 pid
= waitpid (-1, &status
, 0);
2852 status
= status
& 0xffff;
2855 *process_status
= status
;
2860 __gnat_portable_no_block_wait (int *process_status
)
2865 #if defined (__vxworks) || defined (__PikeOS__) || defined (_WIN32)
2866 /* Not supported. */
2871 pid
= waitpid (-1, &status
, WNOHANG
);
2872 status
= status
& 0xffff;
2875 *process_status
= status
;
2880 __gnat_os_exit (int status
)
2886 __gnat_current_process_id (void)
2888 #if defined (__vxworks) || defined (__PikeOS__)
2891 #elif defined (_WIN32)
2893 return (int)GetCurrentProcessId();
2897 return (int)getpid();
2901 /* Locate file on path, that matches a predicate */
2904 __gnat_locate_file_with_predicate (char *file_name
, char *path_val
,
2905 int (*predicate
)(char *))
2908 char *file_path
= (char *) alloca (strlen (file_name
) + 1);
2911 /* Return immediately if file_name is empty */
2913 if (*file_name
== '\0')
2916 /* Remove quotes around file_name if present */
2922 strcpy (file_path
, ptr
);
2924 ptr
= file_path
+ strlen (file_path
) - 1;
2929 /* Handle absolute pathnames. */
2931 absolute
= __gnat_is_absolute_path (file_path
, strlen (file_name
));
2935 if (predicate (file_path
))
2936 return xstrdup (file_path
);
2941 /* If file_name include directory separator(s), try it first as
2942 a path name relative to the current directory */
2943 for (ptr
= file_name
; *ptr
&& !IS_DIRECTORY_SEPARATOR(*ptr
); ptr
++)
2948 if (predicate (file_name
))
2949 return xstrdup (file_name
);
2956 /* The result has to be smaller than path_val + file_name. */
2958 (char *) alloca (strlen (path_val
) + strlen (file_name
) + 2);
2962 /* Skip the starting quote */
2964 if (*path_val
== '"')
2967 for (ptr
= file_path
; *path_val
&& *path_val
!= PATH_SEPARATOR
; )
2968 *ptr
++ = *path_val
++;
2970 /* If directory is empty, it is the current directory*/
2972 if (ptr
== file_path
)
2979 /* Skip the ending quote */
2984 if (!IS_DIRECTORY_SEPARATOR(*ptr
))
2985 *++ptr
= DIR_SEPARATOR
;
2987 strcpy (++ptr
, file_name
);
2989 if (predicate (file_path
))
2990 return xstrdup (file_path
);
2995 /* Skip path separator */
3004 /* Locate an executable file, give a Path value. */
3007 __gnat_locate_executable_file (char *file_name
, char *path_val
)
3009 return __gnat_locate_file_with_predicate
3010 (file_name
, path_val
, &__gnat_is_executable_file
);
3013 /* Locate a regular file, give a Path value. */
3016 __gnat_locate_regular_file (char *file_name
, char *path_val
)
3018 return __gnat_locate_file_with_predicate
3019 (file_name
, path_val
, &__gnat_is_regular_file
);
3022 /* Locate an executable given a Path argument. This routine is only used by
3023 gnatbl and should not be used otherwise. Use locate_exec_on_path
3027 __gnat_locate_exec (char *exec_name
, char *path_val
)
3029 const unsigned int len
= strlen (HOST_EXECUTABLE_SUFFIX
);
3032 if (len
> 0 && !strstr (exec_name
, HOST_EXECUTABLE_SUFFIX
))
3034 char *full_exec_name
= (char *) alloca (strlen (exec_name
) + len
+ 1);
3036 strcpy (full_exec_name
, exec_name
);
3037 strcat (full_exec_name
, HOST_EXECUTABLE_SUFFIX
);
3038 ptr
= __gnat_locate_executable_file (full_exec_name
, path_val
);
3041 return __gnat_locate_executable_file (exec_name
, path_val
);
3045 return __gnat_locate_executable_file (exec_name
, path_val
);
3048 /* Locate an executable using the Systems default PATH. */
3051 __gnat_locate_exec_on_path (char *exec_name
)
3055 #if defined (_WIN32)
3056 TCHAR
*wpath_val
= _tgetenv (_T("PATH"));
3058 /* In Win32 systems we expand the PATH as for XP environment
3059 variables are not automatically expanded. We also prepend the
3060 ".;" to the path to match normal NT path search semantics */
3062 #define EXPAND_BUFFER_SIZE 32767
3064 wapath_val
= (TCHAR
*) alloca (EXPAND_BUFFER_SIZE
);
3066 wapath_val
[0] = '.';
3067 wapath_val
[1] = ';';
3069 DWORD res
= ExpandEnvironmentStrings
3070 (wpath_val
, &wapath_val
[2], EXPAND_BUFFER_SIZE
- 2);
3072 if (!res
) wapath_val
[0] = _T('\0');
3074 apath_val
= (char *) alloca (EXPAND_BUFFER_SIZE
);
3076 WS2SC (apath_val
, wapath_val
, EXPAND_BUFFER_SIZE
);
3079 const char *path_val
= getenv ("PATH");
3081 /* If PATH is not defined, proceed with __gnat_locate_exec anyway, so we can
3082 find files that contain directory names. */
3084 if (path_val
== NULL
) path_val
= "";
3085 apath_val
= (char *) alloca (strlen (path_val
) + 1);
3086 strcpy (apath_val
, path_val
);
3089 return __gnat_locate_exec (exec_name
, apath_val
);
3092 /* Dummy functions for Osint import for non-VMS systems.
3093 ??? To be removed. */
3096 __gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED
,
3097 int onlydirs ATTRIBUTE_UNUSED
)
3103 __gnat_to_canonical_file_list_next (void)
3105 static char empty
[] = "";
3110 __gnat_to_canonical_file_list_free (void)
3115 __gnat_to_canonical_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
3121 __gnat_to_canonical_file_spec (char *filespec
)
3127 __gnat_to_canonical_path_spec (char *pathspec
)
3133 __gnat_to_host_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
3139 __gnat_to_host_file_spec (char *filespec
)
3145 __gnat_adjust_os_resource_limits (void)
3149 #if defined (__mips_vxworks)
3153 CACHE_USER_FLUSH (0, ENTIRE_CACHE
);
3157 #if defined (_WIN32)
3158 int __gnat_argument_needs_quote
= 1;
3160 int __gnat_argument_needs_quote
= 0;
3163 /* This option is used to enable/disable object files handling from the
3164 binder file by the GNAT Project module. For example, this is disabled on
3165 Windows (prior to GCC 3.4) as it is already done by the mdll module.
3166 Stating with GCC 3.4 the shared libraries are not based on mdll
3167 anymore as it uses the GCC's -shared option */
3168 #if defined (_WIN32) \
3169 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
3170 int __gnat_prj_add_obj_files
= 0;
3172 int __gnat_prj_add_obj_files
= 1;
3175 /* char used as prefix/suffix for environment variables */
3176 #if defined (_WIN32)
3177 char __gnat_environment_char
= '%';
3179 char __gnat_environment_char
= '$';
3182 /* This functions copy the file attributes from a source file to a
3185 mode = 0 : In this mode copy only the file time stamps (last access and
3186 last modification time stamps).
3188 mode = 1 : In this mode, time stamps and read/write/execute attributes are
3191 mode = 2 : In this mode, only read/write/execute attributes are copied
3193 Returns 0 if operation was successful and -1 in case of error. */
3196 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED
, char *to ATTRIBUTE_UNUSED
,
3197 int mode ATTRIBUTE_UNUSED
)
3199 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
3202 #elif defined (_WIN32)
3203 TCHAR wfrom
[GNAT_MAX_PATH_LEN
+ 2];
3204 TCHAR wto
[GNAT_MAX_PATH_LEN
+ 2];
3206 FILETIME fct
, flat
, flwt
;
3209 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
+ 2);
3210 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
+ 2);
3212 /* Do we need to copy the timestamp ? */
3215 /* retrieve from times */
3218 (wfrom
, GENERIC_READ
, 0, NULL
, OPEN_EXISTING
,
3219 FILE_ATTRIBUTE_NORMAL
, NULL
);
3221 if (hfrom
== INVALID_HANDLE_VALUE
)
3224 res
= GetFileTime (hfrom
, &fct
, &flat
, &flwt
);
3226 CloseHandle (hfrom
);
3231 /* retrieve from times */
3234 (wto
, GENERIC_WRITE
, 0, NULL
, OPEN_EXISTING
,
3235 FILE_ATTRIBUTE_NORMAL
, NULL
);
3237 if (hto
== INVALID_HANDLE_VALUE
)
3240 res
= SetFileTime (hto
, NULL
, &flat
, &flwt
);
3248 /* Do we need to copy the permissions ? */
3249 /* Set file attributes in full mode. */
3253 DWORD attribs
= GetFileAttributes (wfrom
);
3255 if (attribs
== INVALID_FILE_ATTRIBUTES
)
3258 res
= SetFileAttributes (wto
, attribs
);
3266 GNAT_STRUCT_STAT fbuf
;
3268 if (GNAT_STAT (from
, &fbuf
) == -1) {
3272 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 7)
3274 /* VxWorks prior to 7 only has utime. */
3276 /* Do we need to copy the timestamp ? */
3278 struct utimbuf tbuf
;
3280 tbuf
.actime
= fbuf
.st_atime
;
3281 tbuf
.modtime
= fbuf
.st_mtime
;
3283 if (utime (to
, &tbuf
) == -1)
3287 #elif _POSIX_C_SOURCE >= 200809L
3288 struct timespec tbuf
[2];
3291 tbuf
[0] = fbuf
.st_atim
;
3292 tbuf
[1] = fbuf
.st_mtim
;
3294 if (utimensat (AT_FDCWD
, to
, tbuf
, 0) == -1) {
3300 struct timeval tbuf
[2];
3301 /* Do we need to copy timestamp ? */
3304 tbuf
[0].tv_sec
= fbuf
.st_atime
;
3305 tbuf
[1].tv_sec
= fbuf
.st_mtime
;
3307 #if defined(st_mtime)
3308 tbuf
[0].tv_usec
= fbuf
.st_atim
.tv_nsec
/ 1000;
3309 tbuf
[1].tv_usec
= fbuf
.st_mtim
.tv_nsec
/ 1000;
3311 tbuf
[0].tv_usec
= 0;
3312 tbuf
[1].tv_usec
= 0;
3315 if (utimes (to
, tbuf
) == -1) {
3321 /* Do we need to copy file permissions ? */
3322 if (mode
!= 0 && (chmod (to
, fbuf
.st_mode
) == -1)) {
3331 __gnat_lseek (int fd
, long offset
, int whence
)
3333 return (int) lseek (fd
, offset
, whence
);
3336 /* This function returns the major version number of GCC being used. */
3338 get_gcc_version (void)
3343 return (int) (version_string
[0] - '0');
3348 * Set Close_On_Exec as indicated.
3349 * Note: this is used for both GNAT.OS_Lib and GNAT.Sockets.
3353 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED
,
3354 int close_on_exec_p ATTRIBUTE_UNUSED
)
3356 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
3357 int flags
= fcntl (fd
, F_GETFD
, 0);
3360 if (close_on_exec_p
)
3361 flags
|= FD_CLOEXEC
;
3363 flags
&= ~FD_CLOEXEC
;
3364 return fcntl (fd
, F_SETFD
, flags
);
3365 #elif defined(_WIN32)
3366 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
3367 if (h
== (HANDLE
) -1)
3369 if (close_on_exec_p
)
3370 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
, 0);
3371 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
,
3372 HANDLE_FLAG_INHERIT
);
3374 /* TODO: Unimplemented. */
3379 /* Indicates if platforms supports automatic initialization through the
3380 constructor mechanism */
3382 __gnat_binder_supports_auto_init (void)
3387 /* Indicates that Stand-Alone Libraries are automatically initialized through
3388 the constructor mechanism */
3390 __gnat_sals_init_using_constructors (void)
3392 #if defined (__vxworks) || defined (__Lynx__)
3399 #if defined (__linux__) || defined (__ANDROID__)
3400 /* There is no function in the glibc to retrieve the LWP of the current
3401 thread. We need to do a system call in order to retrieve this
3403 #include <sys/syscall.h>
3405 __gnat_lwp_self (void)
3407 return (void *) syscall (__NR_gettid
);
3411 #if defined (__APPLE__)
3412 # if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1060
3413 # include <mach/thread_info.h>
3414 # include <mach/mach_init.h>
3415 # include <mach/thread_act.h>
3417 # include <pthread.h>
3420 /* System-wide thread identifier. Note it could be truncated on 32 bit
3422 Previously was: pthread_mach_thread_np (pthread_self ()). */
3424 __gnat_lwp_self (void)
3426 #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1060
3427 thread_identifier_info_data_t data
;
3428 mach_msg_type_number_t count
= THREAD_IDENTIFIER_INFO_COUNT
;
3431 kret
= thread_info (mach_thread_self (), THREAD_IDENTIFIER_INFO
,
3432 (thread_info_t
) &data
, &count
);
3433 if (kret
== KERN_SUCCESS
)
3434 return (void *)(uintptr_t)data
.thread_id
;
3438 return (void *)pthread_mach_thread_np (pthread_self ());
3443 #if defined (__linux__)
3446 /* glibc versions earlier than 2.7 do not define the routines to handle
3447 dynamically allocated CPU sets. For these targets, we use the static
3452 /* Dynamic cpu sets */
3455 __gnat_cpu_alloc (size_t count
)
3457 return CPU_ALLOC (count
);
3461 __gnat_cpu_alloc_size (size_t count
)
3463 return CPU_ALLOC_SIZE (count
);
3467 __gnat_cpu_free (cpu_set_t
*set
)
3473 __gnat_cpu_zero (size_t count
, cpu_set_t
*set
)
3475 CPU_ZERO_S (count
, set
);
3479 __gnat_cpu_set (int cpu
, size_t count
, cpu_set_t
*set
)
3481 /* Ada handles CPU numbers starting from 1, while C identifies the first
3482 CPU by a 0, so we need to adjust. */
3483 CPU_SET_S (cpu
- 1, count
, set
);
3486 #else /* !CPU_ALLOC */
3488 /* Static cpu sets */
3491 __gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED
)
3493 return (cpu_set_t
*) xmalloc (sizeof (cpu_set_t
));
3497 __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED
)
3499 return sizeof (cpu_set_t
);
3503 __gnat_cpu_free (cpu_set_t
*set
)
3509 __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3515 __gnat_cpu_set (int cpu
, size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3517 /* Ada handles CPU numbers starting from 1, while C identifies the first
3518 CPU by a 0, so we need to adjust. */
3519 CPU_SET (cpu
- 1, set
);
3521 #endif /* !CPU_ALLOC */
3522 #endif /* __linux__ */
3524 /* Return the load address of the executable, or 0 if not known. In the
3525 specific case of error, (void *)-1 can be returned. Beware: this unit may
3526 be in a shared library. As low-level units are needed, we allow #include
3529 #if defined (__APPLE__)
3530 #include <mach-o/dyld.h>
3531 #elif defined (__linux__)
3532 #include <features.h>
3537 __gnat_get_executable_load_address (void)
3539 #if defined (__APPLE__)
3540 return _dyld_get_image_header (0);
3542 #elif defined (__linux__) && (defined (__GLIBC__) || defined (__UCLIBC__))
3543 struct link_map
*map
= _r_debug
.r_map
;
3544 return (const void *)map
->l_addr
;
3546 #elif defined (_WIN32)
3547 return GetModuleHandle (NULL
);
3555 __gnat_kill (int pid
, int sig
)
3561 case 9: // SIGKILL is not declared in Windows headers
3566 h
= OpenProcess (PROCESS_ALL_ACCESS
, FALSE
, pid
);
3568 TerminateProcess (h
, sig
);
3573 #elif defined (__vxworks)
3574 /* Not implemented */
3580 void __gnat_killprocesstree (int pid
, int sig_num
)
3585 memset(&pe
, 0, sizeof(PROCESSENTRY32
));
3586 pe
.dwSize
= sizeof(PROCESSENTRY32
);
3588 HANDLE hSnap
= CreateToolhelp32Snapshot (TH32CS_SNAPPROCESS
, 0);
3590 /* cannot take snapshot, just kill the parent process */
3592 if (hSnap
== INVALID_HANDLE_VALUE
)
3594 __gnat_kill (pid
, sig_num
);
3598 if (Process32First(hSnap
, &pe
))
3600 BOOL bContinue
= TRUE
;
3602 /* kill child processes first */
3606 if (pe
.th32ParentProcessID
== (DWORD
)pid
)
3607 __gnat_killprocesstree (pe
.th32ProcessID
, sig_num
);
3609 bContinue
= Process32Next (hSnap
, &pe
);
3613 CloseHandle (hSnap
);
3617 __gnat_kill (pid
, sig_num
);
3619 #elif defined (__vxworks)
3620 /* not implemented */
3622 #elif defined (__linux__)
3626 /* read all processes' pid and ppid */
3628 dir
= opendir ("/proc");
3630 /* cannot open proc, just kill the parent process */
3634 __gnat_kill (pid
, sig_num
);
3638 /* kill child processes first */
3640 while ((d
= readdir (dir
)) != NULL
)
3642 if ((d
->d_type
& DT_DIR
) == DT_DIR
)
3647 /* read /proc/<PID>/stat */
3649 if (strlen (d
->d_name
) >= sizeof (statfile
) - strlen ("/proc//stat"))
3651 strcpy (statfile
, "/proc/");
3652 strcat (statfile
, d
->d_name
);
3653 strcat (statfile
, "/stat");
3655 FILE *fd
= fopen (statfile
, "r");
3659 const int match
= fscanf (fd
, "%d %*s %*s %d", &_pid
, &_ppid
);
3662 if (match
== 2 && _ppid
== pid
)
3663 __gnat_killprocesstree (_pid
, sig_num
);
3672 __gnat_kill (pid
, sig_num
);
3674 __gnat_kill (pid
, sig_num
);
3676 /* Note on Solaris it is possible to read /proc/<PID>/status.
3677 The 5th and 6th words are the pid and the 7th and 8th the ppid.
3678 See: /usr/include/sys/procfs.h (struct pstatus).