1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
9 * Copyright (C) 1992-2015, 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 */
42 #ifndef _LARGEFILE_SOURCE
43 #define _LARGEFILE_SOURCE
45 #define _FILE_OFFSET_BITS 64
49 /* No need to redefine exit here. */
52 /* We want to use the POSIX variants of include files. */
56 #if defined (__mips_vxworks)
58 #endif /* __mips_vxworks */
60 /* If SMP, access vxCpuConfiguredGet */
61 #ifdef _WRS_CONFIG_SMP
63 #endif /* _WRS_CONFIG_SMP */
65 /* We need to know the VxWorks version because some file operations
66 (such as chmod) are only available on VxWorks 6. */
71 #if defined (__APPLE__)
75 #if defined (__hpux__)
76 #include <sys/param.h>
77 #include <sys/pstat.h>
81 #define __BSD_VISIBLE 1
91 #if defined (__vxworks) || defined (__ANDROID__)
92 /* S_IREAD and S_IWRITE are not defined in VxWorks or Android */
94 #define S_IREAD (S_IRUSR | S_IRGRP | S_IROTH)
98 #define S_IWRITE (S_IWUSR)
102 /* We don't have libiberty, so use malloc. */
103 #define xmalloc(S) malloc (S)
104 #define xrealloc(V,S) realloc (V,S)
115 #if defined (__MINGW32__) || defined (__CYGWIN__)
119 /* Current code page and CCS encoding to use, set in initialize.c. */
120 UINT CurrentCodePage
;
121 UINT CurrentCCSEncoding
;
123 #include <sys/utime.h>
125 /* For isalpha-like tests in the compiler, we're expected to resort to
126 safe-ctype.h/ISALPHA. This isn't available for the runtime library
127 build, so we fallback on ctype.h/isalpha there. */
131 #define ISALPHA isalpha
134 #elif defined (__Lynx__)
136 /* Lynx utime.h only defines the entities of interest to us if
137 defined (VMOS_DEV), so ... */
146 /* wait.h processing */
149 # include <sys/wait.h>
151 #elif defined (__vxworks) && defined (__RTP__)
153 #elif defined (__Lynx__)
154 /* ??? We really need wait.h and it includes resource.h on Lynx. GCC
155 has a resource.h header as well, included instead of the lynx
156 version in our setup, causing lots of errors. We don't really need
157 the lynx contents of this file, so just workaround the issue by
158 preventing the inclusion of the GCC header from doing anything. */
159 # define GCC_RESOURCE_H
160 # include <sys/wait.h>
161 #elif defined (__PikeOS__)
162 /* No wait() or waitpid() calls available. */
165 #include <sys/wait.h>
176 #define DIR_SEPARATOR '\\'
184 /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
185 defined in the current system. On DOS-like systems these flags control
186 whether the file is opened/created in text-translation mode (CR/LF in
187 external file mapped to LF in internal file), but in Unix-like systems,
188 no text translation is required, so these flags have no effect. */
198 #ifndef HOST_EXECUTABLE_SUFFIX
199 #define HOST_EXECUTABLE_SUFFIX ""
202 #ifndef HOST_OBJECT_SUFFIX
203 #define HOST_OBJECT_SUFFIX ".o"
206 #ifndef PATH_SEPARATOR
207 #define PATH_SEPARATOR ':'
210 #ifndef DIR_SEPARATOR
211 #define DIR_SEPARATOR '/'
214 /* Check for cross-compilation. */
215 #if defined (CROSS_COMPILE) || defined (CROSS_DIRECTORY_STRUCTURE)
217 int __gnat_is_cross_compiler
= 1;
220 int __gnat_is_cross_compiler
= 0;
223 char __gnat_dir_separator
= DIR_SEPARATOR
;
225 char __gnat_path_separator
= PATH_SEPARATOR
;
227 /* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
228 the base filenames that libraries specified with -lsomelib options
229 may have. This is used by GNATMAKE to check whether an executable
230 is up-to-date or not. The syntax is
232 library_template ::= { pattern ; } pattern NUL
233 pattern ::= [ prefix ] * [ postfix ]
235 These should only specify names of static libraries as it makes
236 no sense to determine at link time if dynamic-link libraries are
237 up to date or not. Any libraries that are not found are supposed
240 * if they are needed but not present, the link
243 * otherwise they are libraries in the system paths and so
244 they are considered part of the system and not checked
247 ??? This should be part of a GNAT host-specific compiler
248 file instead of being included in all user applications
249 as well. This is only a temporary work-around for 3.11b. */
251 #ifndef GNAT_LIBRARY_TEMPLATE
252 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
255 const char *__gnat_library_template
= GNAT_LIBRARY_TEMPLATE
;
257 #if defined (__vxworks)
258 #define GNAT_MAX_PATH_LEN PATH_MAX
262 #if defined (__MINGW32__)
266 #include <sys/param.h>
270 #include <sys/param.h>
274 #define GNAT_MAX_PATH_LEN MAXPATHLEN
276 #define GNAT_MAX_PATH_LEN 256
281 /* Used for runtime check that Ada constant File_Attributes_Size is no
282 less than the actual size of struct file_attributes (see Osint
284 int __gnat_size_of_file_attributes
= sizeof (struct file_attributes
);
286 void __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
);
288 /* The __gnat_max_path_len variable is used to export the maximum
289 length of a path name to Ada code. max_path_len is also provided
290 for compatibility with older GNAT versions, please do not use
293 int __gnat_max_path_len
= GNAT_MAX_PATH_LEN
;
294 int max_path_len
= GNAT_MAX_PATH_LEN
;
296 /* Control whether we can use ACL on Windows. */
298 int __gnat_use_acl
= 1;
300 /* The following macro HAVE_READDIR_R should be defined if the
301 system provides the routine readdir_r.
302 ... but we never define it anywhere??? */
303 #undef HAVE_READDIR_R
305 #define MAYBE_TO_PTR32(argv) argv
307 static const char ATTR_UNSET
= 127;
309 /* Reset the file attributes as if no system call had been performed */
312 __gnat_reset_attributes (struct file_attributes
* attr
)
314 attr
->exists
= ATTR_UNSET
;
315 attr
->error
= EINVAL
;
317 attr
->writable
= ATTR_UNSET
;
318 attr
->readable
= ATTR_UNSET
;
319 attr
->executable
= ATTR_UNSET
;
321 attr
->regular
= ATTR_UNSET
;
322 attr
->symbolic_link
= ATTR_UNSET
;
323 attr
->directory
= ATTR_UNSET
;
325 attr
->timestamp
= (OS_Time
)-2;
326 attr
->file_length
= -1;
330 __gnat_error_attributes (struct file_attributes
*attr
) {
335 __gnat_current_time (void)
337 time_t res
= time (NULL
);
338 return (OS_Time
) res
;
341 /* Return the current local time as a string in the ISO 8601 format of
342 "YYYY-MM-DD HH:MM:SS.SS". The returned string is 22 + 1 (NULL) characters
346 __gnat_current_time_string (char *result
)
348 const char *format
= "%Y-%m-%d %H:%M:%S";
349 /* Format string necessary to describe the ISO 8601 format */
351 const time_t t_val
= time (NULL
);
353 strftime (result
, 22, format
, localtime (&t_val
));
354 /* Convert the local time into a string following the ISO format, copying
355 at most 22 characters into the result string. */
360 /* The sub-seconds are manually set to zero since type time_t lacks the
361 precision necessary for nanoseconds. */
365 __gnat_to_gm_time (OS_Time
*p_time
, int *p_year
, int *p_month
, int *p_day
,
366 int *p_hours
, int *p_mins
, int *p_secs
)
369 time_t time
= (time_t) *p_time
;
372 /* On Windows systems, the time is sometimes rounded up to the nearest
373 even second, so if the number of seconds is odd, increment it. */
378 res
= gmtime (&time
);
381 *p_year
= res
->tm_year
;
382 *p_month
= res
->tm_mon
;
383 *p_day
= res
->tm_mday
;
384 *p_hours
= res
->tm_hour
;
385 *p_mins
= res
->tm_min
;
386 *p_secs
= res
->tm_sec
;
389 *p_year
= *p_month
= *p_day
= *p_hours
= *p_mins
= *p_secs
= 0;
393 __gnat_to_os_time (OS_Time
*p_time
, int year
, int month
, int day
,
394 int hours
, int mins
, int secs
)
406 /* returns -1 of failing, this is s-os_lib Invalid_Time */
408 *p_time
= (OS_Time
) mktime (&v
);
411 /* Place the contents of the symbolic link named PATH in the buffer BUF,
412 which has size BUFSIZ. If PATH is a symbolic link, then return the number
413 of characters of its content in BUF. Otherwise, return -1.
414 For systems not supporting symbolic links, always return -1. */
417 __gnat_readlink (char *path ATTRIBUTE_UNUSED
,
418 char *buf ATTRIBUTE_UNUSED
,
419 size_t bufsiz ATTRIBUTE_UNUSED
)
421 #if defined (_WIN32) \
422 || defined(__vxworks) || defined (__PikeOS__)
425 return readlink (path
, buf
, bufsiz
);
429 /* Creates a symbolic link named NEWPATH which contains the string OLDPATH.
430 If NEWPATH exists it will NOT be overwritten.
431 For systems not supporting symbolic links, always return -1. */
434 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED
,
435 char *newpath ATTRIBUTE_UNUSED
)
437 #if defined (_WIN32) \
438 || defined(__vxworks) || defined (__PikeOS__)
441 return symlink (oldpath
, newpath
);
445 /* Try to lock a file, return 1 if success. */
447 #if defined (__vxworks) \
448 || defined (_WIN32) || defined (__PikeOS__)
450 /* Version that does not use link. */
453 __gnat_try_lock (char *dir
, char *file
)
457 TCHAR wfull_path
[GNAT_MAX_PATH_LEN
];
458 TCHAR wfile
[GNAT_MAX_PATH_LEN
];
459 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
461 S2WSC (wdir
, dir
, GNAT_MAX_PATH_LEN
);
462 S2WSC (wfile
, file
, GNAT_MAX_PATH_LEN
);
464 /* ??? the code below crash on MingW64 for obscure reasons, a ticket
465 has been opened here:
467 https://sourceforge.net/p/mingw-w64/bugs/414/
469 As a workaround an equivalent set of code has been put in place below.
471 _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
474 _tcscpy (wfull_path
, wdir
);
475 _tcscat (wfull_path
, L
"\\");
476 _tcscat (wfull_path
, wfile
);
478 fd
= _topen (wfull_path
, O_CREAT
| O_EXCL
, 0600);
482 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
483 fd
= open (full_path
, O_CREAT
| O_EXCL
, 0600);
495 /* Version using link(), more secure over NFS. */
496 /* See TN 6913-016 for discussion ??? */
499 __gnat_try_lock (char *dir
, char *file
)
503 GNAT_STRUCT_STAT stat_result
;
506 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
507 sprintf (temp_file
, "%s%cTMP-%ld-%ld",
508 dir
, DIR_SEPARATOR
, (long)getpid(), (long)getppid ());
510 /* Create the temporary file and write the process number. */
511 fd
= open (temp_file
, O_CREAT
| O_WRONLY
, 0600);
517 /* Link it with the new file. */
518 link (temp_file
, full_path
);
520 /* Count the references on the old one. If we have a count of two, then
521 the link did succeed. Remove the temporary file before returning. */
522 __gnat_stat (temp_file
, &stat_result
);
524 return stat_result
.st_nlink
== 2;
528 /* Return the maximum file name length. */
531 __gnat_get_maximum_file_name_length (void)
536 /* Return nonzero if file names are case sensitive. */
538 static int file_names_case_sensitive_cache
= -1;
541 __gnat_get_file_names_case_sensitive (void)
543 if (file_names_case_sensitive_cache
== -1)
545 const char *sensitive
= getenv ("GNAT_FILE_NAME_CASE_SENSITIVE");
547 if (sensitive
!= NULL
548 && (sensitive
[0] == '0' || sensitive
[0] == '1')
549 && sensitive
[1] == '\0')
550 file_names_case_sensitive_cache
= sensitive
[0] - '0';
553 /* By default, we suppose filesystems aren't case sensitive on
554 Windows and Darwin (but they are on arm-darwin). */
555 #if defined (WINNT) || (defined (__APPLE__) && !defined (__arm__))
556 file_names_case_sensitive_cache
= 0;
558 file_names_case_sensitive_cache
= 1;
562 return file_names_case_sensitive_cache
;
565 /* Return nonzero if environment variables are case sensitive. */
568 __gnat_get_env_vars_case_sensitive (void)
578 __gnat_get_default_identifier_character_set (void)
583 /* Return the current working directory. */
586 __gnat_get_current_dir (char *dir
, int *length
)
588 #if defined (__MINGW32__)
589 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
591 _tgetcwd (wdir
, *length
);
593 WS2SC (dir
, wdir
, GNAT_MAX_PATH_LEN
);
596 getcwd (dir
, *length
);
599 *length
= strlen (dir
);
601 if (dir
[*length
- 1] != DIR_SEPARATOR
)
603 dir
[*length
] = DIR_SEPARATOR
;
609 /* Return the suffix for object files. */
612 __gnat_get_object_suffix_ptr (int *len
, const char **value
)
614 *value
= HOST_OBJECT_SUFFIX
;
619 *len
= strlen (*value
);
624 /* Return the suffix for executable files. */
627 __gnat_get_executable_suffix_ptr (int *len
, const char **value
)
629 *value
= HOST_EXECUTABLE_SUFFIX
;
633 *len
= strlen (*value
);
638 /* Return the suffix for debuggable files. Usually this is the same as the
639 executable extension. */
642 __gnat_get_debuggable_suffix_ptr (int *len
, const char **value
)
644 *value
= HOST_EXECUTABLE_SUFFIX
;
649 *len
= strlen (*value
);
654 /* Returns the OS filename and corresponding encoding. */
657 __gnat_os_filename (char *filename ATTRIBUTE_UNUSED
,
658 char *w_filename ATTRIBUTE_UNUSED
,
659 char *os_name
, int *o_length
,
660 char *encoding ATTRIBUTE_UNUSED
, int *e_length
)
662 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
663 WS2SC (os_name
, (TCHAR
*)w_filename
, (DWORD
)*o_length
);
664 *o_length
= strlen (os_name
);
665 strcpy (encoding
, "encoding=utf8");
666 *e_length
= strlen (encoding
);
668 strcpy (os_name
, filename
);
669 *o_length
= strlen (filename
);
677 __gnat_unlink (char *path
)
679 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
681 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
683 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
684 return _tunlink (wpath
);
687 return unlink (path
);
694 __gnat_rename (char *from
, char *to
)
696 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
698 TCHAR wfrom
[GNAT_MAX_PATH_LEN
], wto
[GNAT_MAX_PATH_LEN
];
700 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
);
701 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
);
702 return _trename (wfrom
, wto
);
705 return rename (from
, to
);
709 /* Changing directory. */
712 __gnat_chdir (char *path
)
714 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
716 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
718 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
719 return _tchdir (wpath
);
726 /* Removing a directory. */
729 __gnat_rmdir (char *path
)
731 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
733 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
735 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
736 return _trmdir (wpath
);
738 #elif defined (VTHREADS)
739 /* rmdir not available */
746 #if defined (_WIN32) || defined (linux) || defined (sun) \
747 || defined (__FreeBSD__)
748 #define HAS_TARGET_WCHAR_T
751 #ifdef HAS_TARGET_WCHAR_T
756 __gnat_fputwc(int c
, FILE *stream
)
758 #ifdef HAS_TARGET_WCHAR_T
759 return fputwc ((wchar_t)c
, stream
);
761 return fputc (c
, stream
);
766 __gnat_fopen (char *path
, char *mode
, int encoding ATTRIBUTE_UNUSED
)
768 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
769 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
772 S2WS (wmode
, mode
, 10);
774 if (encoding
== Encoding_Unspecified
)
775 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
776 else if (encoding
== Encoding_UTF8
)
777 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
779 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
781 return _tfopen (wpath
, wmode
);
784 return GNAT_FOPEN (path
, mode
);
789 __gnat_freopen (char *path
,
792 int encoding ATTRIBUTE_UNUSED
)
794 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
795 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
798 S2WS (wmode
, mode
, 10);
800 if (encoding
== Encoding_Unspecified
)
801 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
802 else if (encoding
== Encoding_UTF8
)
803 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
805 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
807 return _tfreopen (wpath
, wmode
, stream
);
809 return freopen (path
, mode
, stream
);
814 __gnat_open_read (char *path
, int fmode
)
817 int o_fmode
= O_BINARY
;
822 #if defined (__vxworks)
823 fd
= open (path
, O_RDONLY
| o_fmode
, 0444);
824 #elif defined (__MINGW32__)
826 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
828 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
829 fd
= _topen (wpath
, O_RDONLY
| o_fmode
, 0444);
832 fd
= GNAT_OPEN (path
, O_RDONLY
| o_fmode
);
835 return fd
< 0 ? -1 : fd
;
838 #if defined (__MINGW32__)
839 #define PERM (S_IREAD | S_IWRITE)
841 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
845 __gnat_open_rw (char *path
, int fmode
)
848 int o_fmode
= O_BINARY
;
853 #if defined (__MINGW32__)
855 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
857 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
858 fd
= _topen (wpath
, O_RDWR
| o_fmode
, PERM
);
861 fd
= GNAT_OPEN (path
, O_RDWR
| o_fmode
, PERM
);
864 return fd
< 0 ? -1 : fd
;
868 __gnat_open_create (char *path
, int fmode
)
871 int o_fmode
= O_BINARY
;
876 #if defined (__MINGW32__)
878 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
880 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
881 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
884 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
887 return fd
< 0 ? -1 : fd
;
891 __gnat_create_output_file (char *path
)
894 #if defined (__MINGW32__)
896 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
898 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
899 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
902 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
905 return fd
< 0 ? -1 : fd
;
909 __gnat_create_output_file_new (char *path
)
912 #if defined (__MINGW32__)
914 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
916 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
917 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
920 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
923 return fd
< 0 ? -1 : fd
;
927 __gnat_open_append (char *path
, int fmode
)
930 int o_fmode
= O_BINARY
;
935 #if defined (__MINGW32__)
937 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
939 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
940 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
943 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
946 return fd
< 0 ? -1 : fd
;
949 /* Open a new file. Return error (-1) if the file already exists. */
952 __gnat_open_new (char *path
, int fmode
)
955 int o_fmode
= O_BINARY
;
960 #if defined (__MINGW32__)
962 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
964 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
965 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
968 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
971 return fd
< 0 ? -1 : fd
;
974 /* Open a new temp file. Return error (-1) if the file already exists. */
977 __gnat_open_new_temp (char *path
, int fmode
)
980 int o_fmode
= O_BINARY
;
982 strcpy (path
, "GNAT-XXXXXX");
984 #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
985 || defined (linux) || defined(__GLIBC__)) && !defined (__vxworks)
986 return mkstemp (path
);
987 #elif defined (__Lynx__)
990 if (mktemp (path
) == NULL
)
997 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
998 return fd
< 0 ? -1 : fd
;
1002 __gnat_open (char *path
, int fmode
)
1006 #if defined (__MINGW32__)
1008 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1010 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1011 fd
= _topen (wpath
, fmode
, PERM
);
1014 fd
= GNAT_OPEN (path
, fmode
, PERM
);
1017 return fd
< 0 ? -1 : fd
;
1020 /****************************************************************
1021 ** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information
1022 ** as possible from it, storing the result in a cache for later reuse
1023 ****************************************************************/
1026 __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
)
1028 GNAT_STRUCT_STAT statbuf
;
1032 /* GNAT_FSTAT returns -1 and sets errno for failure */
1033 ret
= GNAT_FSTAT (fd
, &statbuf
);
1034 error
= ret
? errno
: 0;
1037 /* __gnat_stat returns errno value directly */
1038 error
= __gnat_stat (name
, &statbuf
);
1039 ret
= error
? -1 : 0;
1043 * A missing file is reported as an attr structure with error == 0 and
1047 if (error
== 0 || error
== ENOENT
)
1050 attr
->error
= error
;
1052 attr
->regular
= (!ret
&& S_ISREG (statbuf
.st_mode
));
1053 attr
->directory
= (!ret
&& S_ISDIR (statbuf
.st_mode
));
1056 attr
->file_length
= 0;
1058 /* st_size may be 32 bits, or 64 bits which is converted to long. We
1059 don't return a useful value for files larger than 2 gigabytes in
1061 attr
->file_length
= statbuf
.st_size
; /* all systems */
1063 attr
->exists
= !ret
;
1065 #if !defined (_WIN32)
1066 /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
1067 attr
->readable
= (!ret
&& (statbuf
.st_mode
& S_IRUSR
));
1068 attr
->writable
= (!ret
&& (statbuf
.st_mode
& S_IWUSR
));
1069 attr
->executable
= (!ret
&& (statbuf
.st_mode
& S_IXUSR
));
1073 attr
->timestamp
= (OS_Time
)-1;
1075 attr
->timestamp
= (OS_Time
)statbuf
.st_mtime
;
1079 /****************************************************************
1080 ** Return the number of bytes in the specified file
1081 ****************************************************************/
1084 __gnat_file_length_attr (int fd
, char* name
, struct file_attributes
* attr
)
1086 if (attr
->file_length
== -1) {
1087 __gnat_stat_to_attr (fd
, name
, attr
);
1090 return attr
->file_length
;
1094 __gnat_file_length (int fd
)
1096 struct file_attributes attr
;
1097 __gnat_reset_attributes (&attr
);
1098 return __gnat_file_length_attr (fd
, NULL
, &attr
);
1102 __gnat_file_length_long (int fd
)
1104 struct file_attributes attr
;
1105 __gnat_reset_attributes (&attr
);
1106 return (long)__gnat_file_length_attr (fd
, NULL
, &attr
);
1110 __gnat_named_file_length (char *name
)
1112 struct file_attributes attr
;
1113 __gnat_reset_attributes (&attr
);
1114 return __gnat_file_length_attr (-1, name
, &attr
);
1117 /* Create a temporary filename and put it in string pointed to by
1121 __gnat_tmp_name (char *tmp_filename
)
1123 #if defined (__MINGW32__)
1128 /* tempnam tries to create a temporary file in directory pointed to by
1129 TMP environment variable, in c:\temp if TMP is not set, and in
1130 directory specified by P_tmpdir in stdio.h if c:\temp does not
1131 exist. The filename will be created with the prefix "gnat-". */
1133 sprintf (prefix
, "gnat-%d-", (int)getpid());
1134 pname
= (char *) _tempnam ("c:\\temp", prefix
);
1136 /* if pname is NULL, the file was not created properly, the disk is full
1137 or there is no more free temporary files */
1140 *tmp_filename
= '\0';
1142 /* If pname start with a back slash and not path information it means that
1143 the filename is valid for the current working directory. */
1145 else if (pname
[0] == '\\')
1147 strcpy (tmp_filename
, ".\\");
1148 strcat (tmp_filename
, pname
+1);
1151 strcpy (tmp_filename
, pname
);
1156 #elif defined (linux) || defined (__FreeBSD__) || defined (__NetBSD__) \
1157 || defined (__OpenBSD__) || defined(__GLIBC__) || defined (__ANDROID__)
1158 #define MAX_SAFE_PATH 1000
1159 char *tmpdir
= getenv ("TMPDIR");
1161 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1162 a buffer overflow. */
1163 if (tmpdir
== NULL
|| strlen (tmpdir
) > MAX_SAFE_PATH
)
1165 strcpy (tmp_filename
, "/cache/gnat-XXXXXX");
1167 strcpy (tmp_filename
, "/tmp/gnat-XXXXXX");
1170 sprintf (tmp_filename
, "%s/gnat-XXXXXX", tmpdir
);
1172 close (mkstemp(tmp_filename
));
1173 #elif defined (__vxworks) && !(defined (__RTP__) || defined (VTHREADS))
1177 static ushort_t seed
= 0; /* used to generate unique name */
1179 /* generate unique name */
1180 strcpy (tmp_filename
, "tmp");
1182 /* fill up the name buffer from the last position */
1184 pos
= tmp_filename
+ strlen (tmp_filename
) + index
;
1188 for (t
= seed
; 0 <= --index
; t
>>= 3)
1189 *--pos
= '0' + (t
& 07);
1191 tmpnam (tmp_filename
);
1195 /* Open directory and returns a DIR pointer. */
1197 DIR* __gnat_opendir (char *name
)
1199 #if defined (__MINGW32__)
1200 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1202 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1203 return (DIR*)_topendir (wname
);
1206 return opendir (name
);
1210 /* Read the next entry in a directory. The returned string points somewhere
1213 #if defined (sun) && defined (__SVR4)
1214 /* For Solaris, be sure to use the 64-bit version, otherwise NFS reads may
1215 fail with EOVERFLOW if the server uses 64-bit cookies. */
1216 #define dirent dirent64
1217 #define readdir readdir64
1221 __gnat_readdir (DIR *dirp
, char *buffer
, int *len
)
1223 #if defined (__MINGW32__)
1224 struct _tdirent
*dirent
= _treaddir ((_TDIR
*)dirp
);
1228 WS2SC (buffer
, dirent
->d_name
, GNAT_MAX_PATH_LEN
);
1229 *len
= strlen (buffer
);
1236 #elif defined (HAVE_READDIR_R)
1237 /* If possible, try to use the thread-safe version. */
1238 if (readdir_r (dirp
, buffer
) != NULL
)
1240 *len
= strlen (((struct dirent
*) buffer
)->d_name
);
1241 return ((struct dirent
*) buffer
)->d_name
;
1247 struct dirent
*dirent
= (struct dirent
*) readdir (dirp
);
1251 strcpy (buffer
, dirent
->d_name
);
1252 *len
= strlen (buffer
);
1261 /* Close a directory entry. */
1263 int __gnat_closedir (DIR *dirp
)
1265 #if defined (__MINGW32__)
1266 return _tclosedir ((_TDIR
*)dirp
);
1269 return closedir (dirp
);
1273 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1276 __gnat_readdir_is_thread_safe (void)
1278 #ifdef HAVE_READDIR_R
1285 #if defined (_WIN32)
1286 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1287 static const unsigned long long w32_epoch_offset
= 11644473600ULL;
1289 /* Returns the file modification timestamp using Win32 routines which are
1290 immune against daylight saving time change. It is in fact not possible to
1291 use fstat for this purpose as the DST modify the st_mtime field of the
1295 win32_filetime (HANDLE h
)
1300 unsigned long long ull_time
;
1303 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1304 since <Jan 1st 1601>. This function must return the number of seconds
1305 since <Jan 1st 1970>. */
1307 if (GetFileTime (h
, NULL
, NULL
, &t_write
.ft_time
))
1308 return (time_t) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1312 /* As above but starting from a FILETIME. */
1314 f2t (const FILETIME
*ft
, __time64_t
*t
)
1319 unsigned long long ull_time
;
1322 t_write
.ft_time
= *ft
;
1323 *t
= (__time64_t
) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1327 /* Return a GNAT time stamp given a file name. */
1330 __gnat_file_time_name_attr (char* name
, struct file_attributes
* attr
)
1332 if (attr
->timestamp
== (OS_Time
)-2) {
1333 #if defined (_WIN32)
1335 WIN32_FILE_ATTRIBUTE_DATA fad
;
1336 __time64_t ret
= -1;
1337 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1338 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1340 if ((res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
)))
1341 f2t (&fad
.ftLastWriteTime
, &ret
);
1342 attr
->timestamp
= (OS_Time
) ret
;
1344 __gnat_stat_to_attr (-1, name
, attr
);
1347 return attr
->timestamp
;
1351 __gnat_file_time_name (char *name
)
1353 struct file_attributes attr
;
1354 __gnat_reset_attributes (&attr
);
1355 return __gnat_file_time_name_attr (name
, &attr
);
1358 /* Return a GNAT time stamp given a file descriptor. */
1361 __gnat_file_time_fd_attr (int fd
, struct file_attributes
* attr
)
1363 if (attr
->timestamp
== (OS_Time
)-2) {
1364 #if defined (_WIN32)
1365 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
1366 time_t ret
= win32_filetime (h
);
1367 attr
->timestamp
= (OS_Time
) ret
;
1370 __gnat_stat_to_attr (fd
, NULL
, attr
);
1374 return attr
->timestamp
;
1378 __gnat_file_time_fd (int fd
)
1380 struct file_attributes attr
;
1381 __gnat_reset_attributes (&attr
);
1382 return __gnat_file_time_fd_attr (fd
, &attr
);
1385 /* Set the file time stamp. */
1388 __gnat_set_file_time_name (char *name
, time_t time_stamp
)
1390 #if defined (__vxworks)
1392 /* Code to implement __gnat_set_file_time_name for these systems. */
1394 #elif defined (_WIN32)
1398 unsigned long long ull_time
;
1400 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1402 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1404 HANDLE h
= CreateFile
1405 (wname
, GENERIC_WRITE
, FILE_SHARE_WRITE
, NULL
,
1406 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
,
1408 if (h
== INVALID_HANDLE_VALUE
)
1410 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1411 t_write
.ull_time
= ((unsigned long long)time_stamp
+ w32_epoch_offset
);
1412 /* Convert to 100 nanosecond units */
1413 t_write
.ull_time
*= 10000000ULL;
1415 SetFileTime(h
, NULL
, NULL
, &t_write
.ft_time
);
1420 struct utimbuf utimbuf
;
1423 /* Set modification time to requested time. */
1424 utimbuf
.modtime
= time_stamp
;
1426 /* Set access time to now in local time. */
1427 t
= time ((time_t) 0);
1428 utimbuf
.actime
= mktime (localtime (&t
));
1430 utime (name
, &utimbuf
);
1434 /* Get the list of installed standard libraries from the
1435 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1439 __gnat_get_libraries_from_registry (void)
1441 char *result
= (char *) xmalloc (1);
1445 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
1448 DWORD name_size
, value_size
;
1455 /* First open the key. */
1456 res
= RegOpenKeyExA (HKEY_LOCAL_MACHINE
, "SOFTWARE", 0, KEY_READ
, ®_key
);
1458 if (res
== ERROR_SUCCESS
)
1459 res
= RegOpenKeyExA (reg_key
, "Ada Core Technologies", 0,
1460 KEY_READ
, ®_key
);
1462 if (res
== ERROR_SUCCESS
)
1463 res
= RegOpenKeyExA (reg_key
, "GNAT", 0, KEY_READ
, ®_key
);
1465 if (res
== ERROR_SUCCESS
)
1466 res
= RegOpenKeyExA (reg_key
, "Standard Libraries", 0, KEY_READ
, ®_key
);
1468 /* If the key exists, read out all the values in it and concatenate them
1470 for (index
= 0; res
== ERROR_SUCCESS
; index
++)
1472 value_size
= name_size
= 256;
1473 res
= RegEnumValueA (reg_key
, index
, name
, &name_size
, 0,
1474 &type
, (LPBYTE
)value
, &value_size
);
1476 if (res
== ERROR_SUCCESS
&& type
== REG_SZ
)
1478 char *old_result
= result
;
1480 result
= (char *) xmalloc (strlen (old_result
) + value_size
+ 2);
1481 strcpy (result
, old_result
);
1482 strcat (result
, value
);
1483 strcat (result
, ";");
1488 /* Remove the trailing ";". */
1490 result
[strlen (result
) - 1] = 0;
1496 /* Query information for the given file NAME and return it in STATBUF.
1497 * Returns 0 for success, or errno value for failure.
1500 __gnat_stat (char *name
, GNAT_STRUCT_STAT
*statbuf
)
1503 WIN32_FILE_ATTRIBUTE_DATA fad
;
1504 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1509 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1510 name_len
= _tcslen (wname
);
1512 if (name_len
> GNAT_MAX_PATH_LEN
)
1515 ZeroMemory (statbuf
, sizeof(GNAT_STRUCT_STAT
));
1517 res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
);
1520 error
= GetLastError();
1522 /* Check file existence using GetFileAttributes() which does not fail on
1523 special Windows files like con:, aux:, nul: etc... */
1525 if (GetFileAttributes(wname
) != INVALID_FILE_ATTRIBUTES
) {
1526 /* Just pretend that it is a regular and readable file */
1527 statbuf
->st_mode
= S_IFREG
| S_IREAD
| S_IWRITE
;
1532 case ERROR_ACCESS_DENIED
:
1533 case ERROR_SHARING_VIOLATION
:
1534 case ERROR_LOCK_VIOLATION
:
1535 case ERROR_SHARING_BUFFER_EXCEEDED
:
1537 case ERROR_BUFFER_OVERFLOW
:
1538 return ENAMETOOLONG
;
1539 case ERROR_NOT_ENOUGH_MEMORY
:
1546 f2t (&fad
.ftCreationTime
, &statbuf
->st_ctime
);
1547 f2t (&fad
.ftLastWriteTime
, &statbuf
->st_mtime
);
1548 f2t (&fad
.ftLastAccessTime
, &statbuf
->st_atime
);
1551 (__int64
)fad
.nFileSizeLow
| (__int64
)fad
.nFileSizeHigh
<< 32;
1553 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1554 statbuf
->st_mode
= S_IREAD
;
1556 if (fad
.dwFileAttributes
& FILE_ATTRIBUTE_DIRECTORY
)
1557 statbuf
->st_mode
|= S_IFDIR
;
1559 statbuf
->st_mode
|= S_IFREG
;
1561 if (!(fad
.dwFileAttributes
& FILE_ATTRIBUTE_READONLY
))
1562 statbuf
->st_mode
|= S_IWRITE
;
1567 return GNAT_STAT (name
, statbuf
) == 0 ? 0 : errno
;
1571 /*************************************************************************
1572 ** Check whether a file exists
1573 *************************************************************************/
1576 __gnat_file_exists_attr (char* name
, struct file_attributes
* attr
)
1578 if (attr
->exists
== ATTR_UNSET
)
1579 __gnat_stat_to_attr (-1, name
, attr
);
1581 return attr
->exists
;
1585 __gnat_file_exists (char *name
)
1587 struct file_attributes attr
;
1588 __gnat_reset_attributes (&attr
);
1589 return __gnat_file_exists_attr (name
, &attr
);
1592 /**********************************************************************
1593 ** Whether name is an absolute path
1594 **********************************************************************/
1597 __gnat_is_absolute_path (char *name
, int length
)
1600 /* On VxWorks systems, an absolute path can be represented (depending on
1601 the host platform) as either /dir/file, or device:/dir/file, or
1602 device:drive_letter:/dir/file. */
1609 for (index
= 0; index
< length
; index
++)
1611 if (name
[index
] == ':' &&
1612 ((name
[index
+ 1] == '/') ||
1613 (isalpha (name
[index
+ 1]) && index
+ 2 <= length
&&
1614 name
[index
+ 2] == '/')))
1617 else if (name
[index
] == '/')
1622 return (length
!= 0) &&
1623 (*name
== '/' || *name
== DIR_SEPARATOR
1625 || (length
> 1 && ISALPHA (name
[0]) && name
[1] == ':')
1632 __gnat_is_regular_file_attr (char* name
, struct file_attributes
* attr
)
1634 if (attr
->regular
== ATTR_UNSET
)
1635 __gnat_stat_to_attr (-1, name
, attr
);
1637 return attr
->regular
;
1641 __gnat_is_regular_file (char *name
)
1643 struct file_attributes attr
;
1645 __gnat_reset_attributes (&attr
);
1646 return __gnat_is_regular_file_attr (name
, &attr
);
1650 __gnat_is_regular_file_fd (int fd
)
1653 GNAT_STRUCT_STAT statbuf
;
1655 ret
= GNAT_FSTAT (fd
, &statbuf
);
1656 return (!ret
&& S_ISREG (statbuf
.st_mode
));
1660 __gnat_is_directory_attr (char* name
, struct file_attributes
* attr
)
1662 if (attr
->directory
== ATTR_UNSET
)
1663 __gnat_stat_to_attr (-1, name
, attr
);
1665 return attr
->directory
;
1669 __gnat_is_directory (char *name
)
1671 struct file_attributes attr
;
1673 __gnat_reset_attributes (&attr
);
1674 return __gnat_is_directory_attr (name
, &attr
);
1677 #if defined (_WIN32)
1679 /* Returns the same constant as GetDriveType but takes a pathname as
1683 GetDriveTypeFromPath (TCHAR
*wfullpath
)
1685 TCHAR wdrv
[MAX_PATH
];
1686 TCHAR wpath
[MAX_PATH
];
1687 TCHAR wfilename
[MAX_PATH
];
1688 TCHAR wext
[MAX_PATH
];
1690 _tsplitpath (wfullpath
, wdrv
, wpath
, wfilename
, wext
);
1692 if (_tcslen (wdrv
) != 0)
1694 /* we have a drive specified. */
1695 _tcscat (wdrv
, _T("\\"));
1696 return GetDriveType (wdrv
);
1700 /* No drive specified. */
1702 /* Is this a relative path, if so get current drive type. */
1703 if (wpath
[0] != _T('\\') ||
1704 (_tcslen (wpath
) > 2 && wpath
[0] == _T('\\')
1705 && wpath
[1] != _T('\\')))
1706 return GetDriveType (NULL
);
1708 UINT result
= GetDriveType (wpath
);
1710 /* Cannot guess the drive type, is this \\.\ ? */
1712 if (result
== DRIVE_NO_ROOT_DIR
&&
1713 _tcslen (wpath
) >= 4 && wpath
[0] == _T('\\') && wpath
[1] == _T('\\')
1714 && wpath
[2] == _T('.') && wpath
[3] == _T('\\'))
1716 if (_tcslen (wpath
) == 4)
1717 _tcscat (wpath
, wfilename
);
1719 LPTSTR p
= &wpath
[4];
1720 LPTSTR b
= _tcschr (p
, _T('\\'));
1724 /* logical drive \\.\c\dir\file */
1730 _tcscat (p
, _T(":\\"));
1732 return GetDriveType (p
);
1739 /* This MingW section contains code to work with ACL. */
1741 __gnat_check_OWNER_ACL (TCHAR
*wname
,
1742 DWORD CheckAccessDesired
,
1743 GENERIC_MAPPING CheckGenericMapping
)
1745 DWORD dwAccessDesired
, dwAccessAllowed
;
1746 PRIVILEGE_SET PrivilegeSet
;
1747 DWORD dwPrivSetSize
= sizeof (PRIVILEGE_SET
);
1748 BOOL fAccessGranted
= FALSE
;
1749 HANDLE hToken
= NULL
;
1751 PSECURITY_DESCRIPTOR pSD
= NULL
;
1754 (wname
, OWNER_SECURITY_INFORMATION
|
1755 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1758 if ((pSD
= (SECURITY_DESCRIPTOR
*) HeapAlloc
1759 (GetProcessHeap (), HEAP_ZERO_MEMORY
, nLength
)) == NULL
)
1762 /* Obtain the security descriptor. */
1764 if (!GetFileSecurity
1765 (wname
, OWNER_SECURITY_INFORMATION
|
1766 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1767 pSD
, nLength
, &nLength
))
1770 if (!ImpersonateSelf (SecurityImpersonation
))
1773 if (!OpenThreadToken
1774 (GetCurrentThread(), TOKEN_DUPLICATE
| TOKEN_QUERY
, FALSE
, &hToken
))
1777 /* Undoes the effect of ImpersonateSelf. */
1781 /* We want to test for write permissions. */
1783 dwAccessDesired
= CheckAccessDesired
;
1785 MapGenericMask (&dwAccessDesired
, &CheckGenericMapping
);
1788 (pSD
, /* security descriptor to check */
1789 hToken
, /* impersonation token */
1790 dwAccessDesired
, /* requested access rights */
1791 &CheckGenericMapping
, /* pointer to GENERIC_MAPPING */
1792 &PrivilegeSet
, /* receives privileges used in check */
1793 &dwPrivSetSize
, /* size of PrivilegeSet buffer */
1794 &dwAccessAllowed
, /* receives mask of allowed access rights */
1798 CloseHandle (hToken
);
1799 HeapFree (GetProcessHeap (), 0, pSD
);
1800 return fAccessGranted
;
1804 CloseHandle (hToken
);
1805 HeapFree (GetProcessHeap (), 0, pSD
);
1810 __gnat_set_OWNER_ACL (TCHAR
*wname
,
1811 ACCESS_MODE AccessMode
,
1812 DWORD AccessPermissions
)
1814 PACL pOldDACL
= NULL
;
1815 PACL pNewDACL
= NULL
;
1816 PSECURITY_DESCRIPTOR pSD
= NULL
;
1818 TCHAR username
[100];
1821 /* Get current user, he will act as the owner */
1823 if (!GetUserName (username
, &unsize
))
1826 if (GetNamedSecurityInfo
1829 DACL_SECURITY_INFORMATION
,
1830 NULL
, NULL
, &pOldDACL
, NULL
, &pSD
) != ERROR_SUCCESS
)
1833 BuildExplicitAccessWithName
1834 (&ea
, username
, AccessPermissions
, (ACCESS_MODE
) AccessMode
, NO_INHERITANCE
);
1836 if (AccessMode
== SET_ACCESS
)
1838 /* SET_ACCESS, we want to set an explicte set of permissions, do not
1839 merge with current DACL. */
1840 if (SetEntriesInAcl (1, &ea
, NULL
, &pNewDACL
) != ERROR_SUCCESS
)
1844 if (SetEntriesInAcl (1, &ea
, pOldDACL
, &pNewDACL
) != ERROR_SUCCESS
)
1847 if (SetNamedSecurityInfo
1848 (wname
, SE_FILE_OBJECT
,
1849 DACL_SECURITY_INFORMATION
, NULL
, NULL
, pNewDACL
, NULL
) != ERROR_SUCCESS
)
1853 LocalFree (pNewDACL
);
1856 /* Check if it is possible to use ACL for wname, the file must not be on a
1860 __gnat_can_use_acl (TCHAR
*wname
)
1862 return __gnat_use_acl
&& GetDriveTypeFromPath (wname
) != DRIVE_REMOTE
;
1865 #endif /* defined (_WIN32) */
1868 __gnat_is_readable_file_attr (char* name
, struct file_attributes
* attr
)
1870 if (attr
->readable
== ATTR_UNSET
)
1872 #if defined (_WIN32)
1873 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1874 GENERIC_MAPPING GenericMapping
;
1876 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1878 if (__gnat_can_use_acl (wname
))
1880 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1881 GenericMapping
.GenericRead
= GENERIC_READ
;
1883 __gnat_check_OWNER_ACL (wname
, FILE_READ_DATA
, GenericMapping
);
1886 attr
->readable
= GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
;
1888 __gnat_stat_to_attr (-1, name
, attr
);
1892 return attr
->readable
;
1896 __gnat_is_readable_file (char *name
)
1898 struct file_attributes attr
;
1900 __gnat_reset_attributes (&attr
);
1901 return __gnat_is_readable_file_attr (name
, &attr
);
1905 __gnat_is_writable_file_attr (char* name
, struct file_attributes
* attr
)
1907 if (attr
->writable
== ATTR_UNSET
)
1909 #if defined (_WIN32)
1910 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1911 GENERIC_MAPPING GenericMapping
;
1913 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1915 if (__gnat_can_use_acl (wname
))
1917 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1918 GenericMapping
.GenericWrite
= GENERIC_WRITE
;
1920 attr
->writable
= __gnat_check_OWNER_ACL
1921 (wname
, FILE_WRITE_DATA
| FILE_APPEND_DATA
, GenericMapping
)
1922 && !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
1926 !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
1929 __gnat_stat_to_attr (-1, name
, attr
);
1933 return attr
->writable
;
1937 __gnat_is_writable_file (char *name
)
1939 struct file_attributes attr
;
1941 __gnat_reset_attributes (&attr
);
1942 return __gnat_is_writable_file_attr (name
, &attr
);
1946 __gnat_is_executable_file_attr (char* name
, struct file_attributes
* attr
)
1948 if (attr
->executable
== ATTR_UNSET
)
1950 #if defined (_WIN32)
1951 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1952 GENERIC_MAPPING GenericMapping
;
1954 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1956 if (__gnat_can_use_acl (wname
))
1958 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1959 GenericMapping
.GenericExecute
= GENERIC_EXECUTE
;
1962 __gnat_check_OWNER_ACL (wname
, FILE_EXECUTE
, GenericMapping
);
1966 TCHAR
*l
, *last
= _tcsstr(wname
, _T(".exe"));
1968 /* look for last .exe */
1970 while ((l
= _tcsstr(last
+1, _T(".exe"))))
1974 GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
1975 && (last
- wname
) == (int) (_tcslen (wname
) - 4);
1978 __gnat_stat_to_attr (-1, name
, attr
);
1982 return attr
->regular
&& attr
->executable
;
1986 __gnat_is_executable_file (char *name
)
1988 struct file_attributes attr
;
1990 __gnat_reset_attributes (&attr
);
1991 return __gnat_is_executable_file_attr (name
, &attr
);
1995 __gnat_set_writable (char *name
)
1997 #if defined (_WIN32)
1998 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2000 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2002 if (__gnat_can_use_acl (wname
))
2003 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_WRITE
);
2006 (wname
, GetFileAttributes (wname
) & ~FILE_ATTRIBUTE_READONLY
);
2007 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2008 GNAT_STRUCT_STAT statbuf
;
2010 if (GNAT_STAT (name
, &statbuf
) == 0)
2012 statbuf
.st_mode
= statbuf
.st_mode
| S_IWUSR
;
2013 chmod (name
, statbuf
.st_mode
);
2018 /* must match definition in s-os_lib.ads */
2024 __gnat_set_executable (char *name
, int mode ATTRIBUTE_UNUSED
)
2026 #if defined (_WIN32)
2027 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2029 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2031 if (__gnat_can_use_acl (wname
))
2032 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_EXECUTE
);
2034 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2035 GNAT_STRUCT_STAT statbuf
;
2037 if (GNAT_STAT (name
, &statbuf
) == 0)
2040 statbuf
.st_mode
= statbuf
.st_mode
| S_IXUSR
;
2042 statbuf
.st_mode
= statbuf
.st_mode
| S_IXGRP
;
2043 if (mode
& S_OTHERS
)
2044 statbuf
.st_mode
= statbuf
.st_mode
| S_IXOTH
;
2045 chmod (name
, statbuf
.st_mode
);
2051 __gnat_set_non_writable (char *name
)
2053 #if defined (_WIN32)
2054 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2056 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2058 if (__gnat_can_use_acl (wname
))
2059 __gnat_set_OWNER_ACL
2060 (wname
, DENY_ACCESS
,
2061 FILE_WRITE_DATA
| FILE_APPEND_DATA
|
2062 FILE_WRITE_EA
| FILE_WRITE_ATTRIBUTES
);
2065 (wname
, GetFileAttributes (wname
) | FILE_ATTRIBUTE_READONLY
);
2066 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2067 GNAT_STRUCT_STAT statbuf
;
2069 if (GNAT_STAT (name
, &statbuf
) == 0)
2071 statbuf
.st_mode
= statbuf
.st_mode
& 07577;
2072 chmod (name
, statbuf
.st_mode
);
2078 __gnat_set_readable (char *name
)
2080 #if defined (_WIN32)
2081 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2083 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2085 if (__gnat_can_use_acl (wname
))
2086 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_READ
);
2088 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2089 GNAT_STRUCT_STAT statbuf
;
2091 if (GNAT_STAT (name
, &statbuf
) == 0)
2093 chmod (name
, statbuf
.st_mode
| S_IREAD
);
2099 __gnat_set_non_readable (char *name
)
2101 #if defined (_WIN32)
2102 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2104 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2106 if (__gnat_can_use_acl (wname
))
2107 __gnat_set_OWNER_ACL (wname
, DENY_ACCESS
, FILE_GENERIC_READ
);
2109 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2110 GNAT_STRUCT_STAT statbuf
;
2112 if (GNAT_STAT (name
, &statbuf
) == 0)
2114 chmod (name
, statbuf
.st_mode
& (~S_IREAD
));
2120 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED
,
2121 struct file_attributes
* attr
)
2123 if (attr
->symbolic_link
== ATTR_UNSET
)
2125 #if defined (__vxworks)
2126 attr
->symbolic_link
= 0;
2128 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2130 GNAT_STRUCT_STAT statbuf
;
2131 ret
= GNAT_LSTAT (name
, &statbuf
);
2132 attr
->symbolic_link
= (!ret
&& S_ISLNK (statbuf
.st_mode
));
2134 attr
->symbolic_link
= 0;
2137 return attr
->symbolic_link
;
2141 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED
)
2143 struct file_attributes attr
;
2145 __gnat_reset_attributes (&attr
);
2146 return __gnat_is_symbolic_link_attr (name
, &attr
);
2149 #if defined (sun) && defined (__SVR4)
2150 /* Using fork on Solaris will duplicate all the threads. fork1, which
2151 duplicates only the active thread, must be used instead, or spawning
2152 subprocess from a program with tasking will lead into numerous problems. */
2157 __gnat_portable_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2159 int status ATTRIBUTE_UNUSED
= 0;
2160 int finished ATTRIBUTE_UNUSED
;
2161 int pid ATTRIBUTE_UNUSED
;
2163 #if defined (__vxworks) || defined(__PikeOS__)
2166 #elif defined (_WIN32)
2167 /* args[0] must be quotes as it could contain a full pathname with spaces */
2168 char *args_0
= args
[0];
2169 args
[0] = (char *)xmalloc (strlen (args_0
) + 3);
2170 strcpy (args
[0], "\"");
2171 strcat (args
[0], args_0
);
2172 strcat (args
[0], "\"");
2174 status
= spawnvp (P_WAIT
, args_0
, (char ** const)args
);
2176 /* restore previous value */
2178 args
[0] = (char *)args_0
;
2194 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2199 finished
= waitpid (pid
, &status
, 0);
2201 if (finished
!= pid
|| WIFEXITED (status
) == 0)
2204 return WEXITSTATUS (status
);
2210 /* Create a copy of the given file descriptor.
2211 Return -1 if an error occurred. */
2214 __gnat_dup (int oldfd
)
2216 #if defined (__vxworks) && !defined (__RTP__)
2217 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2225 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2226 Return -1 if an error occurred. */
2229 __gnat_dup2 (int oldfd ATTRIBUTE_UNUSED
, int newfd ATTRIBUTE_UNUSED
)
2231 #if defined (__vxworks) && !defined (__RTP__)
2232 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2235 #elif defined (__PikeOS__)
2236 /* Not supported. */
2238 #elif defined (_WIN32)
2239 /* Special case when oldfd and newfd are identical and are the standard
2240 input, output or error as this makes Windows XP hangs. Note that we
2241 do that only for standard file descriptors that are known to be valid. */
2242 if (oldfd
== newfd
&& newfd
>= 0 && newfd
<= 2)
2245 return dup2 (oldfd
, newfd
);
2247 return dup2 (oldfd
, newfd
);
2252 __gnat_number_of_cpus (void)
2256 #if defined (linux) || defined (sun) || defined (AIX) || defined (__APPLE__)
2257 cores
= (int) sysconf (_SC_NPROCESSORS_ONLN
);
2259 #elif defined (__hpux__)
2260 struct pst_dynamic psd
;
2261 if (pstat_getdynamic (&psd
, sizeof (psd
), 1, 0) != -1)
2262 cores
= (int) psd
.psd_proc_cnt
;
2264 #elif defined (_WIN32)
2265 SYSTEM_INFO sysinfo
;
2266 GetSystemInfo (&sysinfo
);
2267 cores
= (int) sysinfo
.dwNumberOfProcessors
;
2269 #elif defined (_WRS_CONFIG_SMP)
2270 unsigned int vxCpuConfiguredGet (void);
2272 cores
= vxCpuConfiguredGet ();
2279 /* WIN32 code to implement a wait call that wait for any child process. */
2281 #if defined (_WIN32)
2283 /* Synchronization code, to be thread safe. */
2287 /* For the Cert run times on native Windows we use dummy functions
2288 for locking and unlocking tasks since we do not support multiple
2289 threads on this configuration (Cert run time on native Windows). */
2291 static void EnterCS (void) {}
2292 static void LeaveCS (void) {}
2293 static void SignalListChanged (void) {}
2297 CRITICAL_SECTION ProcListCS
;
2298 HANDLE ProcListEvt
= NULL
;
2300 static void EnterCS (void)
2302 EnterCriticalSection(&ProcListCS
);
2305 static void LeaveCS (void)
2307 LeaveCriticalSection(&ProcListCS
);
2310 static void SignalListChanged (void)
2312 SetEvent (ProcListEvt
);
2317 static HANDLE
*HANDLES_LIST
= NULL
;
2318 static int *PID_LIST
= NULL
, plist_length
= 0, plist_max_length
= 0;
2321 add_handle (HANDLE h
, int pid
)
2323 /* -------------------- critical section -------------------- */
2326 if (plist_length
== plist_max_length
)
2328 plist_max_length
+= 100;
2330 (HANDLE
*) xrealloc (HANDLES_LIST
, sizeof (HANDLE
) * plist_max_length
);
2332 (int *) xrealloc (PID_LIST
, sizeof (int) * plist_max_length
);
2335 HANDLES_LIST
[plist_length
] = h
;
2336 PID_LIST
[plist_length
] = pid
;
2339 SignalListChanged();
2341 /* -------------------- critical section -------------------- */
2345 __gnat_win32_remove_handle (HANDLE h
, int pid
)
2350 /* -------------------- critical section -------------------- */
2353 for (j
= 0; j
< plist_length
; j
++)
2355 if ((HANDLES_LIST
[j
] == h
) || (PID_LIST
[j
] == pid
))
2359 HANDLES_LIST
[j
] = HANDLES_LIST
[plist_length
];
2360 PID_LIST
[j
] = PID_LIST
[plist_length
];
2367 /* -------------------- critical section -------------------- */
2370 SignalListChanged();
2376 win32_no_block_spawn (char *command
, char *args
[], HANDLE
*h
, int *pid
)
2380 PROCESS_INFORMATION PI
;
2381 SECURITY_ATTRIBUTES SA
;
2386 /* compute the total command line length */
2390 csize
+= strlen (args
[k
]) + 1;
2394 full_command
= (char *) xmalloc (csize
);
2397 SI
.cb
= sizeof (STARTUPINFO
);
2398 SI
.lpReserved
= NULL
;
2399 SI
.lpReserved2
= NULL
;
2400 SI
.lpDesktop
= NULL
;
2404 SI
.wShowWindow
= SW_HIDE
;
2406 /* Security attributes. */
2407 SA
.nLength
= sizeof (SECURITY_ATTRIBUTES
);
2408 SA
.bInheritHandle
= TRUE
;
2409 SA
.lpSecurityDescriptor
= NULL
;
2411 /* Prepare the command string. */
2412 strcpy (full_command
, command
);
2413 strcat (full_command
, " ");
2418 strcat (full_command
, args
[k
]);
2419 strcat (full_command
, " ");
2424 int wsize
= csize
* 2;
2425 TCHAR
*wcommand
= (TCHAR
*) xmalloc (wsize
);
2427 S2WSC (wcommand
, full_command
, wsize
);
2429 free (full_command
);
2431 result
= CreateProcess
2432 (NULL
, wcommand
, &SA
, NULL
, TRUE
,
2433 GetPriorityClass (GetCurrentProcess()), NULL
, NULL
, &SI
, &PI
);
2440 CloseHandle (PI
.hThread
);
2442 *pid
= PI
.dwProcessId
;
2452 win32_wait (int *status
)
2454 DWORD exitcode
, pid
;
2464 if (plist_length
== 0)
2470 /* -------------------- critical section -------------------- */
2473 hl_len
= plist_length
;
2476 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * hl_len
);
2477 memmove (hl
, HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2478 pidl
= (int *) xmalloc (sizeof (int) * hl_len
);
2479 memmove (pidl
, PID_LIST
, sizeof (int) * hl_len
);
2481 /* Note that index 0 contains the event handle that is signaled when the
2482 process list has changed */
2483 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * hl_len
+ 1);
2484 hl
[0] = ProcListEvt
;
2485 memmove (&hl
[1], HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2486 pidl
= (int *) xmalloc (sizeof (int) * hl_len
+ 1);
2487 memmove (&pidl
[1], PID_LIST
, sizeof (int) * hl_len
);
2492 /* -------------------- critical section -------------------- */
2494 res
= WaitForMultipleObjects (hl_len
, hl
, FALSE
, INFINITE
);
2496 /* if the ProcListEvt has been signaled then the list of processes has been
2497 updated to add or remove a handle, just loop over */
2499 if (res
- WAIT_OBJECT_0
== 0)
2506 h
= hl
[res
- WAIT_OBJECT_0
];
2507 GetExitCodeProcess (h
, &exitcode
);
2508 pid
= pidl
[res
- WAIT_OBJECT_0
];
2510 found
= __gnat_win32_remove_handle (h
, -1);
2515 /* if not found another process waiting has already handled this process */
2522 *status
= (int) exitcode
;
2529 __gnat_portable_no_block_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2532 #if defined (__vxworks) || defined (__PikeOS__)
2533 /* Not supported. */
2536 #elif defined (_WIN32)
2541 win32_no_block_spawn (args
[0], args
, &h
, &pid
);
2544 add_handle (h
, pid
);
2557 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2567 __gnat_portable_wait (int *process_status
)
2572 #if defined (__vxworks) || defined (__PikeOS__)
2573 /* Not sure what to do here, so do nothing but return zero. */
2575 #elif defined (_WIN32)
2577 pid
= win32_wait (&status
);
2581 pid
= waitpid (-1, &status
, 0);
2582 status
= status
& 0xffff;
2585 *process_status
= status
;
2590 __gnat_os_exit (int status
)
2595 /* Locate file on path, that matches a predicate */
2598 __gnat_locate_file_with_predicate (char *file_name
, char *path_val
,
2599 int (*predicate
)(char *))
2602 char *file_path
= (char *) alloca (strlen (file_name
) + 1);
2605 /* Return immediately if file_name is empty */
2607 if (*file_name
== '\0')
2610 /* Remove quotes around file_name if present */
2616 strcpy (file_path
, ptr
);
2618 ptr
= file_path
+ strlen (file_path
) - 1;
2623 /* Handle absolute pathnames. */
2625 absolute
= __gnat_is_absolute_path (file_path
, strlen (file_name
));
2629 if (predicate (file_path
))
2630 return xstrdup (file_path
);
2635 /* If file_name include directory separator(s), try it first as
2636 a path name relative to the current directory */
2637 for (ptr
= file_name
; *ptr
&& *ptr
!= '/' && *ptr
!= DIR_SEPARATOR
; ptr
++)
2642 if (predicate (file_name
))
2643 return xstrdup (file_name
);
2650 /* The result has to be smaller than path_val + file_name. */
2652 (char *) alloca (strlen (path_val
) + strlen (file_name
) + 2);
2656 /* Skip the starting quote */
2658 if (*path_val
== '"')
2661 for (ptr
= file_path
; *path_val
&& *path_val
!= PATH_SEPARATOR
; )
2662 *ptr
++ = *path_val
++;
2664 /* If directory is empty, it is the current directory*/
2666 if (ptr
== file_path
)
2673 /* Skip the ending quote */
2678 if (*ptr
!= '/' && *ptr
!= DIR_SEPARATOR
)
2679 *++ptr
= DIR_SEPARATOR
;
2681 strcpy (++ptr
, file_name
);
2683 if (predicate (file_path
))
2684 return xstrdup (file_path
);
2689 /* Skip path separator */
2698 /* Locate an executable file, give a Path value. */
2701 __gnat_locate_executable_file (char *file_name
, char *path_val
)
2703 return __gnat_locate_file_with_predicate
2704 (file_name
, path_val
, &__gnat_is_executable_file
);
2707 /* Locate a regular file, give a Path value. */
2710 __gnat_locate_regular_file (char *file_name
, char *path_val
)
2712 return __gnat_locate_file_with_predicate
2713 (file_name
, path_val
, &__gnat_is_regular_file
);
2716 /* Locate an executable given a Path argument. This routine is only used by
2717 gnatbl and should not be used otherwise. Use locate_exec_on_path
2721 __gnat_locate_exec (char *exec_name
, char *path_val
)
2724 if (!strstr (exec_name
, HOST_EXECUTABLE_SUFFIX
))
2726 char *full_exec_name
=
2728 (strlen (exec_name
) + strlen (HOST_EXECUTABLE_SUFFIX
) + 1);
2730 strcpy (full_exec_name
, exec_name
);
2731 strcat (full_exec_name
, HOST_EXECUTABLE_SUFFIX
);
2732 ptr
= __gnat_locate_executable_file (full_exec_name
, path_val
);
2735 return __gnat_locate_executable_file (exec_name
, path_val
);
2739 return __gnat_locate_executable_file (exec_name
, path_val
);
2742 /* Locate an executable using the Systems default PATH. */
2745 __gnat_locate_exec_on_path (char *exec_name
)
2749 #if defined (_WIN32)
2750 TCHAR
*wpath_val
= _tgetenv (_T("PATH"));
2752 /* In Win32 systems we expand the PATH as for XP environment
2753 variables are not automatically expanded. We also prepend the
2754 ".;" to the path to match normal NT path search semantics */
2756 #define EXPAND_BUFFER_SIZE 32767
2758 wapath_val
= (TCHAR
*) alloca (EXPAND_BUFFER_SIZE
);
2760 wapath_val
[0] = '.';
2761 wapath_val
[1] = ';';
2763 DWORD res
= ExpandEnvironmentStrings
2764 (wpath_val
, &wapath_val
[2], EXPAND_BUFFER_SIZE
- 2);
2766 if (!res
) wapath_val
[0] = _T('\0');
2768 apath_val
= (char *) alloca (EXPAND_BUFFER_SIZE
);
2770 WS2SC (apath_val
, wapath_val
, EXPAND_BUFFER_SIZE
);
2771 return __gnat_locate_exec (exec_name
, apath_val
);
2774 char *path_val
= getenv ("PATH");
2776 if (path_val
== NULL
) return NULL
;
2777 apath_val
= (char *) alloca (strlen (path_val
) + 1);
2778 strcpy (apath_val
, path_val
);
2779 return __gnat_locate_exec (exec_name
, apath_val
);
2783 /* Dummy functions for Osint import for non-VMS systems.
2784 ??? To be removed. */
2787 __gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED
,
2788 int onlydirs ATTRIBUTE_UNUSED
)
2794 __gnat_to_canonical_file_list_next (void)
2796 static char empty
[] = "";
2801 __gnat_to_canonical_file_list_free (void)
2806 __gnat_to_canonical_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2812 __gnat_to_canonical_file_spec (char *filespec
)
2818 __gnat_to_canonical_path_spec (char *pathspec
)
2824 __gnat_to_host_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2830 __gnat_to_host_file_spec (char *filespec
)
2836 __gnat_adjust_os_resource_limits (void)
2840 #if defined (__mips_vxworks)
2844 CACHE_USER_FLUSH (0, ENTIRE_CACHE
);
2848 #if defined (_WIN32)
2849 int __gnat_argument_needs_quote
= 1;
2851 int __gnat_argument_needs_quote
= 0;
2854 /* This option is used to enable/disable object files handling from the
2855 binder file by the GNAT Project module. For example, this is disabled on
2856 Windows (prior to GCC 3.4) as it is already done by the mdll module.
2857 Stating with GCC 3.4 the shared libraries are not based on mdll
2858 anymore as it uses the GCC's -shared option */
2859 #if defined (_WIN32) \
2860 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
2861 int __gnat_prj_add_obj_files
= 0;
2863 int __gnat_prj_add_obj_files
= 1;
2866 /* char used as prefix/suffix for environment variables */
2867 #if defined (_WIN32)
2868 char __gnat_environment_char
= '%';
2870 char __gnat_environment_char
= '$';
2873 /* This functions copy the file attributes from a source file to a
2876 mode = 0 : In this mode copy only the file time stamps (last access and
2877 last modification time stamps).
2879 mode = 1 : In this mode, time stamps and read/write/execute attributes are
2882 Returns 0 if operation was successful and -1 in case of error. */
2885 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED
, char *to ATTRIBUTE_UNUSED
,
2886 int mode ATTRIBUTE_UNUSED
)
2888 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2891 #elif defined (_WIN32)
2892 TCHAR wfrom
[GNAT_MAX_PATH_LEN
+ 2];
2893 TCHAR wto
[GNAT_MAX_PATH_LEN
+ 2];
2895 FILETIME fct
, flat
, flwt
;
2898 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
+ 2);
2899 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
+ 2);
2901 /* retrieve from times */
2904 (wfrom
, GENERIC_READ
, 0, NULL
, OPEN_EXISTING
, FILE_ATTRIBUTE_NORMAL
, NULL
);
2906 if (hfrom
== INVALID_HANDLE_VALUE
)
2909 res
= GetFileTime (hfrom
, &fct
, &flat
, &flwt
);
2911 CloseHandle (hfrom
);
2916 /* retrieve from times */
2919 (wto
, GENERIC_WRITE
, 0, NULL
, OPEN_EXISTING
, FILE_ATTRIBUTE_NORMAL
, NULL
);
2921 if (hto
== INVALID_HANDLE_VALUE
)
2924 res
= SetFileTime (hto
, NULL
, &flat
, &flwt
);
2931 /* Set file attributes in full mode. */
2935 DWORD attribs
= GetFileAttributes (wfrom
);
2937 if (attribs
== INVALID_FILE_ATTRIBUTES
)
2940 res
= SetFileAttributes (wto
, attribs
);
2948 GNAT_STRUCT_STAT fbuf
;
2949 struct utimbuf tbuf
;
2951 if (GNAT_STAT (from
, &fbuf
) == -1)
2956 tbuf
.actime
= fbuf
.st_atime
;
2957 tbuf
.modtime
= fbuf
.st_mtime
;
2959 if (utime (to
, &tbuf
) == -1)
2966 if (chmod (to
, fbuf
.st_mode
) == -1)
2977 __gnat_lseek (int fd
, long offset
, int whence
)
2979 return (int) lseek (fd
, offset
, whence
);
2982 /* This function returns the major version number of GCC being used. */
2984 get_gcc_version (void)
2989 return (int) (version_string
[0] - '0');
2994 * Set Close_On_Exec as indicated.
2995 * Note: this is used for both GNAT.OS_Lib and GNAT.Sockets.
2999 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED
,
3000 int close_on_exec_p ATTRIBUTE_UNUSED
)
3002 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
3003 int flags
= fcntl (fd
, F_GETFD
, 0);
3006 if (close_on_exec_p
)
3007 flags
|= FD_CLOEXEC
;
3009 flags
&= ~FD_CLOEXEC
;
3010 return fcntl (fd
, F_SETFD
, flags
);
3011 #elif defined(_WIN32)
3012 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
3013 if (h
== (HANDLE
) -1)
3015 if (close_on_exec_p
)
3016 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
, 0);
3017 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
,
3018 HANDLE_FLAG_INHERIT
);
3020 /* TODO: Unimplemented. */
3025 /* Indicates if platforms supports automatic initialization through the
3026 constructor mechanism */
3028 __gnat_binder_supports_auto_init (void)
3033 /* Indicates that Stand-Alone Libraries are automatically initialized through
3034 the constructor mechanism */
3036 __gnat_sals_init_using_constructors (void)
3038 #if defined (__vxworks) || defined (__Lynx__)
3045 #if defined (__ANDROID__)
3047 #include <pthread.h>
3050 __gnat_lwp_self (void)
3052 return (void *) pthread_self ();
3055 #elif defined (linux)
3056 /* There is no function in the glibc to retrieve the LWP of the current
3057 thread. We need to do a system call in order to retrieve this
3059 #include <sys/syscall.h>
3061 __gnat_lwp_self (void)
3063 return (void *) syscall (__NR_gettid
);
3068 /* glibc versions earlier than 2.7 do not define the routines to handle
3069 dynamically allocated CPU sets. For these targets, we use the static
3074 /* Dynamic cpu sets */
3077 __gnat_cpu_alloc (size_t count
)
3079 return CPU_ALLOC (count
);
3083 __gnat_cpu_alloc_size (size_t count
)
3085 return CPU_ALLOC_SIZE (count
);
3089 __gnat_cpu_free (cpu_set_t
*set
)
3095 __gnat_cpu_zero (size_t count
, cpu_set_t
*set
)
3097 CPU_ZERO_S (count
, set
);
3101 __gnat_cpu_set (int cpu
, size_t count
, cpu_set_t
*set
)
3103 /* Ada handles CPU numbers starting from 1, while C identifies the first
3104 CPU by a 0, so we need to adjust. */
3105 CPU_SET_S (cpu
- 1, count
, set
);
3108 #else /* !CPU_ALLOC */
3110 /* Static cpu sets */
3113 __gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED
)
3115 return (cpu_set_t
*) xmalloc (sizeof (cpu_set_t
));
3119 __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED
)
3121 return sizeof (cpu_set_t
);
3125 __gnat_cpu_free (cpu_set_t
*set
)
3131 __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3137 __gnat_cpu_set (int cpu
, size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3139 /* Ada handles CPU numbers starting from 1, while C identifies the first
3140 CPU by a 0, so we need to adjust. */
3141 CPU_SET (cpu
- 1, set
);
3143 #endif /* !CPU_ALLOC */
3146 /* Return the load address of the executable, or 0 if not known. In the
3147 specific case of error, (void *)-1 can be returned. Beware: this unit may
3148 be in a shared library. As low-level units are needed, we allow #include
3151 #if defined (__APPLE__)
3152 #include <mach-o/dyld.h>
3153 #elif 0 && defined (__linux__)
3158 __gnat_get_executable_load_address (void)
3160 #if defined (__APPLE__)
3161 return _dyld_get_image_header (0);
3163 #elif 0 && defined (__linux__)
3164 /* Currently disabled as it needs at least -ldl. */
3165 struct link_map
*map
= _r_debug
.r_map
;
3167 return (const void *)map
->l_addr
;