1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
9 * Copyright (C) 1992-2019, 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. */
41 /* Use 64 bit Large File API */
43 #define _LARGEFILE64_SOURCE 1
44 #elif !defined(_LARGEFILE_SOURCE)
45 #define _LARGEFILE_SOURCE
47 #define _FILE_OFFSET_BITS 64
51 /* No need to redefine exit here. */
54 /* We want to use the POSIX variants of include files. */
58 #if defined (__mips_vxworks)
60 #endif /* __mips_vxworks */
62 /* If SMP, access vxCpuConfiguredGet */
63 #ifdef _WRS_CONFIG_SMP
65 #endif /* _WRS_CONFIG_SMP */
67 /* We need to know the VxWorks version because some file operations
68 (such as chmod) are only available on VxWorks 6. */
73 #if defined (__APPLE__)
77 #if defined (__hpux__)
78 #include <sys/param.h>
79 #include <sys/pstat.h>
83 #define __BSD_VISIBLE 1
87 #include <sys/syspage.h>
94 #include <sys/types.h>
100 /* for CPU_SET/CPU_ZERO */
111 #include <sys/stat.h>
115 #if defined (__vxworks) || defined (__ANDROID__)
116 /* S_IREAD and S_IWRITE are not defined in VxWorks or Android */
118 #define S_IREAD (S_IRUSR | S_IRGRP | S_IROTH)
122 #define S_IWRITE (S_IWUSR)
126 /* We don't have libiberty, so use malloc. */
127 #define xmalloc(S) malloc (S)
128 #define xrealloc(V,S) realloc (V,S)
139 #if defined (__DJGPP__)
141 /* For isalpha-like tests in the compiler, we're expected to resort to
142 safe-ctype.h/ISALPHA. This isn't available for the runtime library
143 build, so we fallback on ctype.h/isalpha there. */
147 #define ISALPHA isalpha
150 #elif defined (__MINGW32__) || defined (__CYGWIN__)
154 /* Current code page and CCS encoding to use, set in initialize.c. */
155 UINT __gnat_current_codepage
;
156 UINT __gnat_current_ccs_encoding
;
158 #include <sys/utime.h>
160 /* For isalpha-like tests in the compiler, we're expected to resort to
161 safe-ctype.h/ISALPHA. This isn't available for the runtime library
162 build, so we fallback on ctype.h/isalpha there. */
166 #define ISALPHA isalpha
169 #elif defined (__Lynx__)
171 /* Lynx utime.h only defines the entities of interest to us if
172 defined (VMOS_DEV), so ... */
181 /* wait.h processing */
184 # include <sys/wait.h>
186 #elif defined (__vxworks) && defined (__RTP__)
188 #elif defined (__Lynx__)
189 /* ??? We really need wait.h and it includes resource.h on Lynx. GCC
190 has a resource.h header as well, included instead of the lynx
191 version in our setup, causing lots of errors. We don't really need
192 the lynx contents of this file, so just workaround the issue by
193 preventing the inclusion of the GCC header from doing anything. */
194 # define GCC_RESOURCE_H
195 # include <sys/wait.h>
196 #elif defined (__PikeOS__)
197 /* No wait() or waitpid() calls available. */
200 #include <sys/wait.h>
203 #if defined (__DJGPP__)
209 #define DIR_SEPARATOR '\\'
211 #elif defined (_WIN32)
216 #include <tlhelp32.h>
219 #define DIR_SEPARATOR '\\'
227 /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
228 defined in the current system. On DOS-like systems these flags control
229 whether the file is opened/created in text-translation mode (CR/LF in
230 external file mapped to LF in internal file), but in Unix-like systems,
231 no text translation is required, so these flags have no effect. */
241 #ifndef HOST_EXECUTABLE_SUFFIX
242 #define HOST_EXECUTABLE_SUFFIX ""
245 #ifndef HOST_OBJECT_SUFFIX
246 #define HOST_OBJECT_SUFFIX ".o"
249 #ifndef PATH_SEPARATOR
250 #define PATH_SEPARATOR ':'
253 #ifndef DIR_SEPARATOR
254 #define DIR_SEPARATOR '/'
257 /* Check for cross-compilation. */
258 #if defined (CROSS_COMPILE) || defined (CROSS_DIRECTORY_STRUCTURE)
260 int __gnat_is_cross_compiler
= 1;
263 int __gnat_is_cross_compiler
= 0;
266 char __gnat_dir_separator
= DIR_SEPARATOR
;
268 char __gnat_path_separator
= PATH_SEPARATOR
;
270 /* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
271 the base filenames that libraries specified with -lsomelib options
272 may have. This is used by GNATMAKE to check whether an executable
273 is up-to-date or not. The syntax is
275 library_template ::= { pattern ; } pattern NUL
276 pattern ::= [ prefix ] * [ postfix ]
278 These should only specify names of static libraries as it makes
279 no sense to determine at link time if dynamic-link libraries are
280 up to date or not. Any libraries that are not found are supposed
283 * if they are needed but not present, the link
286 * otherwise they are libraries in the system paths and so
287 they are considered part of the system and not checked
290 ??? This should be part of a GNAT host-specific compiler
291 file instead of being included in all user applications
292 as well. This is only a temporary work-around for 3.11b. */
294 #ifndef GNAT_LIBRARY_TEMPLATE
295 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
298 const char *__gnat_library_template
= GNAT_LIBRARY_TEMPLATE
;
300 #if defined (__vxworks)
301 #define GNAT_MAX_PATH_LEN PATH_MAX
305 #if defined (__MINGW32__)
309 #include <sys/param.h>
313 #include <sys/param.h>
317 #define GNAT_MAX_PATH_LEN MAXPATHLEN
319 #define GNAT_MAX_PATH_LEN 256
324 /* Used for runtime check that Ada constant File_Attributes_Size is no
325 less than the actual size of struct file_attributes (see Osint
327 int __gnat_size_of_file_attributes
= sizeof (struct file_attributes
);
329 void __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
);
331 /* The __gnat_max_path_len variable is used to export the maximum
332 length of a path name to Ada code. max_path_len is also provided
333 for compatibility with older GNAT versions, please do not use
336 int __gnat_max_path_len
= GNAT_MAX_PATH_LEN
;
337 int max_path_len
= GNAT_MAX_PATH_LEN
;
339 /* Control whether we can use ACL on Windows. */
341 int __gnat_use_acl
= 1;
343 /* The following macro HAVE_READDIR_R should be defined if the
344 system provides the routine readdir_r.
345 ... but we never define it anywhere??? */
346 #undef HAVE_READDIR_R
348 #define MAYBE_TO_PTR32(argv) argv
350 static const char ATTR_UNSET
= 127;
352 /* Reset the file attributes as if no system call had been performed */
355 __gnat_reset_attributes (struct file_attributes
* attr
)
357 attr
->exists
= ATTR_UNSET
;
358 attr
->error
= EINVAL
;
360 attr
->writable
= ATTR_UNSET
;
361 attr
->readable
= ATTR_UNSET
;
362 attr
->executable
= ATTR_UNSET
;
364 attr
->regular
= ATTR_UNSET
;
365 attr
->symbolic_link
= ATTR_UNSET
;
366 attr
->directory
= ATTR_UNSET
;
368 attr
->timestamp
= (OS_Time
)-2;
369 attr
->file_length
= -1;
373 __gnat_error_attributes (struct file_attributes
*attr
) {
378 __gnat_current_time (void)
380 time_t res
= time (NULL
);
381 return (OS_Time
) res
;
384 /* Return the current local time as a string in the ISO 8601 format of
385 "YYYY-MM-DD HH:MM:SS.SS". The returned string is 22 + 1 (NULL) characters
389 __gnat_current_time_string (char *result
)
391 const char *format
= "%Y-%m-%d %H:%M:%S";
392 /* Format string necessary to describe the ISO 8601 format */
394 const time_t t_val
= time (NULL
);
396 strftime (result
, 22, format
, localtime (&t_val
));
397 /* Convert the local time into a string following the ISO format, copying
398 at most 22 characters into the result string. */
403 /* The sub-seconds are manually set to zero since type time_t lacks the
404 precision necessary for nanoseconds. */
408 __gnat_to_gm_time (OS_Time
*p_time
, int *p_year
, int *p_month
, int *p_day
,
409 int *p_hours
, int *p_mins
, int *p_secs
)
412 time_t time
= (time_t) *p_time
;
414 res
= gmtime (&time
);
417 *p_year
= res
->tm_year
;
418 *p_month
= res
->tm_mon
;
419 *p_day
= res
->tm_mday
;
420 *p_hours
= res
->tm_hour
;
421 *p_mins
= res
->tm_min
;
422 *p_secs
= res
->tm_sec
;
425 *p_year
= *p_month
= *p_day
= *p_hours
= *p_mins
= *p_secs
= 0;
429 __gnat_to_os_time (OS_Time
*p_time
, int year
, int month
, int day
,
430 int hours
, int mins
, int secs
)
442 /* returns -1 of failing, this is s-os_lib Invalid_Time */
444 *p_time
= (OS_Time
) mktime (&v
);
447 /* Place the contents of the symbolic link named PATH in the buffer BUF,
448 which has size BUFSIZ. If PATH is a symbolic link, then return the number
449 of characters of its content in BUF. Otherwise, return -1.
450 For systems not supporting symbolic links, always return -1. */
453 __gnat_readlink (char *path ATTRIBUTE_UNUSED
,
454 char *buf ATTRIBUTE_UNUSED
,
455 size_t bufsiz ATTRIBUTE_UNUSED
)
457 #if defined (_WIN32) \
458 || defined(__vxworks) || defined (__PikeOS__)
461 return readlink (path
, buf
, bufsiz
);
465 /* Creates a symbolic link named NEWPATH which contains the string OLDPATH.
466 If NEWPATH exists it will NOT be overwritten.
467 For systems not supporting symbolic links, always return -1. */
470 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED
,
471 char *newpath ATTRIBUTE_UNUSED
)
473 #if defined (_WIN32) \
474 || defined(__vxworks) || defined (__PikeOS__)
477 return symlink (oldpath
, newpath
);
481 /* Try to lock a file, return 1 if success. */
483 #if defined (__vxworks) \
484 || defined (_WIN32) || defined (__PikeOS__)
486 /* Version that does not use link. */
489 __gnat_try_lock (char *dir
, char *file
)
493 TCHAR wfull_path
[GNAT_MAX_PATH_LEN
];
494 TCHAR wfile
[GNAT_MAX_PATH_LEN
];
495 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
497 S2WSC (wdir
, dir
, GNAT_MAX_PATH_LEN
);
498 S2WSC (wfile
, file
, GNAT_MAX_PATH_LEN
);
500 /* ??? the code below crash on MingW64 for obscure reasons, a ticket
501 has been opened here:
503 https://sourceforge.net/p/mingw-w64/bugs/414/
505 As a workaround an equivalent set of code has been put in place below.
507 _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
510 _tcscpy (wfull_path
, wdir
);
511 _tcscat (wfull_path
, L
"\\");
512 _tcscat (wfull_path
, wfile
);
514 fd
= _topen (wfull_path
, O_CREAT
| O_EXCL
, 0600);
518 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
519 fd
= open (full_path
, O_CREAT
| O_EXCL
, 0600);
531 /* Version using link(), more secure over NFS. */
532 /* See TN 6913-016 for discussion ??? */
535 __gnat_try_lock (char *dir
, char *file
)
539 GNAT_STRUCT_STAT stat_result
;
542 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
543 sprintf (temp_file
, "%s%cTMP-%ld-%ld",
544 dir
, DIR_SEPARATOR
, (long)getpid(), (long)getppid ());
546 /* Create the temporary file and write the process number. */
547 fd
= open (temp_file
, O_CREAT
| O_WRONLY
, 0600);
553 /* Link it with the new file. */
554 link (temp_file
, full_path
);
556 /* Count the references on the old one. If we have a count of two, then
557 the link did succeed. Remove the temporary file before returning. */
558 __gnat_stat (temp_file
, &stat_result
);
560 return stat_result
.st_nlink
== 2;
564 /* Return the maximum file name length. */
567 __gnat_get_maximum_file_name_length (void)
572 /* Return nonzero if file names are case sensitive. */
574 static int file_names_case_sensitive_cache
= -1;
577 __gnat_get_file_names_case_sensitive (void)
579 if (file_names_case_sensitive_cache
== -1)
581 const char *sensitive
= getenv ("GNAT_FILE_NAME_CASE_SENSITIVE");
583 if (sensitive
!= NULL
584 && (sensitive
[0] == '0' || sensitive
[0] == '1')
585 && sensitive
[1] == '\0')
586 file_names_case_sensitive_cache
= sensitive
[0] - '0';
589 /* By default, we suppose filesystems aren't case sensitive on
590 Windows and Darwin (but they are on arm-darwin). */
591 #if defined (WINNT) || defined (__DJGPP__) \
592 || (defined (__APPLE__) && !(defined (__arm__) || defined (__arm64__)))
593 file_names_case_sensitive_cache
= 0;
595 file_names_case_sensitive_cache
= 1;
599 return file_names_case_sensitive_cache
;
602 /* Return nonzero if environment variables are case sensitive. */
605 __gnat_get_env_vars_case_sensitive (void)
607 #if defined (WINNT) || defined (__DJGPP__)
615 __gnat_get_default_identifier_character_set (void)
620 /* Return the current working directory. */
623 __gnat_get_current_dir (char *dir
, int *length
)
625 #if defined (__MINGW32__)
626 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
628 _tgetcwd (wdir
, *length
);
630 WS2SC (dir
, wdir
, GNAT_MAX_PATH_LEN
);
633 char* result
= getcwd (dir
, *length
);
634 /* If the current directory does not exist, set length = 0
635 to indicate error. That can't happen on windows, where
636 you can't delete a directory if it is the current
637 directory of some process. */
645 *length
= strlen (dir
);
647 if (dir
[*length
- 1] != DIR_SEPARATOR
)
649 dir
[*length
] = DIR_SEPARATOR
;
655 /* Return the suffix for object files. */
658 __gnat_get_object_suffix_ptr (int *len
, const char **value
)
660 *value
= HOST_OBJECT_SUFFIX
;
665 *len
= strlen (*value
);
670 /* Return the suffix for executable files. */
673 __gnat_get_executable_suffix_ptr (int *len
, const char **value
)
675 *value
= HOST_EXECUTABLE_SUFFIX
;
680 *len
= strlen (*value
);
685 /* Return the suffix for debuggable files. Usually this is the same as the
686 executable extension. */
689 __gnat_get_debuggable_suffix_ptr (int *len
, const char **value
)
691 *value
= HOST_EXECUTABLE_SUFFIX
;
696 *len
= strlen (*value
);
701 /* Returns the OS filename and corresponding encoding. */
704 __gnat_os_filename (char *filename ATTRIBUTE_UNUSED
,
705 char *w_filename ATTRIBUTE_UNUSED
,
706 char *os_name
, int *o_length
,
707 char *encoding ATTRIBUTE_UNUSED
, int *e_length
)
709 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
710 WS2SC (os_name
, (TCHAR
*)w_filename
, (DWORD
)*o_length
);
711 *o_length
= strlen (os_name
);
712 strcpy (encoding
, "encoding=utf8");
713 *e_length
= strlen (encoding
);
715 strcpy (os_name
, filename
);
716 *o_length
= strlen (filename
);
724 __gnat_unlink (char *path
)
726 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
728 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
730 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
731 return _tunlink (wpath
);
734 return unlink (path
);
741 __gnat_rename (char *from
, char *to
)
743 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
745 TCHAR wfrom
[GNAT_MAX_PATH_LEN
], wto
[GNAT_MAX_PATH_LEN
];
747 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
);
748 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
);
749 return _trename (wfrom
, wto
);
752 return rename (from
, to
);
756 /* Changing directory. */
759 __gnat_chdir (char *path
)
761 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
763 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
765 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
766 return _tchdir (wpath
);
773 /* Removing a directory. */
776 __gnat_rmdir (char *path
)
778 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
780 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
782 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
783 return _trmdir (wpath
);
785 #elif defined (VTHREADS)
786 /* rmdir not available */
793 #if defined (_WIN32) || defined (__linux__) || defined (__sun__) \
794 || defined (__FreeBSD__) || defined(__DragonFly__) || defined (__QNX__)
795 #define HAS_TARGET_WCHAR_T
798 #ifdef HAS_TARGET_WCHAR_T
803 __gnat_fputwc(int c
, FILE *stream
)
805 #ifdef HAS_TARGET_WCHAR_T
806 return fputwc ((wchar_t)c
, stream
);
808 return fputc (c
, stream
);
813 __gnat_fopen (char *path
, char *mode
, int encoding ATTRIBUTE_UNUSED
)
815 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
816 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
819 S2WS (wmode
, mode
, 10);
821 if (encoding
== Encoding_Unspecified
)
822 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
823 else if (encoding
== Encoding_UTF8
)
824 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
826 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
828 return _tfopen (wpath
, wmode
);
831 return GNAT_FOPEN (path
, mode
);
836 __gnat_freopen (char *path
,
839 int encoding ATTRIBUTE_UNUSED
)
841 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
842 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
845 S2WS (wmode
, mode
, 10);
847 if (encoding
== Encoding_Unspecified
)
848 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
849 else if (encoding
== Encoding_UTF8
)
850 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
852 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
854 return _tfreopen (wpath
, wmode
, stream
);
856 return freopen (path
, mode
, stream
);
861 __gnat_open_read (char *path
, int fmode
)
864 int o_fmode
= O_BINARY
;
869 #if defined (__vxworks)
870 fd
= open (path
, O_RDONLY
| o_fmode
, 0444);
871 #elif defined (__MINGW32__)
873 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
875 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
876 fd
= _topen (wpath
, O_RDONLY
| o_fmode
, 0444);
879 fd
= GNAT_OPEN (path
, O_RDONLY
| o_fmode
);
882 return fd
< 0 ? -1 : fd
;
885 #if defined (__MINGW32__)
886 #define PERM (S_IREAD | S_IWRITE)
888 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
892 __gnat_open_rw (char *path
, int fmode
)
895 int o_fmode
= O_BINARY
;
900 #if defined (__MINGW32__)
902 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
904 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
905 fd
= _topen (wpath
, O_RDWR
| o_fmode
, PERM
);
908 fd
= GNAT_OPEN (path
, O_RDWR
| o_fmode
, PERM
);
911 return fd
< 0 ? -1 : fd
;
915 __gnat_open_create (char *path
, int fmode
)
918 int o_fmode
= O_BINARY
;
923 #if defined (__MINGW32__)
925 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
927 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
928 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
931 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
934 return fd
< 0 ? -1 : fd
;
938 __gnat_create_output_file (char *path
)
941 #if defined (__MINGW32__)
943 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
945 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
946 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
949 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
952 return fd
< 0 ? -1 : fd
;
956 __gnat_create_output_file_new (char *path
)
959 #if defined (__MINGW32__)
961 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
963 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
964 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
967 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
970 return fd
< 0 ? -1 : fd
;
974 __gnat_open_append (char *path
, int fmode
)
977 int o_fmode
= O_BINARY
;
982 #if defined (__MINGW32__)
984 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
986 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
987 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
990 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
993 return fd
< 0 ? -1 : fd
;
996 /* Open a new file. Return error (-1) if the file already exists. */
999 __gnat_open_new (char *path
, int fmode
)
1002 int o_fmode
= O_BINARY
;
1007 #if defined (__MINGW32__)
1009 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1011 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1012 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1015 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1018 return fd
< 0 ? -1 : fd
;
1021 /* Open a new temp file. Return error (-1) if the file already exists. */
1024 __gnat_open_new_temp (char *path
, int fmode
)
1027 int o_fmode
= O_BINARY
;
1029 strcpy (path
, "GNAT-XXXXXX");
1031 #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
1032 || defined (__linux__) || defined (__GLIBC__) || defined (__ANDROID__) \
1033 || defined (__DragonFly__) || defined (__QNX__)) && !defined (__vxworks)
1034 return mkstemp (path
);
1035 #elif defined (__Lynx__)
1038 if (mktemp (path
) == NULL
)
1045 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1046 return fd
< 0 ? -1 : fd
;
1050 __gnat_open (char *path
, int fmode
)
1054 #if defined (__MINGW32__)
1056 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1058 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1059 fd
= _topen (wpath
, fmode
, PERM
);
1062 fd
= GNAT_OPEN (path
, fmode
, PERM
);
1065 return fd
< 0 ? -1 : fd
;
1068 /****************************************************************
1069 ** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information
1070 ** as possible from it, storing the result in a cache for later reuse
1071 ****************************************************************/
1074 __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
)
1076 GNAT_STRUCT_STAT statbuf
;
1080 /* GNAT_FSTAT returns -1 and sets errno for failure */
1081 ret
= GNAT_FSTAT (fd
, &statbuf
);
1082 error
= ret
? errno
: 0;
1085 /* __gnat_stat returns errno value directly */
1086 error
= __gnat_stat (name
, &statbuf
);
1087 ret
= error
? -1 : 0;
1091 * A missing file is reported as an attr structure with error == 0 and
1095 if (error
== 0 || error
== ENOENT
)
1098 attr
->error
= error
;
1100 attr
->regular
= (!ret
&& S_ISREG (statbuf
.st_mode
));
1101 attr
->directory
= (!ret
&& S_ISDIR (statbuf
.st_mode
));
1104 attr
->file_length
= 0;
1106 /* st_size may be 32 bits, or 64 bits which is converted to long. We
1107 don't return a useful value for files larger than 2 gigabytes in
1109 attr
->file_length
= statbuf
.st_size
; /* all systems */
1111 attr
->exists
= !ret
;
1113 #if !defined (_WIN32)
1114 /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
1115 attr
->readable
= (!ret
&& (statbuf
.st_mode
& S_IRUSR
));
1116 attr
->writable
= (!ret
&& (statbuf
.st_mode
& S_IWUSR
));
1117 attr
->executable
= (!ret
&& (statbuf
.st_mode
& S_IXUSR
));
1121 attr
->timestamp
= (OS_Time
)-1;
1123 attr
->timestamp
= (OS_Time
)statbuf
.st_mtime
;
1127 /****************************************************************
1128 ** Return the number of bytes in the specified file
1129 ****************************************************************/
1132 __gnat_file_length_attr (int fd
, char* name
, struct file_attributes
* attr
)
1134 if (attr
->file_length
== -1) {
1135 __gnat_stat_to_attr (fd
, name
, attr
);
1138 return attr
->file_length
;
1142 __gnat_file_length (int fd
)
1144 struct file_attributes attr
;
1145 __gnat_reset_attributes (&attr
);
1146 return __gnat_file_length_attr (fd
, NULL
, &attr
);
1150 __gnat_file_length_long (int fd
)
1152 struct file_attributes attr
;
1153 __gnat_reset_attributes (&attr
);
1154 return (long)__gnat_file_length_attr (fd
, NULL
, &attr
);
1158 __gnat_named_file_length (char *name
)
1160 struct file_attributes attr
;
1161 __gnat_reset_attributes (&attr
);
1162 return __gnat_file_length_attr (-1, name
, &attr
);
1165 /* Create a temporary filename and put it in string pointed to by
1169 __gnat_tmp_name (char *tmp_filename
)
1171 #if defined (__MINGW32__)
1176 /* tempnam tries to create a temporary file in directory pointed to by
1177 TMP environment variable, in c:\temp if TMP is not set, and in
1178 directory specified by P_tmpdir in stdio.h if c:\temp does not
1179 exist. The filename will be created with the prefix "gnat-". */
1181 sprintf (prefix
, "gnat-%d-", (int)getpid());
1182 pname
= (char *) _tempnam ("c:\\temp", prefix
);
1184 /* if pname is NULL, the file was not created properly, the disk is full
1185 or there is no more free temporary files */
1188 *tmp_filename
= '\0';
1190 /* If pname start with a back slash and not path information it means that
1191 the filename is valid for the current working directory. */
1193 else if (pname
[0] == '\\')
1195 strcpy (tmp_filename
, ".\\");
1196 strcat (tmp_filename
, pname
+1);
1199 strcpy (tmp_filename
, pname
);
1204 #elif defined (__linux__) || defined (__FreeBSD__) || defined (__NetBSD__) \
1205 || defined (__OpenBSD__) || defined (__GLIBC__) || defined (__ANDROID__) \
1206 || defined (__DragonFly__) || defined (__QNX__)
1207 #define MAX_SAFE_PATH 1000
1208 char *tmpdir
= getenv ("TMPDIR");
1210 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1211 a buffer overflow. */
1212 if (tmpdir
== NULL
|| strlen (tmpdir
) > MAX_SAFE_PATH
)
1214 strcpy (tmp_filename
, "/cache/gnat-XXXXXX");
1216 strcpy (tmp_filename
, "/tmp/gnat-XXXXXX");
1219 sprintf (tmp_filename
, "%s/gnat-XXXXXX", tmpdir
);
1221 close (mkstemp(tmp_filename
));
1222 #elif defined (__vxworks) && !defined (VTHREADS)
1226 static ushort_t seed
= 0; /* used to generate unique name */
1228 /* Generate a unique name. */
1229 strcpy (tmp_filename
, "tmp");
1232 savepos
= pos
= tmp_filename
+ strlen (tmp_filename
) + index
;
1240 /* Fill up the name buffer from the last position. */
1242 for (t
= seed
; --index
>= 0; t
>>= 3)
1243 *--pos
= '0' + (t
& 07);
1245 /* Check to see if its unique, if not bump the seed and try again. */
1246 f
= fopen (tmp_filename
, "r");
1254 tmpnam (tmp_filename
);
1258 /* Open directory and returns a DIR pointer. */
1260 DIR* __gnat_opendir (char *name
)
1262 #if defined (__MINGW32__)
1263 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1265 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1266 return (DIR*)_topendir (wname
);
1269 return opendir (name
);
1273 /* Read the next entry in a directory. The returned string points somewhere
1276 #if defined (__sun__)
1277 /* For Solaris, be sure to use the 64-bit version, otherwise NFS reads may
1278 fail with EOVERFLOW if the server uses 64-bit cookies. */
1279 #define dirent dirent64
1280 #define readdir readdir64
1284 __gnat_readdir (DIR *dirp
, char *buffer
, int *len
)
1286 #if defined (__MINGW32__)
1287 struct _tdirent
*dirent
= _treaddir ((_TDIR
*)dirp
);
1291 WS2SC (buffer
, dirent
->d_name
, GNAT_MAX_PATH_LEN
);
1292 *len
= strlen (buffer
);
1299 #elif defined (HAVE_READDIR_R)
1300 /* If possible, try to use the thread-safe version. */
1301 if (readdir_r (dirp
, buffer
) != NULL
)
1303 *len
= strlen (((struct dirent
*) buffer
)->d_name
);
1304 return ((struct dirent
*) buffer
)->d_name
;
1310 struct dirent
*dirent
= (struct dirent
*) readdir (dirp
);
1314 strcpy (buffer
, dirent
->d_name
);
1315 *len
= strlen (buffer
);
1324 /* Close a directory entry. */
1326 int __gnat_closedir (DIR *dirp
)
1328 #if defined (__MINGW32__)
1329 return _tclosedir ((_TDIR
*)dirp
);
1332 return closedir (dirp
);
1336 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1339 __gnat_readdir_is_thread_safe (void)
1341 #ifdef HAVE_READDIR_R
1348 #if defined (_WIN32)
1349 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1350 static const unsigned long long w32_epoch_offset
= 11644473600ULL;
1352 /* Returns the file modification timestamp using Win32 routines which are
1353 immune against daylight saving time change. It is in fact not possible to
1354 use fstat for this purpose as the DST modify the st_mtime field of the
1358 win32_filetime (HANDLE h
)
1363 unsigned long long ull_time
;
1366 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1367 since <Jan 1st 1601>. This function must return the number of seconds
1368 since <Jan 1st 1970>. */
1370 if (GetFileTime (h
, NULL
, NULL
, &t_write
.ft_time
))
1371 return (time_t) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1375 /* As above but starting from a FILETIME. */
1377 f2t (const FILETIME
*ft
, __time64_t
*t
)
1382 unsigned long long ull_time
;
1385 t_write
.ft_time
= *ft
;
1386 *t
= (__time64_t
) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1390 /* Return a GNAT time stamp given a file name. */
1393 __gnat_file_time_name_attr (char* name
, struct file_attributes
* attr
)
1395 if (attr
->timestamp
== (OS_Time
)-2) {
1396 #if defined (_WIN32)
1398 WIN32_FILE_ATTRIBUTE_DATA fad
;
1399 __time64_t ret
= -1;
1400 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1401 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1403 if ((res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
)))
1404 f2t (&fad
.ftLastWriteTime
, &ret
);
1405 attr
->timestamp
= (OS_Time
) ret
;
1407 __gnat_stat_to_attr (-1, name
, attr
);
1410 return attr
->timestamp
;
1414 __gnat_file_time_name (char *name
)
1416 struct file_attributes attr
;
1417 __gnat_reset_attributes (&attr
);
1418 return __gnat_file_time_name_attr (name
, &attr
);
1421 /* Return a GNAT time stamp given a file descriptor. */
1424 __gnat_file_time_fd_attr (int fd
, struct file_attributes
* attr
)
1426 if (attr
->timestamp
== (OS_Time
)-2) {
1427 #if defined (_WIN32)
1428 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
1429 time_t ret
= win32_filetime (h
);
1430 attr
->timestamp
= (OS_Time
) ret
;
1433 __gnat_stat_to_attr (fd
, NULL
, attr
);
1437 return attr
->timestamp
;
1441 __gnat_file_time_fd (int fd
)
1443 struct file_attributes attr
;
1444 __gnat_reset_attributes (&attr
);
1445 return __gnat_file_time_fd_attr (fd
, &attr
);
1448 /* Set the file time stamp. */
1451 __gnat_set_file_time_name (char *name
, time_t time_stamp
)
1453 #if defined (__vxworks)
1455 /* Code to implement __gnat_set_file_time_name for these systems. */
1457 #elif defined (_WIN32)
1461 unsigned long long ull_time
;
1463 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1465 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1467 HANDLE h
= CreateFile
1468 (wname
, GENERIC_WRITE
, FILE_SHARE_WRITE
, NULL
,
1469 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
,
1471 if (h
== INVALID_HANDLE_VALUE
)
1473 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1474 t_write
.ull_time
= ((unsigned long long)time_stamp
+ w32_epoch_offset
);
1475 /* Convert to 100 nanosecond units */
1476 t_write
.ull_time
*= 10000000ULL;
1478 SetFileTime(h
, NULL
, NULL
, &t_write
.ft_time
);
1483 struct utimbuf utimbuf
;
1486 /* Set modification time to requested time. */
1487 utimbuf
.modtime
= time_stamp
;
1489 /* Set access time to now in local time. */
1491 utimbuf
.actime
= mktime (localtime (&t
));
1493 utime (name
, &utimbuf
);
1497 /* Get the list of installed standard libraries from the
1498 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1502 __gnat_get_libraries_from_registry (void)
1504 char *result
= (char *) xmalloc (1);
1508 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
1511 DWORD name_size
, value_size
;
1518 /* First open the key. */
1519 res
= RegOpenKeyExA (HKEY_LOCAL_MACHINE
, "SOFTWARE", 0, KEY_READ
, ®_key
);
1521 if (res
== ERROR_SUCCESS
)
1522 res
= RegOpenKeyExA (reg_key
, "Ada Core Technologies", 0,
1523 KEY_READ
, ®_key
);
1525 if (res
== ERROR_SUCCESS
)
1526 res
= RegOpenKeyExA (reg_key
, "GNAT", 0, KEY_READ
, ®_key
);
1528 if (res
== ERROR_SUCCESS
)
1529 res
= RegOpenKeyExA (reg_key
, "Standard Libraries", 0, KEY_READ
, ®_key
);
1531 /* If the key exists, read out all the values in it and concatenate them
1533 for (index
= 0; res
== ERROR_SUCCESS
; index
++)
1535 value_size
= name_size
= 256;
1536 res
= RegEnumValueA (reg_key
, index
, name
, &name_size
, 0,
1537 &type
, (LPBYTE
)value
, &value_size
);
1539 if (res
== ERROR_SUCCESS
&& type
== REG_SZ
)
1541 char *old_result
= result
;
1543 result
= (char *) xmalloc (strlen (old_result
) + value_size
+ 2);
1544 strcpy (result
, old_result
);
1545 strcat (result
, value
);
1546 strcat (result
, ";");
1551 /* Remove the trailing ";". */
1553 result
[strlen (result
) - 1] = 0;
1559 /* Query information for the given file NAME and return it in STATBUF.
1560 * Returns 0 for success, or errno value for failure.
1563 __gnat_stat (char *name
, GNAT_STRUCT_STAT
*statbuf
)
1566 WIN32_FILE_ATTRIBUTE_DATA fad
;
1567 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1572 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1573 name_len
= _tcslen (wname
);
1575 if (name_len
> GNAT_MAX_PATH_LEN
)
1578 ZeroMemory (statbuf
, sizeof(GNAT_STRUCT_STAT
));
1580 res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
);
1583 error
= GetLastError();
1585 /* Check file existence using GetFileAttributes() which does not fail on
1586 special Windows files like con:, aux:, nul: etc... */
1588 if (GetFileAttributes(wname
) != INVALID_FILE_ATTRIBUTES
) {
1589 /* Just pretend that it is a regular and readable file */
1590 statbuf
->st_mode
= S_IFREG
| S_IREAD
| S_IWRITE
;
1595 case ERROR_ACCESS_DENIED
:
1596 case ERROR_SHARING_VIOLATION
:
1597 case ERROR_LOCK_VIOLATION
:
1598 case ERROR_SHARING_BUFFER_EXCEEDED
:
1600 case ERROR_BUFFER_OVERFLOW
:
1601 return ENAMETOOLONG
;
1602 case ERROR_NOT_ENOUGH_MEMORY
:
1609 f2t (&fad
.ftCreationTime
, &statbuf
->st_ctime
);
1610 f2t (&fad
.ftLastWriteTime
, &statbuf
->st_mtime
);
1611 f2t (&fad
.ftLastAccessTime
, &statbuf
->st_atime
);
1614 (__int64
)fad
.nFileSizeLow
| (__int64
)fad
.nFileSizeHigh
<< 32;
1616 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1617 statbuf
->st_mode
= S_IREAD
;
1619 if (fad
.dwFileAttributes
& FILE_ATTRIBUTE_DIRECTORY
)
1620 statbuf
->st_mode
|= S_IFDIR
;
1622 statbuf
->st_mode
|= S_IFREG
;
1624 if (!(fad
.dwFileAttributes
& FILE_ATTRIBUTE_READONLY
))
1625 statbuf
->st_mode
|= S_IWRITE
;
1630 return GNAT_STAT (name
, statbuf
) == 0 ? 0 : errno
;
1634 /*************************************************************************
1635 ** Check whether a file exists
1636 *************************************************************************/
1639 __gnat_file_exists_attr (char* name
, struct file_attributes
* attr
)
1641 if (attr
->exists
== ATTR_UNSET
)
1642 __gnat_stat_to_attr (-1, name
, attr
);
1644 return attr
->exists
;
1648 __gnat_file_exists (char *name
)
1650 struct file_attributes attr
;
1651 __gnat_reset_attributes (&attr
);
1652 return __gnat_file_exists_attr (name
, &attr
);
1655 /**********************************************************************
1656 ** Whether name is an absolute path
1657 **********************************************************************/
1660 __gnat_is_absolute_path (char *name
, int length
)
1663 /* On VxWorks systems, an absolute path can be represented (depending on
1664 the host platform) as either /dir/file, or device:/dir/file, or
1665 device:drive_letter:/dir/file. */
1672 for (index
= 0; index
< length
; index
++)
1674 if (name
[index
] == ':' &&
1675 ((name
[index
+ 1] == '/') ||
1676 (isalpha (name
[index
+ 1]) && index
+ 2 <= length
&&
1677 name
[index
+ 2] == '/')))
1680 else if (name
[index
] == '/')
1685 return (length
!= 0) &&
1686 (*name
== '/' || *name
== DIR_SEPARATOR
1687 #if defined (WINNT) || defined(__DJGPP__)
1688 || (length
> 1 && ISALPHA (name
[0]) && name
[1] == ':')
1695 __gnat_is_regular_file_attr (char* name
, struct file_attributes
* attr
)
1697 if (attr
->regular
== ATTR_UNSET
)
1698 __gnat_stat_to_attr (-1, name
, attr
);
1700 return attr
->regular
;
1704 __gnat_is_regular_file (char *name
)
1706 struct file_attributes attr
;
1708 __gnat_reset_attributes (&attr
);
1709 return __gnat_is_regular_file_attr (name
, &attr
);
1713 __gnat_is_regular_file_fd (int fd
)
1716 GNAT_STRUCT_STAT statbuf
;
1718 ret
= GNAT_FSTAT (fd
, &statbuf
);
1719 return (!ret
&& S_ISREG (statbuf
.st_mode
));
1723 __gnat_is_directory_attr (char* name
, struct file_attributes
* attr
)
1725 if (attr
->directory
== ATTR_UNSET
)
1726 __gnat_stat_to_attr (-1, name
, attr
);
1728 return attr
->directory
;
1732 __gnat_is_directory (char *name
)
1734 struct file_attributes attr
;
1736 __gnat_reset_attributes (&attr
);
1737 return __gnat_is_directory_attr (name
, &attr
);
1740 #if defined (_WIN32)
1742 /* Returns the same constant as GetDriveType but takes a pathname as
1746 GetDriveTypeFromPath (TCHAR
*wfullpath
)
1748 TCHAR wdrv
[MAX_PATH
];
1749 TCHAR wpath
[MAX_PATH
];
1750 TCHAR wfilename
[MAX_PATH
];
1751 TCHAR wext
[MAX_PATH
];
1753 _tsplitpath (wfullpath
, wdrv
, wpath
, wfilename
, wext
);
1755 if (_tcslen (wdrv
) != 0)
1757 /* we have a drive specified. */
1758 _tcscat (wdrv
, _T("\\"));
1759 return GetDriveType (wdrv
);
1763 /* No drive specified. */
1765 /* Is this a relative path, if so get current drive type. */
1766 if (wpath
[0] != _T('\\') ||
1767 (_tcslen (wpath
) > 2 && wpath
[0] == _T('\\')
1768 && wpath
[1] != _T('\\')))
1769 return GetDriveType (NULL
);
1771 UINT result
= GetDriveType (wpath
);
1773 /* Cannot guess the drive type, is this \\.\ ? */
1775 if (result
== DRIVE_NO_ROOT_DIR
&&
1776 _tcslen (wpath
) >= 4 && wpath
[0] == _T('\\') && wpath
[1] == _T('\\')
1777 && wpath
[2] == _T('.') && wpath
[3] == _T('\\'))
1779 if (_tcslen (wpath
) == 4)
1780 _tcscat (wpath
, wfilename
);
1782 LPTSTR p
= &wpath
[4];
1783 LPTSTR b
= _tcschr (p
, _T('\\'));
1787 /* logical drive \\.\c\dir\file */
1793 _tcscat (p
, _T(":\\"));
1795 return GetDriveType (p
);
1802 /* This MingW section contains code to work with ACL. */
1804 __gnat_check_OWNER_ACL (TCHAR
*wname
,
1805 DWORD CheckAccessDesired
,
1806 GENERIC_MAPPING CheckGenericMapping
)
1808 DWORD dwAccessDesired
, dwAccessAllowed
;
1809 PRIVILEGE_SET PrivilegeSet
;
1810 DWORD dwPrivSetSize
= sizeof (PRIVILEGE_SET
);
1811 BOOL fAccessGranted
= FALSE
;
1812 HANDLE hToken
= NULL
;
1814 PSECURITY_DESCRIPTOR pSD
= NULL
;
1817 (wname
, OWNER_SECURITY_INFORMATION
|
1818 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1821 if ((pSD
= (SECURITY_DESCRIPTOR
*) HeapAlloc
1822 (GetProcessHeap (), HEAP_ZERO_MEMORY
, nLength
)) == NULL
)
1825 /* Obtain the security descriptor. */
1827 if (!GetFileSecurity
1828 (wname
, OWNER_SECURITY_INFORMATION
|
1829 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1830 pSD
, nLength
, &nLength
))
1833 if (!ImpersonateSelf (SecurityImpersonation
))
1836 if (!OpenThreadToken
1837 (GetCurrentThread(), TOKEN_DUPLICATE
| TOKEN_QUERY
, FALSE
, &hToken
))
1840 /* Undoes the effect of ImpersonateSelf. */
1844 /* We want to test for write permissions. */
1846 dwAccessDesired
= CheckAccessDesired
;
1848 MapGenericMask (&dwAccessDesired
, &CheckGenericMapping
);
1851 (pSD
, /* security descriptor to check */
1852 hToken
, /* impersonation token */
1853 dwAccessDesired
, /* requested access rights */
1854 &CheckGenericMapping
, /* pointer to GENERIC_MAPPING */
1855 &PrivilegeSet
, /* receives privileges used in check */
1856 &dwPrivSetSize
, /* size of PrivilegeSet buffer */
1857 &dwAccessAllowed
, /* receives mask of allowed access rights */
1861 CloseHandle (hToken
);
1862 HeapFree (GetProcessHeap (), 0, pSD
);
1863 return fAccessGranted
;
1867 CloseHandle (hToken
);
1868 HeapFree (GetProcessHeap (), 0, pSD
);
1873 __gnat_set_OWNER_ACL (TCHAR
*wname
,
1874 ACCESS_MODE AccessMode
,
1875 DWORD AccessPermissions
)
1877 PACL pOldDACL
= NULL
;
1878 PACL pNewDACL
= NULL
;
1879 PSECURITY_DESCRIPTOR pSD
= NULL
;
1881 TCHAR username
[100];
1884 /* Get current user, he will act as the owner */
1886 if (!GetUserName (username
, &unsize
))
1889 if (GetNamedSecurityInfo
1892 DACL_SECURITY_INFORMATION
,
1893 NULL
, NULL
, &pOldDACL
, NULL
, &pSD
) != ERROR_SUCCESS
)
1896 BuildExplicitAccessWithName
1897 (&ea
, username
, AccessPermissions
, (ACCESS_MODE
) AccessMode
, NO_INHERITANCE
);
1899 if (AccessMode
== SET_ACCESS
)
1901 /* SET_ACCESS, we want to set an explicte set of permissions, do not
1902 merge with current DACL. */
1903 if (SetEntriesInAcl (1, &ea
, NULL
, &pNewDACL
) != ERROR_SUCCESS
)
1907 if (SetEntriesInAcl (1, &ea
, pOldDACL
, &pNewDACL
) != ERROR_SUCCESS
)
1910 if (SetNamedSecurityInfo
1911 (wname
, SE_FILE_OBJECT
,
1912 DACL_SECURITY_INFORMATION
, NULL
, NULL
, pNewDACL
, NULL
) != ERROR_SUCCESS
)
1916 LocalFree (pNewDACL
);
1919 /* Check if it is possible to use ACL for wname, the file must not be on a
1923 __gnat_can_use_acl (TCHAR
*wname
)
1925 return __gnat_use_acl
&& GetDriveTypeFromPath (wname
) != DRIVE_REMOTE
;
1928 #endif /* defined (_WIN32) */
1931 __gnat_is_readable_file_attr (char* name
, struct file_attributes
* attr
)
1933 if (attr
->readable
== ATTR_UNSET
)
1935 #if defined (_WIN32)
1936 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1937 GENERIC_MAPPING GenericMapping
;
1939 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1941 if (__gnat_can_use_acl (wname
))
1943 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1944 GenericMapping
.GenericRead
= GENERIC_READ
;
1946 __gnat_check_OWNER_ACL (wname
, FILE_READ_DATA
, GenericMapping
);
1949 attr
->readable
= GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
;
1951 __gnat_stat_to_attr (-1, name
, attr
);
1955 return attr
->readable
;
1959 __gnat_is_read_accessible_file (char *name
)
1961 #if defined (_WIN32)
1962 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1964 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1966 return !_waccess (wname
, 4);
1968 #elif defined (__vxworks)
1971 if ((fd
= open (name
, O_RDONLY
, 0)) < 0)
1977 return !access (name
, R_OK
);
1982 __gnat_is_readable_file (char *name
)
1984 struct file_attributes attr
;
1986 __gnat_reset_attributes (&attr
);
1987 return __gnat_is_readable_file_attr (name
, &attr
);
1991 __gnat_is_writable_file_attr (char* name
, struct file_attributes
* attr
)
1993 if (attr
->writable
== ATTR_UNSET
)
1995 #if defined (_WIN32)
1996 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1997 GENERIC_MAPPING GenericMapping
;
1999 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2001 if (__gnat_can_use_acl (wname
))
2003 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
2004 GenericMapping
.GenericWrite
= GENERIC_WRITE
;
2006 attr
->writable
= __gnat_check_OWNER_ACL
2007 (wname
, FILE_WRITE_DATA
| FILE_APPEND_DATA
, GenericMapping
)
2008 && !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
2012 !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
2015 __gnat_stat_to_attr (-1, name
, attr
);
2019 return attr
->writable
;
2023 __gnat_is_writable_file (char *name
)
2025 struct file_attributes attr
;
2027 __gnat_reset_attributes (&attr
);
2028 return __gnat_is_writable_file_attr (name
, &attr
);
2032 __gnat_is_write_accessible_file (char *name
)
2034 #if defined (_WIN32)
2035 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2037 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2039 return !_waccess (wname
, 2);
2041 #elif defined (__vxworks)
2044 if ((fd
= open (name
, O_WRONLY
, 0)) < 0)
2050 return !access (name
, W_OK
);
2055 __gnat_is_executable_file_attr (char* name
, struct file_attributes
* attr
)
2057 if (attr
->executable
== ATTR_UNSET
)
2059 #if defined (_WIN32)
2060 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2061 GENERIC_MAPPING GenericMapping
;
2063 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2065 if (__gnat_can_use_acl (wname
))
2067 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
2068 GenericMapping
.GenericExecute
= GENERIC_EXECUTE
;
2071 __gnat_check_OWNER_ACL (wname
, FILE_EXECUTE
, GenericMapping
);
2075 TCHAR
*l
, *last
= _tcsstr(wname
, _T(".exe"));
2077 /* look for last .exe */
2079 while ((l
= _tcsstr(last
+1, _T(".exe"))))
2083 GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
2084 && (last
- wname
) == (int) (_tcslen (wname
) - 4);
2087 __gnat_stat_to_attr (-1, name
, attr
);
2091 return attr
->regular
&& attr
->executable
;
2095 __gnat_is_executable_file (char *name
)
2097 struct file_attributes attr
;
2099 __gnat_reset_attributes (&attr
);
2100 return __gnat_is_executable_file_attr (name
, &attr
);
2104 __gnat_set_writable (char *name
)
2106 #if defined (_WIN32)
2107 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2109 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2111 if (__gnat_can_use_acl (wname
))
2112 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_WRITE
);
2115 (wname
, GetFileAttributes (wname
) & ~FILE_ATTRIBUTE_READONLY
);
2116 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2117 GNAT_STRUCT_STAT statbuf
;
2119 if (GNAT_STAT (name
, &statbuf
) == 0)
2121 statbuf
.st_mode
= statbuf
.st_mode
| S_IWUSR
;
2122 chmod (name
, statbuf
.st_mode
);
2127 /* must match definition in s-os_lib.ads */
2133 __gnat_set_executable (char *name
, int mode ATTRIBUTE_UNUSED
)
2135 #if defined (_WIN32)
2136 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2138 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2140 if (__gnat_can_use_acl (wname
))
2141 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_EXECUTE
);
2143 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2144 GNAT_STRUCT_STAT statbuf
;
2146 if (GNAT_STAT (name
, &statbuf
) == 0)
2149 statbuf
.st_mode
= statbuf
.st_mode
| S_IXUSR
;
2151 statbuf
.st_mode
= statbuf
.st_mode
| S_IXGRP
;
2152 if (mode
& S_OTHERS
)
2153 statbuf
.st_mode
= statbuf
.st_mode
| S_IXOTH
;
2154 chmod (name
, statbuf
.st_mode
);
2160 __gnat_set_non_writable (char *name
)
2162 #if defined (_WIN32)
2163 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2165 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2167 if (__gnat_can_use_acl (wname
))
2168 __gnat_set_OWNER_ACL
2169 (wname
, DENY_ACCESS
,
2170 FILE_WRITE_DATA
| FILE_APPEND_DATA
|
2171 FILE_WRITE_EA
| FILE_WRITE_ATTRIBUTES
);
2174 (wname
, GetFileAttributes (wname
) | FILE_ATTRIBUTE_READONLY
);
2175 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2176 GNAT_STRUCT_STAT statbuf
;
2178 if (GNAT_STAT (name
, &statbuf
) == 0)
2180 statbuf
.st_mode
= statbuf
.st_mode
& 07577;
2181 chmod (name
, statbuf
.st_mode
);
2187 __gnat_set_readable (char *name
)
2189 #if defined (_WIN32)
2190 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2192 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2194 if (__gnat_can_use_acl (wname
))
2195 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_READ
);
2197 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2198 GNAT_STRUCT_STAT statbuf
;
2200 if (GNAT_STAT (name
, &statbuf
) == 0)
2202 chmod (name
, statbuf
.st_mode
| S_IREAD
);
2208 __gnat_set_non_readable (char *name
)
2210 #if defined (_WIN32)
2211 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2213 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2215 if (__gnat_can_use_acl (wname
))
2216 __gnat_set_OWNER_ACL (wname
, DENY_ACCESS
, FILE_GENERIC_READ
);
2218 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2219 GNAT_STRUCT_STAT statbuf
;
2221 if (GNAT_STAT (name
, &statbuf
) == 0)
2223 chmod (name
, statbuf
.st_mode
& (~S_IREAD
));
2229 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED
,
2230 struct file_attributes
* attr
)
2232 if (attr
->symbolic_link
== ATTR_UNSET
)
2234 #if defined (__vxworks)
2235 attr
->symbolic_link
= 0;
2237 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2239 GNAT_STRUCT_STAT statbuf
;
2240 ret
= GNAT_LSTAT (name
, &statbuf
);
2241 attr
->symbolic_link
= (!ret
&& S_ISLNK (statbuf
.st_mode
));
2243 attr
->symbolic_link
= 0;
2246 return attr
->symbolic_link
;
2250 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED
)
2252 struct file_attributes attr
;
2254 __gnat_reset_attributes (&attr
);
2255 return __gnat_is_symbolic_link_attr (name
, &attr
);
2258 #if defined (__sun__)
2259 /* Using fork on Solaris will duplicate all the threads. fork1, which
2260 duplicates only the active thread, must be used instead, or spawning
2261 subprocess from a program with tasking will lead into numerous problems. */
2266 __gnat_portable_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2268 int status ATTRIBUTE_UNUSED
= 0;
2269 int finished ATTRIBUTE_UNUSED
;
2270 int pid ATTRIBUTE_UNUSED
;
2272 #if defined (__vxworks) || defined(__PikeOS__)
2275 #elif defined (__DJGPP__) || defined (_WIN32)
2276 /* args[0] must be quotes as it could contain a full pathname with spaces */
2277 char *args_0
= args
[0];
2278 args
[0] = (char *)xmalloc (strlen (args_0
) + 3);
2279 strcpy (args
[0], "\"");
2280 strcat (args
[0], args_0
);
2281 strcat (args
[0], "\"");
2283 status
= spawnvp (P_WAIT
, args_0
, (char ** const)args
);
2285 /* restore previous value */
2287 args
[0] = (char *)args_0
;
2303 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2308 finished
= waitpid (pid
, &status
, 0);
2310 if (finished
!= pid
|| WIFEXITED (status
) == 0)
2313 return WEXITSTATUS (status
);
2319 /* Create a copy of the given file descriptor.
2320 Return -1 if an error occurred. */
2323 __gnat_dup (int oldfd
)
2325 #if defined (__vxworks) && !defined (__RTP__)
2326 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2334 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2335 Return -1 if an error occurred. */
2338 __gnat_dup2 (int oldfd ATTRIBUTE_UNUSED
, int newfd ATTRIBUTE_UNUSED
)
2340 #if defined (__vxworks) && !defined (__RTP__)
2341 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2344 #elif defined (__PikeOS__)
2345 /* Not supported. */
2347 #elif defined (_WIN32)
2348 /* Special case when oldfd and newfd are identical and are the standard
2349 input, output or error as this makes Windows XP hangs. Note that we
2350 do that only for standard file descriptors that are known to be valid. */
2351 if (oldfd
== newfd
&& newfd
>= 0 && newfd
<= 2)
2354 return dup2 (oldfd
, newfd
);
2356 return dup2 (oldfd
, newfd
);
2361 __gnat_number_of_cpus (void)
2365 #if defined (__linux__) || defined (__sun__) || defined (_AIX) \
2366 || defined (__APPLE__) || defined (__FreeBSD__) || defined (__OpenBSD__) \
2367 || defined (__DragonFly__) || defined (__NetBSD__)
2368 cores
= (int) sysconf (_SC_NPROCESSORS_ONLN
);
2370 #elif defined (__QNX__)
2371 cores
= (int) _syspage_ptr
->num_cpu
;
2373 #elif defined (__hpux__)
2374 struct pst_dynamic psd
;
2375 if (pstat_getdynamic (&psd
, sizeof (psd
), 1, 0) != -1)
2376 cores
= (int) psd
.psd_proc_cnt
;
2378 #elif defined (_WIN32)
2379 SYSTEM_INFO sysinfo
;
2380 GetSystemInfo (&sysinfo
);
2381 cores
= (int) sysinfo
.dwNumberOfProcessors
;
2383 #elif defined (_WRS_CONFIG_SMP)
2384 unsigned int vxCpuConfiguredGet (void);
2386 cores
= vxCpuConfiguredGet ();
2393 /* WIN32 code to implement a wait call that wait for any child process. */
2395 #if defined (_WIN32)
2397 /* Synchronization code, to be thread safe. */
2401 /* For the Cert run times on native Windows we use dummy functions
2402 for locking and unlocking tasks since we do not support multiple
2403 threads on this configuration (Cert run time on native Windows). */
2405 static void EnterCS (void) {}
2406 static void LeaveCS (void) {}
2407 static void SignalListChanged (void) {}
2411 CRITICAL_SECTION ProcListCS
;
2412 HANDLE ProcListEvt
= NULL
;
2414 static void EnterCS (void)
2416 EnterCriticalSection(&ProcListCS
);
2419 static void LeaveCS (void)
2421 LeaveCriticalSection(&ProcListCS
);
2424 static void SignalListChanged (void)
2426 SetEvent (ProcListEvt
);
2431 static HANDLE
*HANDLES_LIST
= NULL
;
2432 static int *PID_LIST
= NULL
, plist_length
= 0, plist_max_length
= 0;
2435 add_handle (HANDLE h
, int pid
)
2437 /* -------------------- critical section -------------------- */
2440 if (plist_length
== plist_max_length
)
2442 plist_max_length
+= 100;
2444 (HANDLE
*) xrealloc (HANDLES_LIST
, sizeof (HANDLE
) * plist_max_length
);
2446 (int *) xrealloc (PID_LIST
, sizeof (int) * plist_max_length
);
2449 HANDLES_LIST
[plist_length
] = h
;
2450 PID_LIST
[plist_length
] = pid
;
2453 SignalListChanged();
2455 /* -------------------- critical section -------------------- */
2459 __gnat_win32_remove_handle (HANDLE h
, int pid
)
2464 /* -------------------- critical section -------------------- */
2467 for (j
= 0; j
< plist_length
; j
++)
2469 if ((HANDLES_LIST
[j
] == h
) || (PID_LIST
[j
] == pid
))
2473 HANDLES_LIST
[j
] = HANDLES_LIST
[plist_length
];
2474 PID_LIST
[j
] = PID_LIST
[plist_length
];
2481 /* -------------------- critical section -------------------- */
2484 SignalListChanged();
2490 win32_no_block_spawn (char *command
, char *args
[], HANDLE
*h
, int *pid
)
2494 PROCESS_INFORMATION PI
;
2495 SECURITY_ATTRIBUTES SA
;
2500 /* compute the total command line length */
2504 csize
+= strlen (args
[k
]) + 1;
2508 full_command
= (char *) xmalloc (csize
);
2511 SI
.cb
= sizeof (STARTUPINFO
);
2512 SI
.lpReserved
= NULL
;
2513 SI
.lpReserved2
= NULL
;
2514 SI
.lpDesktop
= NULL
;
2518 SI
.wShowWindow
= SW_HIDE
;
2520 /* Security attributes. */
2521 SA
.nLength
= sizeof (SECURITY_ATTRIBUTES
);
2522 SA
.bInheritHandle
= TRUE
;
2523 SA
.lpSecurityDescriptor
= NULL
;
2525 /* Prepare the command string. */
2526 strcpy (full_command
, command
);
2527 strcat (full_command
, " ");
2532 strcat (full_command
, args
[k
]);
2533 strcat (full_command
, " ");
2538 int wsize
= csize
* 2;
2539 TCHAR
*wcommand
= (TCHAR
*) xmalloc (wsize
);
2541 S2WSC (wcommand
, full_command
, wsize
);
2543 free (full_command
);
2545 result
= CreateProcess
2546 (NULL
, wcommand
, &SA
, NULL
, TRUE
,
2547 GetPriorityClass (GetCurrentProcess()), NULL
, NULL
, &SI
, &PI
);
2554 CloseHandle (PI
.hThread
);
2556 *pid
= PI
.dwProcessId
;
2566 win32_wait (int *status
)
2568 DWORD exitcode
, pid
;
2579 if (plist_length
== 0)
2585 /* -------------------- critical section -------------------- */
2588 /* ??? We can't wait for more than MAXIMUM_WAIT_OBJECTS due to a Win32
2590 if (plist_length
< MAXIMUM_WAIT_OBJECTS
)
2591 hl_len
= plist_length
;
2599 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * hl_len
);
2600 memmove (hl
, HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2601 pidl
= (int *) xmalloc (sizeof (int) * hl_len
);
2602 memmove (pidl
, PID_LIST
, sizeof (int) * hl_len
);
2604 /* Note that index 0 contains the event handle that is signaled when the
2605 process list has changed */
2606 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * (hl_len
+ 1));
2607 hl
[0] = ProcListEvt
;
2608 memmove (&hl
[1], HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2609 pidl
= (int *) xmalloc (sizeof (int) * (hl_len
+ 1));
2610 memmove (&pidl
[1], PID_LIST
, sizeof (int) * hl_len
);
2615 /* -------------------- critical section -------------------- */
2617 res
= WaitForMultipleObjects (hl_len
, hl
, FALSE
, INFINITE
);
2619 /* If there was an error, exit now */
2620 if (res
== WAIT_FAILED
)
2628 /* if the ProcListEvt has been signaled then the list of processes has been
2629 updated to add or remove a handle, just loop over */
2631 if (res
- WAIT_OBJECT_0
== 0)
2638 /* Handle two distinct groups of return codes: finished waits and abandoned
2641 if (res
< WAIT_ABANDONED_0
)
2642 pos
= res
- WAIT_OBJECT_0
;
2644 pos
= res
- WAIT_ABANDONED_0
;
2647 GetExitCodeProcess (h
, &exitcode
);
2650 found
= __gnat_win32_remove_handle (h
, -1);
2655 /* if not found another process waiting has already handled this process */
2662 *status
= (int) exitcode
;
2669 __gnat_portable_no_block_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2672 #if defined (__vxworks) || defined (__PikeOS__)
2673 /* Not supported. */
2676 #elif defined(__DJGPP__)
2677 if (spawnvp (P_WAIT
, args
[0], args
) != 0)
2682 #elif defined (_WIN32)
2687 win32_no_block_spawn (args
[0], args
, &h
, &pid
);
2690 add_handle (h
, pid
);
2703 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2713 __gnat_portable_wait (int *process_status
)
2718 #if defined (__vxworks) || defined (__PikeOS__)
2719 /* Not sure what to do here, so do nothing but return zero. */
2721 #elif defined (_WIN32)
2723 pid
= win32_wait (&status
);
2725 #elif defined (__DJGPP__)
2726 /* Child process has already ended in case of DJGPP.
2727 No need to do anything. Just return success. */
2730 pid
= waitpid (-1, &status
, 0);
2731 status
= status
& 0xffff;
2734 *process_status
= status
;
2739 __gnat_portable_no_block_wait (int *process_status
)
2744 #if defined (__vxworks) || defined (__PikeOS__) || defined (_WIN32)
2745 /* Not supported. */
2750 pid
= waitpid (-1, &status
, WNOHANG
);
2751 status
= status
& 0xffff;
2754 *process_status
= status
;
2759 __gnat_os_exit (int status
)
2765 __gnat_current_process_id (void)
2767 #if defined (__vxworks) || defined (__PikeOS__)
2770 #elif defined (_WIN32)
2772 return (int)GetCurrentProcessId();
2776 return (int)getpid();
2780 /* Locate file on path, that matches a predicate */
2783 __gnat_locate_file_with_predicate (char *file_name
, char *path_val
,
2784 int (*predicate
)(char *))
2787 char *file_path
= (char *) alloca (strlen (file_name
) + 1);
2790 /* Return immediately if file_name is empty */
2792 if (*file_name
== '\0')
2795 /* Remove quotes around file_name if present */
2801 strcpy (file_path
, ptr
);
2803 ptr
= file_path
+ strlen (file_path
) - 1;
2808 /* Handle absolute pathnames. */
2810 absolute
= __gnat_is_absolute_path (file_path
, strlen (file_name
));
2814 if (predicate (file_path
))
2815 return xstrdup (file_path
);
2820 /* If file_name include directory separator(s), try it first as
2821 a path name relative to the current directory */
2822 for (ptr
= file_name
; *ptr
&& *ptr
!= '/' && *ptr
!= DIR_SEPARATOR
; ptr
++)
2827 if (predicate (file_name
))
2828 return xstrdup (file_name
);
2835 /* The result has to be smaller than path_val + file_name. */
2837 (char *) alloca (strlen (path_val
) + strlen (file_name
) + 2);
2841 /* Skip the starting quote */
2843 if (*path_val
== '"')
2846 for (ptr
= file_path
; *path_val
&& *path_val
!= PATH_SEPARATOR
; )
2847 *ptr
++ = *path_val
++;
2849 /* If directory is empty, it is the current directory*/
2851 if (ptr
== file_path
)
2858 /* Skip the ending quote */
2863 if (*ptr
!= '/' && *ptr
!= DIR_SEPARATOR
)
2864 *++ptr
= DIR_SEPARATOR
;
2866 strcpy (++ptr
, file_name
);
2868 if (predicate (file_path
))
2869 return xstrdup (file_path
);
2874 /* Skip path separator */
2883 /* Locate an executable file, give a Path value. */
2886 __gnat_locate_executable_file (char *file_name
, char *path_val
)
2888 return __gnat_locate_file_with_predicate
2889 (file_name
, path_val
, &__gnat_is_executable_file
);
2892 /* Locate a regular file, give a Path value. */
2895 __gnat_locate_regular_file (char *file_name
, char *path_val
)
2897 return __gnat_locate_file_with_predicate
2898 (file_name
, path_val
, &__gnat_is_regular_file
);
2901 /* Locate an executable given a Path argument. This routine is only used by
2902 gnatbl and should not be used otherwise. Use locate_exec_on_path
2906 __gnat_locate_exec (char *exec_name
, char *path_val
)
2908 const unsigned int len
= strlen (HOST_EXECUTABLE_SUFFIX
);
2911 if (len
> 0 && !strstr (exec_name
, HOST_EXECUTABLE_SUFFIX
))
2913 char *full_exec_name
= (char *) alloca (strlen (exec_name
) + len
+ 1);
2915 strcpy (full_exec_name
, exec_name
);
2916 strcat (full_exec_name
, HOST_EXECUTABLE_SUFFIX
);
2917 ptr
= __gnat_locate_executable_file (full_exec_name
, path_val
);
2920 return __gnat_locate_executable_file (exec_name
, path_val
);
2924 return __gnat_locate_executable_file (exec_name
, path_val
);
2927 /* Locate an executable using the Systems default PATH. */
2930 __gnat_locate_exec_on_path (char *exec_name
)
2934 #if defined (_WIN32)
2935 TCHAR
*wpath_val
= _tgetenv (_T("PATH"));
2937 /* In Win32 systems we expand the PATH as for XP environment
2938 variables are not automatically expanded. We also prepend the
2939 ".;" to the path to match normal NT path search semantics */
2941 #define EXPAND_BUFFER_SIZE 32767
2943 wapath_val
= (TCHAR
*) alloca (EXPAND_BUFFER_SIZE
);
2945 wapath_val
[0] = '.';
2946 wapath_val
[1] = ';';
2948 DWORD res
= ExpandEnvironmentStrings
2949 (wpath_val
, &wapath_val
[2], EXPAND_BUFFER_SIZE
- 2);
2951 if (!res
) wapath_val
[0] = _T('\0');
2953 apath_val
= (char *) alloca (EXPAND_BUFFER_SIZE
);
2955 WS2SC (apath_val
, wapath_val
, EXPAND_BUFFER_SIZE
);
2958 const char *path_val
= getenv ("PATH");
2960 /* If PATH is not defined, proceed with __gnat_locate_exec anyway, so we can
2961 find files that contain directory names. */
2963 if (path_val
== NULL
) path_val
= "";
2964 apath_val
= (char *) alloca (strlen (path_val
) + 1);
2965 strcpy (apath_val
, path_val
);
2968 return __gnat_locate_exec (exec_name
, apath_val
);
2971 /* Dummy functions for Osint import for non-VMS systems.
2972 ??? To be removed. */
2975 __gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED
,
2976 int onlydirs ATTRIBUTE_UNUSED
)
2982 __gnat_to_canonical_file_list_next (void)
2984 static char empty
[] = "";
2989 __gnat_to_canonical_file_list_free (void)
2994 __gnat_to_canonical_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
3000 __gnat_to_canonical_file_spec (char *filespec
)
3006 __gnat_to_canonical_path_spec (char *pathspec
)
3012 __gnat_to_host_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
3018 __gnat_to_host_file_spec (char *filespec
)
3024 __gnat_adjust_os_resource_limits (void)
3028 #if defined (__mips_vxworks)
3032 CACHE_USER_FLUSH (0, ENTIRE_CACHE
);
3036 #if defined (_WIN32)
3037 int __gnat_argument_needs_quote
= 1;
3039 int __gnat_argument_needs_quote
= 0;
3042 /* This option is used to enable/disable object files handling from the
3043 binder file by the GNAT Project module. For example, this is disabled on
3044 Windows (prior to GCC 3.4) as it is already done by the mdll module.
3045 Stating with GCC 3.4 the shared libraries are not based on mdll
3046 anymore as it uses the GCC's -shared option */
3047 #if defined (_WIN32) \
3048 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
3049 int __gnat_prj_add_obj_files
= 0;
3051 int __gnat_prj_add_obj_files
= 1;
3054 /* char used as prefix/suffix for environment variables */
3055 #if defined (_WIN32)
3056 char __gnat_environment_char
= '%';
3058 char __gnat_environment_char
= '$';
3061 /* This functions copy the file attributes from a source file to a
3064 mode = 0 : In this mode copy only the file time stamps (last access and
3065 last modification time stamps).
3067 mode = 1 : In this mode, time stamps and read/write/execute attributes are
3070 mode = 2 : In this mode, only read/write/execute attributes are copied
3072 Returns 0 if operation was successful and -1 in case of error. */
3075 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED
, char *to ATTRIBUTE_UNUSED
,
3076 int mode ATTRIBUTE_UNUSED
)
3078 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
3081 #elif defined (_WIN32)
3082 TCHAR wfrom
[GNAT_MAX_PATH_LEN
+ 2];
3083 TCHAR wto
[GNAT_MAX_PATH_LEN
+ 2];
3085 FILETIME fct
, flat
, flwt
;
3088 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
+ 2);
3089 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
+ 2);
3091 /* Do we need to copy the timestamp ? */
3094 /* retrieve from times */
3097 (wfrom
, GENERIC_READ
, 0, NULL
, OPEN_EXISTING
,
3098 FILE_ATTRIBUTE_NORMAL
, NULL
);
3100 if (hfrom
== INVALID_HANDLE_VALUE
)
3103 res
= GetFileTime (hfrom
, &fct
, &flat
, &flwt
);
3105 CloseHandle (hfrom
);
3110 /* retrieve from times */
3113 (wto
, GENERIC_WRITE
, 0, NULL
, OPEN_EXISTING
,
3114 FILE_ATTRIBUTE_NORMAL
, NULL
);
3116 if (hto
== INVALID_HANDLE_VALUE
)
3119 res
= SetFileTime (hto
, NULL
, &flat
, &flwt
);
3127 /* Do we need to copy the permissions ? */
3128 /* Set file attributes in full mode. */
3132 DWORD attribs
= GetFileAttributes (wfrom
);
3134 if (attribs
== INVALID_FILE_ATTRIBUTES
)
3137 res
= SetFileAttributes (wto
, attribs
);
3145 GNAT_STRUCT_STAT fbuf
;
3146 struct utimbuf tbuf
;
3148 if (GNAT_STAT (from
, &fbuf
) == -1) {
3152 /* Do we need to copy timestamp ? */
3154 tbuf
.actime
= fbuf
.st_atime
;
3155 tbuf
.modtime
= fbuf
.st_mtime
;
3157 if (utime (to
, &tbuf
) == -1) {
3162 /* Do we need to copy file permissions ? */
3163 if (mode
!= 0 && (chmod (to
, fbuf
.st_mode
) == -1)) {
3172 __gnat_lseek (int fd
, long offset
, int whence
)
3174 return (int) lseek (fd
, offset
, whence
);
3177 /* This function returns the major version number of GCC being used. */
3179 get_gcc_version (void)
3184 return (int) (version_string
[0] - '0');
3189 * Set Close_On_Exec as indicated.
3190 * Note: this is used for both GNAT.OS_Lib and GNAT.Sockets.
3194 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED
,
3195 int close_on_exec_p ATTRIBUTE_UNUSED
)
3197 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
3198 int flags
= fcntl (fd
, F_GETFD
, 0);
3201 if (close_on_exec_p
)
3202 flags
|= FD_CLOEXEC
;
3204 flags
&= ~FD_CLOEXEC
;
3205 return fcntl (fd
, F_SETFD
, flags
);
3206 #elif defined(_WIN32)
3207 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
3208 if (h
== (HANDLE
) -1)
3210 if (close_on_exec_p
)
3211 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
, 0);
3212 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
,
3213 HANDLE_FLAG_INHERIT
);
3215 /* TODO: Unimplemented. */
3220 /* Indicates if platforms supports automatic initialization through the
3221 constructor mechanism */
3223 __gnat_binder_supports_auto_init (void)
3228 /* Indicates that Stand-Alone Libraries are automatically initialized through
3229 the constructor mechanism */
3231 __gnat_sals_init_using_constructors (void)
3233 #if defined (__vxworks) || defined (__Lynx__)
3240 #if defined (__linux__) || defined (__ANDROID__)
3241 /* There is no function in the glibc to retrieve the LWP of the current
3242 thread. We need to do a system call in order to retrieve this
3244 #include <sys/syscall.h>
3246 __gnat_lwp_self (void)
3248 return (void *) syscall (__NR_gettid
);
3252 #if defined (__APPLE__)
3253 # if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1060
3254 # include <mach/thread_info.h>
3255 # include <mach/mach_init.h>
3256 # include <mach/thread_act.h>
3258 # include <pthread.h>
3261 /* System-wide thread identifier. Note it could be truncated on 32 bit
3263 Previously was: pthread_mach_thread_np (pthread_self ()). */
3265 __gnat_lwp_self (void)
3267 #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ >= 1060
3268 thread_identifier_info_data_t data
;
3269 mach_msg_type_number_t count
= THREAD_IDENTIFIER_INFO_COUNT
;
3272 kret
= thread_info (mach_thread_self (), THREAD_IDENTIFIER_INFO
,
3273 (thread_info_t
) &data
, &count
);
3274 if (kret
== KERN_SUCCESS
)
3275 return (void *)(uintptr_t)data
.thread_id
;
3279 return (void *)pthread_mach_thread_np (pthread_self ());
3284 #if defined (__linux__)
3287 /* glibc versions earlier than 2.7 do not define the routines to handle
3288 dynamically allocated CPU sets. For these targets, we use the static
3293 /* Dynamic cpu sets */
3296 __gnat_cpu_alloc (size_t count
)
3298 return CPU_ALLOC (count
);
3302 __gnat_cpu_alloc_size (size_t count
)
3304 return CPU_ALLOC_SIZE (count
);
3308 __gnat_cpu_free (cpu_set_t
*set
)
3314 __gnat_cpu_zero (size_t count
, cpu_set_t
*set
)
3316 CPU_ZERO_S (count
, set
);
3320 __gnat_cpu_set (int cpu
, size_t count
, cpu_set_t
*set
)
3322 /* Ada handles CPU numbers starting from 1, while C identifies the first
3323 CPU by a 0, so we need to adjust. */
3324 CPU_SET_S (cpu
- 1, count
, set
);
3327 #else /* !CPU_ALLOC */
3329 /* Static cpu sets */
3332 __gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED
)
3334 return (cpu_set_t
*) xmalloc (sizeof (cpu_set_t
));
3338 __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED
)
3340 return sizeof (cpu_set_t
);
3344 __gnat_cpu_free (cpu_set_t
*set
)
3350 __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3356 __gnat_cpu_set (int cpu
, size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3358 /* Ada handles CPU numbers starting from 1, while C identifies the first
3359 CPU by a 0, so we need to adjust. */
3360 CPU_SET (cpu
- 1, set
);
3362 #endif /* !CPU_ALLOC */
3363 #endif /* __linux__ */
3365 /* Return the load address of the executable, or 0 if not known. In the
3366 specific case of error, (void *)-1 can be returned. Beware: this unit may
3367 be in a shared library. As low-level units are needed, we allow #include
3370 #if defined (__APPLE__)
3371 #include <mach-o/dyld.h>
3375 __gnat_get_executable_load_address (void)
3377 #if defined (__APPLE__)
3378 return _dyld_get_image_header (0);
3380 #elif 0 && defined (__linux__)
3381 /* Currently disabled as it needs at least -ldl. */
3382 struct link_map
*map
= _r_debug
.r_map
;
3384 return (const void *)map
->l_addr
;
3392 __gnat_kill (int pid
, int sig
, int close ATTRIBUTE_UNUSED
)
3395 HANDLE h
= OpenProcess (PROCESS_ALL_ACCESS
, FALSE
, pid
);
3400 TerminateProcess (h
, 1);
3402 else if (sig
== SIGINT
)
3403 GenerateConsoleCtrlEvent (CTRL_C_EVENT
, pid
);
3404 else if (sig
== SIGBREAK
)
3405 GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT
, pid
);
3406 /* ??? The last two alternatives don't really work. SIGBREAK requires setting
3407 up process groups at start time which we don't do; treating SIGINT is just
3408 not possible apparently. So we really only support signal 9. Fortunately
3409 that's all we use in GNAT.Expect */
3412 #elif defined (__vxworks)
3413 /* Not implemented */
3419 void __gnat_killprocesstree (int pid
, int sig_num
)
3424 memset(&pe
, 0, sizeof(PROCESSENTRY32
));
3425 pe
.dwSize
= sizeof(PROCESSENTRY32
);
3427 HANDLE hSnap
= CreateToolhelp32Snapshot (TH32CS_SNAPPROCESS
, 0);
3429 /* cannot take snapshot, just kill the parent process */
3431 if (hSnap
== INVALID_HANDLE_VALUE
)
3433 __gnat_kill (pid
, sig_num
, 1);
3437 if (Process32First(hSnap
, &pe
))
3439 BOOL bContinue
= TRUE
;
3441 /* kill child processes first */
3445 if (pe
.th32ParentProcessID
== (DWORD
)pid
)
3446 __gnat_killprocesstree (pe
.th32ProcessID
, sig_num
);
3448 bContinue
= Process32Next (hSnap
, &pe
);
3452 CloseHandle (hSnap
);
3456 __gnat_kill (pid
, sig_num
, 1);
3458 #elif defined (__vxworks)
3459 /* not implemented */
3461 #elif defined (__linux__)
3465 /* read all processes' pid and ppid */
3467 dir
= opendir ("/proc");
3469 /* cannot open proc, just kill the parent process */
3473 __gnat_kill (pid
, sig_num
, 1);
3477 /* kill child processes first */
3479 while ((d
= readdir (dir
)) != NULL
)
3481 if ((d
->d_type
& DT_DIR
) == DT_DIR
)
3486 /* read /proc/<PID>/stat */
3488 if (strlen (d
->d_name
) >= sizeof (statfile
) - strlen ("/proc//stat"))
3490 strcpy (statfile
, "/proc/");
3491 strcat (statfile
, d
->d_name
);
3492 strcat (statfile
, "/stat");
3494 FILE *fd
= fopen (statfile
, "r");
3498 const int match
= fscanf (fd
, "%d %*s %*s %d", &_pid
, &_ppid
);
3501 if (match
== 2 && _ppid
== pid
)
3502 __gnat_killprocesstree (_pid
, sig_num
);
3511 __gnat_kill (pid
, sig_num
, 1);
3513 __gnat_kill (pid
, sig_num
, 1);
3515 /* Note on Solaris it is possible to read /proc/<PID>/status.
3516 The 5th and 6th words are the pid and the 7th and 8th the ppid.
3517 See: /usr/include/sys/procfs.h (struct pstatus).