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__) || defined(__DragonFly__)
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 || defined (__DragonFly__)
987 return mkstemp (path
);
988 #elif defined (__Lynx__)
991 if (mktemp (path
) == NULL
)
998 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
999 return fd
< 0 ? -1 : fd
;
1003 __gnat_open (char *path
, int fmode
)
1007 #if defined (__MINGW32__)
1009 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1011 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1012 fd
= _topen (wpath
, fmode
, PERM
);
1015 fd
= GNAT_OPEN (path
, fmode
, PERM
);
1018 return fd
< 0 ? -1 : fd
;
1021 /****************************************************************
1022 ** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information
1023 ** as possible from it, storing the result in a cache for later reuse
1024 ****************************************************************/
1027 __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
)
1029 GNAT_STRUCT_STAT statbuf
;
1033 /* GNAT_FSTAT returns -1 and sets errno for failure */
1034 ret
= GNAT_FSTAT (fd
, &statbuf
);
1035 error
= ret
? errno
: 0;
1038 /* __gnat_stat returns errno value directly */
1039 error
= __gnat_stat (name
, &statbuf
);
1040 ret
= error
? -1 : 0;
1044 * A missing file is reported as an attr structure with error == 0 and
1048 if (error
== 0 || error
== ENOENT
)
1051 attr
->error
= error
;
1053 attr
->regular
= (!ret
&& S_ISREG (statbuf
.st_mode
));
1054 attr
->directory
= (!ret
&& S_ISDIR (statbuf
.st_mode
));
1057 attr
->file_length
= 0;
1059 /* st_size may be 32 bits, or 64 bits which is converted to long. We
1060 don't return a useful value for files larger than 2 gigabytes in
1062 attr
->file_length
= statbuf
.st_size
; /* all systems */
1064 attr
->exists
= !ret
;
1066 #if !defined (_WIN32)
1067 /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
1068 attr
->readable
= (!ret
&& (statbuf
.st_mode
& S_IRUSR
));
1069 attr
->writable
= (!ret
&& (statbuf
.st_mode
& S_IWUSR
));
1070 attr
->executable
= (!ret
&& (statbuf
.st_mode
& S_IXUSR
));
1074 attr
->timestamp
= (OS_Time
)-1;
1076 attr
->timestamp
= (OS_Time
)statbuf
.st_mtime
;
1080 /****************************************************************
1081 ** Return the number of bytes in the specified file
1082 ****************************************************************/
1085 __gnat_file_length_attr (int fd
, char* name
, struct file_attributes
* attr
)
1087 if (attr
->file_length
== -1) {
1088 __gnat_stat_to_attr (fd
, name
, attr
);
1091 return attr
->file_length
;
1095 __gnat_file_length (int fd
)
1097 struct file_attributes attr
;
1098 __gnat_reset_attributes (&attr
);
1099 return __gnat_file_length_attr (fd
, NULL
, &attr
);
1103 __gnat_file_length_long (int fd
)
1105 struct file_attributes attr
;
1106 __gnat_reset_attributes (&attr
);
1107 return (long)__gnat_file_length_attr (fd
, NULL
, &attr
);
1111 __gnat_named_file_length (char *name
)
1113 struct file_attributes attr
;
1114 __gnat_reset_attributes (&attr
);
1115 return __gnat_file_length_attr (-1, name
, &attr
);
1118 /* Create a temporary filename and put it in string pointed to by
1122 __gnat_tmp_name (char *tmp_filename
)
1124 #if defined (__MINGW32__)
1129 /* tempnam tries to create a temporary file in directory pointed to by
1130 TMP environment variable, in c:\temp if TMP is not set, and in
1131 directory specified by P_tmpdir in stdio.h if c:\temp does not
1132 exist. The filename will be created with the prefix "gnat-". */
1134 sprintf (prefix
, "gnat-%d-", (int)getpid());
1135 pname
= (char *) _tempnam ("c:\\temp", prefix
);
1137 /* if pname is NULL, the file was not created properly, the disk is full
1138 or there is no more free temporary files */
1141 *tmp_filename
= '\0';
1143 /* If pname start with a back slash and not path information it means that
1144 the filename is valid for the current working directory. */
1146 else if (pname
[0] == '\\')
1148 strcpy (tmp_filename
, ".\\");
1149 strcat (tmp_filename
, pname
+1);
1152 strcpy (tmp_filename
, pname
);
1157 #elif defined (__linux__) || defined (__FreeBSD__) || defined (__NetBSD__) \
1158 || defined (__OpenBSD__) || defined (__GLIBC__) || defined (__ANDROID__) \
1159 || defined (__DragonFly__)
1160 #define MAX_SAFE_PATH 1000
1161 char *tmpdir
= getenv ("TMPDIR");
1163 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1164 a buffer overflow. */
1165 if (tmpdir
== NULL
|| strlen (tmpdir
) > MAX_SAFE_PATH
)
1167 strcpy (tmp_filename
, "/cache/gnat-XXXXXX");
1169 strcpy (tmp_filename
, "/tmp/gnat-XXXXXX");
1172 sprintf (tmp_filename
, "%s/gnat-XXXXXX", tmpdir
);
1174 close (mkstemp(tmp_filename
));
1175 #elif defined (__vxworks) && !defined (VTHREADS)
1179 static ushort_t seed
= 0; /* used to generate unique name */
1181 /* Generate a unique name. */
1182 strcpy (tmp_filename
, "tmp");
1185 savepos
= pos
= tmp_filename
+ strlen (tmp_filename
) + index
;
1193 /* Fill up the name buffer from the last position. */
1195 for (t
= seed
; 0 <= --index
; t
>>= 3)
1196 *--pos
= '0' + (t
& 07);
1198 /* Check to see if its unique, if not bump the seed and try again. */
1199 f
= fopen (tmp_filename
, "r");
1207 tmpnam (tmp_filename
);
1211 /* Open directory and returns a DIR pointer. */
1213 DIR* __gnat_opendir (char *name
)
1215 #if defined (__MINGW32__)
1216 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1218 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1219 return (DIR*)_topendir (wname
);
1222 return opendir (name
);
1226 /* Read the next entry in a directory. The returned string points somewhere
1229 #if defined (__sun__)
1230 /* For Solaris, be sure to use the 64-bit version, otherwise NFS reads may
1231 fail with EOVERFLOW if the server uses 64-bit cookies. */
1232 #define dirent dirent64
1233 #define readdir readdir64
1237 __gnat_readdir (DIR *dirp
, char *buffer
, int *len
)
1239 #if defined (__MINGW32__)
1240 struct _tdirent
*dirent
= _treaddir ((_TDIR
*)dirp
);
1244 WS2SC (buffer
, dirent
->d_name
, GNAT_MAX_PATH_LEN
);
1245 *len
= strlen (buffer
);
1252 #elif defined (HAVE_READDIR_R)
1253 /* If possible, try to use the thread-safe version. */
1254 if (readdir_r (dirp
, buffer
) != NULL
)
1256 *len
= strlen (((struct dirent
*) buffer
)->d_name
);
1257 return ((struct dirent
*) buffer
)->d_name
;
1263 struct dirent
*dirent
= (struct dirent
*) readdir (dirp
);
1267 strcpy (buffer
, dirent
->d_name
);
1268 *len
= strlen (buffer
);
1277 /* Close a directory entry. */
1279 int __gnat_closedir (DIR *dirp
)
1281 #if defined (__MINGW32__)
1282 return _tclosedir ((_TDIR
*)dirp
);
1285 return closedir (dirp
);
1289 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1292 __gnat_readdir_is_thread_safe (void)
1294 #ifdef HAVE_READDIR_R
1301 #if defined (_WIN32)
1302 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1303 static const unsigned long long w32_epoch_offset
= 11644473600ULL;
1305 /* Returns the file modification timestamp using Win32 routines which are
1306 immune against daylight saving time change. It is in fact not possible to
1307 use fstat for this purpose as the DST modify the st_mtime field of the
1311 win32_filetime (HANDLE h
)
1316 unsigned long long ull_time
;
1319 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1320 since <Jan 1st 1601>. This function must return the number of seconds
1321 since <Jan 1st 1970>. */
1323 if (GetFileTime (h
, NULL
, NULL
, &t_write
.ft_time
))
1324 return (time_t) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1328 /* As above but starting from a FILETIME. */
1330 f2t (const FILETIME
*ft
, __time64_t
*t
)
1335 unsigned long long ull_time
;
1338 t_write
.ft_time
= *ft
;
1339 *t
= (__time64_t
) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1343 /* Return a GNAT time stamp given a file name. */
1346 __gnat_file_time_name_attr (char* name
, struct file_attributes
* attr
)
1348 if (attr
->timestamp
== (OS_Time
)-2) {
1349 #if defined (_WIN32)
1351 WIN32_FILE_ATTRIBUTE_DATA fad
;
1352 __time64_t ret
= -1;
1353 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1354 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1356 if ((res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
)))
1357 f2t (&fad
.ftLastWriteTime
, &ret
);
1358 attr
->timestamp
= (OS_Time
) ret
;
1360 __gnat_stat_to_attr (-1, name
, attr
);
1363 return attr
->timestamp
;
1367 __gnat_file_time_name (char *name
)
1369 struct file_attributes attr
;
1370 __gnat_reset_attributes (&attr
);
1371 return __gnat_file_time_name_attr (name
, &attr
);
1374 /* Return a GNAT time stamp given a file descriptor. */
1377 __gnat_file_time_fd_attr (int fd
, struct file_attributes
* attr
)
1379 if (attr
->timestamp
== (OS_Time
)-2) {
1380 #if defined (_WIN32)
1381 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
1382 time_t ret
= win32_filetime (h
);
1383 attr
->timestamp
= (OS_Time
) ret
;
1386 __gnat_stat_to_attr (fd
, NULL
, attr
);
1390 return attr
->timestamp
;
1394 __gnat_file_time_fd (int fd
)
1396 struct file_attributes attr
;
1397 __gnat_reset_attributes (&attr
);
1398 return __gnat_file_time_fd_attr (fd
, &attr
);
1401 /* Set the file time stamp. */
1404 __gnat_set_file_time_name (char *name
, time_t time_stamp
)
1406 #if defined (__vxworks)
1408 /* Code to implement __gnat_set_file_time_name for these systems. */
1410 #elif defined (_WIN32)
1414 unsigned long long ull_time
;
1416 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1418 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1420 HANDLE h
= CreateFile
1421 (wname
, GENERIC_WRITE
, FILE_SHARE_WRITE
, NULL
,
1422 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
,
1424 if (h
== INVALID_HANDLE_VALUE
)
1426 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1427 t_write
.ull_time
= ((unsigned long long)time_stamp
+ w32_epoch_offset
);
1428 /* Convert to 100 nanosecond units */
1429 t_write
.ull_time
*= 10000000ULL;
1431 SetFileTime(h
, NULL
, NULL
, &t_write
.ft_time
);
1436 struct utimbuf utimbuf
;
1439 /* Set modification time to requested time. */
1440 utimbuf
.modtime
= time_stamp
;
1442 /* Set access time to now in local time. */
1443 t
= time ((time_t) 0);
1444 utimbuf
.actime
= mktime (localtime (&t
));
1446 utime (name
, &utimbuf
);
1450 /* Get the list of installed standard libraries from the
1451 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1455 __gnat_get_libraries_from_registry (void)
1457 char *result
= (char *) xmalloc (1);
1461 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
1464 DWORD name_size
, value_size
;
1471 /* First open the key. */
1472 res
= RegOpenKeyExA (HKEY_LOCAL_MACHINE
, "SOFTWARE", 0, KEY_READ
, ®_key
);
1474 if (res
== ERROR_SUCCESS
)
1475 res
= RegOpenKeyExA (reg_key
, "Ada Core Technologies", 0,
1476 KEY_READ
, ®_key
);
1478 if (res
== ERROR_SUCCESS
)
1479 res
= RegOpenKeyExA (reg_key
, "GNAT", 0, KEY_READ
, ®_key
);
1481 if (res
== ERROR_SUCCESS
)
1482 res
= RegOpenKeyExA (reg_key
, "Standard Libraries", 0, KEY_READ
, ®_key
);
1484 /* If the key exists, read out all the values in it and concatenate them
1486 for (index
= 0; res
== ERROR_SUCCESS
; index
++)
1488 value_size
= name_size
= 256;
1489 res
= RegEnumValueA (reg_key
, index
, name
, &name_size
, 0,
1490 &type
, (LPBYTE
)value
, &value_size
);
1492 if (res
== ERROR_SUCCESS
&& type
== REG_SZ
)
1494 char *old_result
= result
;
1496 result
= (char *) xmalloc (strlen (old_result
) + value_size
+ 2);
1497 strcpy (result
, old_result
);
1498 strcat (result
, value
);
1499 strcat (result
, ";");
1504 /* Remove the trailing ";". */
1506 result
[strlen (result
) - 1] = 0;
1512 /* Query information for the given file NAME and return it in STATBUF.
1513 * Returns 0 for success, or errno value for failure.
1516 __gnat_stat (char *name
, GNAT_STRUCT_STAT
*statbuf
)
1519 WIN32_FILE_ATTRIBUTE_DATA fad
;
1520 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1525 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1526 name_len
= _tcslen (wname
);
1528 if (name_len
> GNAT_MAX_PATH_LEN
)
1531 ZeroMemory (statbuf
, sizeof(GNAT_STRUCT_STAT
));
1533 res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
);
1536 error
= GetLastError();
1538 /* Check file existence using GetFileAttributes() which does not fail on
1539 special Windows files like con:, aux:, nul: etc... */
1541 if (GetFileAttributes(wname
) != INVALID_FILE_ATTRIBUTES
) {
1542 /* Just pretend that it is a regular and readable file */
1543 statbuf
->st_mode
= S_IFREG
| S_IREAD
| S_IWRITE
;
1548 case ERROR_ACCESS_DENIED
:
1549 case ERROR_SHARING_VIOLATION
:
1550 case ERROR_LOCK_VIOLATION
:
1551 case ERROR_SHARING_BUFFER_EXCEEDED
:
1553 case ERROR_BUFFER_OVERFLOW
:
1554 return ENAMETOOLONG
;
1555 case ERROR_NOT_ENOUGH_MEMORY
:
1562 f2t (&fad
.ftCreationTime
, &statbuf
->st_ctime
);
1563 f2t (&fad
.ftLastWriteTime
, &statbuf
->st_mtime
);
1564 f2t (&fad
.ftLastAccessTime
, &statbuf
->st_atime
);
1567 (__int64
)fad
.nFileSizeLow
| (__int64
)fad
.nFileSizeHigh
<< 32;
1569 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1570 statbuf
->st_mode
= S_IREAD
;
1572 if (fad
.dwFileAttributes
& FILE_ATTRIBUTE_DIRECTORY
)
1573 statbuf
->st_mode
|= S_IFDIR
;
1575 statbuf
->st_mode
|= S_IFREG
;
1577 if (!(fad
.dwFileAttributes
& FILE_ATTRIBUTE_READONLY
))
1578 statbuf
->st_mode
|= S_IWRITE
;
1583 return GNAT_STAT (name
, statbuf
) == 0 ? 0 : errno
;
1587 /*************************************************************************
1588 ** Check whether a file exists
1589 *************************************************************************/
1592 __gnat_file_exists_attr (char* name
, struct file_attributes
* attr
)
1594 if (attr
->exists
== ATTR_UNSET
)
1595 __gnat_stat_to_attr (-1, name
, attr
);
1597 return attr
->exists
;
1601 __gnat_file_exists (char *name
)
1603 struct file_attributes attr
;
1604 __gnat_reset_attributes (&attr
);
1605 return __gnat_file_exists_attr (name
, &attr
);
1608 /**********************************************************************
1609 ** Whether name is an absolute path
1610 **********************************************************************/
1613 __gnat_is_absolute_path (char *name
, int length
)
1616 /* On VxWorks systems, an absolute path can be represented (depending on
1617 the host platform) as either /dir/file, or device:/dir/file, or
1618 device:drive_letter:/dir/file. */
1625 for (index
= 0; index
< length
; index
++)
1627 if (name
[index
] == ':' &&
1628 ((name
[index
+ 1] == '/') ||
1629 (isalpha (name
[index
+ 1]) && index
+ 2 <= length
&&
1630 name
[index
+ 2] == '/')))
1633 else if (name
[index
] == '/')
1638 return (length
!= 0) &&
1639 (*name
== '/' || *name
== DIR_SEPARATOR
1641 || (length
> 1 && ISALPHA (name
[0]) && name
[1] == ':')
1648 __gnat_is_regular_file_attr (char* name
, struct file_attributes
* attr
)
1650 if (attr
->regular
== ATTR_UNSET
)
1651 __gnat_stat_to_attr (-1, name
, attr
);
1653 return attr
->regular
;
1657 __gnat_is_regular_file (char *name
)
1659 struct file_attributes attr
;
1661 __gnat_reset_attributes (&attr
);
1662 return __gnat_is_regular_file_attr (name
, &attr
);
1666 __gnat_is_regular_file_fd (int fd
)
1669 GNAT_STRUCT_STAT statbuf
;
1671 ret
= GNAT_FSTAT (fd
, &statbuf
);
1672 return (!ret
&& S_ISREG (statbuf
.st_mode
));
1676 __gnat_is_directory_attr (char* name
, struct file_attributes
* attr
)
1678 if (attr
->directory
== ATTR_UNSET
)
1679 __gnat_stat_to_attr (-1, name
, attr
);
1681 return attr
->directory
;
1685 __gnat_is_directory (char *name
)
1687 struct file_attributes attr
;
1689 __gnat_reset_attributes (&attr
);
1690 return __gnat_is_directory_attr (name
, &attr
);
1693 #if defined (_WIN32)
1695 /* Returns the same constant as GetDriveType but takes a pathname as
1699 GetDriveTypeFromPath (TCHAR
*wfullpath
)
1701 TCHAR wdrv
[MAX_PATH
];
1702 TCHAR wpath
[MAX_PATH
];
1703 TCHAR wfilename
[MAX_PATH
];
1704 TCHAR wext
[MAX_PATH
];
1706 _tsplitpath (wfullpath
, wdrv
, wpath
, wfilename
, wext
);
1708 if (_tcslen (wdrv
) != 0)
1710 /* we have a drive specified. */
1711 _tcscat (wdrv
, _T("\\"));
1712 return GetDriveType (wdrv
);
1716 /* No drive specified. */
1718 /* Is this a relative path, if so get current drive type. */
1719 if (wpath
[0] != _T('\\') ||
1720 (_tcslen (wpath
) > 2 && wpath
[0] == _T('\\')
1721 && wpath
[1] != _T('\\')))
1722 return GetDriveType (NULL
);
1724 UINT result
= GetDriveType (wpath
);
1726 /* Cannot guess the drive type, is this \\.\ ? */
1728 if (result
== DRIVE_NO_ROOT_DIR
&&
1729 _tcslen (wpath
) >= 4 && wpath
[0] == _T('\\') && wpath
[1] == _T('\\')
1730 && wpath
[2] == _T('.') && wpath
[3] == _T('\\'))
1732 if (_tcslen (wpath
) == 4)
1733 _tcscat (wpath
, wfilename
);
1735 LPTSTR p
= &wpath
[4];
1736 LPTSTR b
= _tcschr (p
, _T('\\'));
1740 /* logical drive \\.\c\dir\file */
1746 _tcscat (p
, _T(":\\"));
1748 return GetDriveType (p
);
1755 /* This MingW section contains code to work with ACL. */
1757 __gnat_check_OWNER_ACL (TCHAR
*wname
,
1758 DWORD CheckAccessDesired
,
1759 GENERIC_MAPPING CheckGenericMapping
)
1761 DWORD dwAccessDesired
, dwAccessAllowed
;
1762 PRIVILEGE_SET PrivilegeSet
;
1763 DWORD dwPrivSetSize
= sizeof (PRIVILEGE_SET
);
1764 BOOL fAccessGranted
= FALSE
;
1765 HANDLE hToken
= NULL
;
1767 PSECURITY_DESCRIPTOR pSD
= NULL
;
1770 (wname
, OWNER_SECURITY_INFORMATION
|
1771 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1774 if ((pSD
= (SECURITY_DESCRIPTOR
*) HeapAlloc
1775 (GetProcessHeap (), HEAP_ZERO_MEMORY
, nLength
)) == NULL
)
1778 /* Obtain the security descriptor. */
1780 if (!GetFileSecurity
1781 (wname
, OWNER_SECURITY_INFORMATION
|
1782 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1783 pSD
, nLength
, &nLength
))
1786 if (!ImpersonateSelf (SecurityImpersonation
))
1789 if (!OpenThreadToken
1790 (GetCurrentThread(), TOKEN_DUPLICATE
| TOKEN_QUERY
, FALSE
, &hToken
))
1793 /* Undoes the effect of ImpersonateSelf. */
1797 /* We want to test for write permissions. */
1799 dwAccessDesired
= CheckAccessDesired
;
1801 MapGenericMask (&dwAccessDesired
, &CheckGenericMapping
);
1804 (pSD
, /* security descriptor to check */
1805 hToken
, /* impersonation token */
1806 dwAccessDesired
, /* requested access rights */
1807 &CheckGenericMapping
, /* pointer to GENERIC_MAPPING */
1808 &PrivilegeSet
, /* receives privileges used in check */
1809 &dwPrivSetSize
, /* size of PrivilegeSet buffer */
1810 &dwAccessAllowed
, /* receives mask of allowed access rights */
1814 CloseHandle (hToken
);
1815 HeapFree (GetProcessHeap (), 0, pSD
);
1816 return fAccessGranted
;
1820 CloseHandle (hToken
);
1821 HeapFree (GetProcessHeap (), 0, pSD
);
1826 __gnat_set_OWNER_ACL (TCHAR
*wname
,
1827 ACCESS_MODE AccessMode
,
1828 DWORD AccessPermissions
)
1830 PACL pOldDACL
= NULL
;
1831 PACL pNewDACL
= NULL
;
1832 PSECURITY_DESCRIPTOR pSD
= NULL
;
1834 TCHAR username
[100];
1837 /* Get current user, he will act as the owner */
1839 if (!GetUserName (username
, &unsize
))
1842 if (GetNamedSecurityInfo
1845 DACL_SECURITY_INFORMATION
,
1846 NULL
, NULL
, &pOldDACL
, NULL
, &pSD
) != ERROR_SUCCESS
)
1849 BuildExplicitAccessWithName
1850 (&ea
, username
, AccessPermissions
, (ACCESS_MODE
) AccessMode
, NO_INHERITANCE
);
1852 if (AccessMode
== SET_ACCESS
)
1854 /* SET_ACCESS, we want to set an explicte set of permissions, do not
1855 merge with current DACL. */
1856 if (SetEntriesInAcl (1, &ea
, NULL
, &pNewDACL
) != ERROR_SUCCESS
)
1860 if (SetEntriesInAcl (1, &ea
, pOldDACL
, &pNewDACL
) != ERROR_SUCCESS
)
1863 if (SetNamedSecurityInfo
1864 (wname
, SE_FILE_OBJECT
,
1865 DACL_SECURITY_INFORMATION
, NULL
, NULL
, pNewDACL
, NULL
) != ERROR_SUCCESS
)
1869 LocalFree (pNewDACL
);
1872 /* Check if it is possible to use ACL for wname, the file must not be on a
1876 __gnat_can_use_acl (TCHAR
*wname
)
1878 return __gnat_use_acl
&& GetDriveTypeFromPath (wname
) != DRIVE_REMOTE
;
1881 #endif /* defined (_WIN32) */
1884 __gnat_is_readable_file_attr (char* name
, struct file_attributes
* attr
)
1886 if (attr
->readable
== ATTR_UNSET
)
1888 #if defined (_WIN32)
1889 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1890 GENERIC_MAPPING GenericMapping
;
1892 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1894 if (__gnat_can_use_acl (wname
))
1896 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1897 GenericMapping
.GenericRead
= GENERIC_READ
;
1899 __gnat_check_OWNER_ACL (wname
, FILE_READ_DATA
, GenericMapping
);
1902 attr
->readable
= GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
;
1904 __gnat_stat_to_attr (-1, name
, attr
);
1908 return attr
->readable
;
1912 __gnat_is_readable_file (char *name
)
1914 struct file_attributes attr
;
1916 __gnat_reset_attributes (&attr
);
1917 return __gnat_is_readable_file_attr (name
, &attr
);
1921 __gnat_is_writable_file_attr (char* name
, struct file_attributes
* attr
)
1923 if (attr
->writable
== ATTR_UNSET
)
1925 #if defined (_WIN32)
1926 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1927 GENERIC_MAPPING GenericMapping
;
1929 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1931 if (__gnat_can_use_acl (wname
))
1933 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1934 GenericMapping
.GenericWrite
= GENERIC_WRITE
;
1936 attr
->writable
= __gnat_check_OWNER_ACL
1937 (wname
, FILE_WRITE_DATA
| FILE_APPEND_DATA
, GenericMapping
)
1938 && !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
1942 !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
1945 __gnat_stat_to_attr (-1, name
, attr
);
1949 return attr
->writable
;
1953 __gnat_is_writable_file (char *name
)
1955 struct file_attributes attr
;
1957 __gnat_reset_attributes (&attr
);
1958 return __gnat_is_writable_file_attr (name
, &attr
);
1962 __gnat_is_executable_file_attr (char* name
, struct file_attributes
* attr
)
1964 if (attr
->executable
== ATTR_UNSET
)
1966 #if defined (_WIN32)
1967 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1968 GENERIC_MAPPING GenericMapping
;
1970 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1972 if (__gnat_can_use_acl (wname
))
1974 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1975 GenericMapping
.GenericExecute
= GENERIC_EXECUTE
;
1978 __gnat_check_OWNER_ACL (wname
, FILE_EXECUTE
, GenericMapping
);
1982 TCHAR
*l
, *last
= _tcsstr(wname
, _T(".exe"));
1984 /* look for last .exe */
1986 while ((l
= _tcsstr(last
+1, _T(".exe"))))
1990 GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
1991 && (last
- wname
) == (int) (_tcslen (wname
) - 4);
1994 __gnat_stat_to_attr (-1, name
, attr
);
1998 return attr
->regular
&& attr
->executable
;
2002 __gnat_is_executable_file (char *name
)
2004 struct file_attributes attr
;
2006 __gnat_reset_attributes (&attr
);
2007 return __gnat_is_executable_file_attr (name
, &attr
);
2011 __gnat_set_writable (char *name
)
2013 #if defined (_WIN32)
2014 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2016 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2018 if (__gnat_can_use_acl (wname
))
2019 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_WRITE
);
2022 (wname
, GetFileAttributes (wname
) & ~FILE_ATTRIBUTE_READONLY
);
2023 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2024 GNAT_STRUCT_STAT statbuf
;
2026 if (GNAT_STAT (name
, &statbuf
) == 0)
2028 statbuf
.st_mode
= statbuf
.st_mode
| S_IWUSR
;
2029 chmod (name
, statbuf
.st_mode
);
2034 /* must match definition in s-os_lib.ads */
2040 __gnat_set_executable (char *name
, int mode ATTRIBUTE_UNUSED
)
2042 #if defined (_WIN32)
2043 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2045 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2047 if (__gnat_can_use_acl (wname
))
2048 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_EXECUTE
);
2050 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2051 GNAT_STRUCT_STAT statbuf
;
2053 if (GNAT_STAT (name
, &statbuf
) == 0)
2056 statbuf
.st_mode
= statbuf
.st_mode
| S_IXUSR
;
2058 statbuf
.st_mode
= statbuf
.st_mode
| S_IXGRP
;
2059 if (mode
& S_OTHERS
)
2060 statbuf
.st_mode
= statbuf
.st_mode
| S_IXOTH
;
2061 chmod (name
, statbuf
.st_mode
);
2067 __gnat_set_non_writable (char *name
)
2069 #if defined (_WIN32)
2070 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2072 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2074 if (__gnat_can_use_acl (wname
))
2075 __gnat_set_OWNER_ACL
2076 (wname
, DENY_ACCESS
,
2077 FILE_WRITE_DATA
| FILE_APPEND_DATA
|
2078 FILE_WRITE_EA
| FILE_WRITE_ATTRIBUTES
);
2081 (wname
, GetFileAttributes (wname
) | FILE_ATTRIBUTE_READONLY
);
2082 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2083 GNAT_STRUCT_STAT statbuf
;
2085 if (GNAT_STAT (name
, &statbuf
) == 0)
2087 statbuf
.st_mode
= statbuf
.st_mode
& 07577;
2088 chmod (name
, statbuf
.st_mode
);
2094 __gnat_set_readable (char *name
)
2096 #if defined (_WIN32)
2097 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2099 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2101 if (__gnat_can_use_acl (wname
))
2102 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_READ
);
2104 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2105 GNAT_STRUCT_STAT statbuf
;
2107 if (GNAT_STAT (name
, &statbuf
) == 0)
2109 chmod (name
, statbuf
.st_mode
| S_IREAD
);
2115 __gnat_set_non_readable (char *name
)
2117 #if defined (_WIN32)
2118 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2120 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2122 if (__gnat_can_use_acl (wname
))
2123 __gnat_set_OWNER_ACL (wname
, DENY_ACCESS
, FILE_GENERIC_READ
);
2125 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2126 GNAT_STRUCT_STAT statbuf
;
2128 if (GNAT_STAT (name
, &statbuf
) == 0)
2130 chmod (name
, statbuf
.st_mode
& (~S_IREAD
));
2136 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED
,
2137 struct file_attributes
* attr
)
2139 if (attr
->symbolic_link
== ATTR_UNSET
)
2141 #if defined (__vxworks)
2142 attr
->symbolic_link
= 0;
2144 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2146 GNAT_STRUCT_STAT statbuf
;
2147 ret
= GNAT_LSTAT (name
, &statbuf
);
2148 attr
->symbolic_link
= (!ret
&& S_ISLNK (statbuf
.st_mode
));
2150 attr
->symbolic_link
= 0;
2153 return attr
->symbolic_link
;
2157 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED
)
2159 struct file_attributes attr
;
2161 __gnat_reset_attributes (&attr
);
2162 return __gnat_is_symbolic_link_attr (name
, &attr
);
2165 #if defined (__sun__)
2166 /* Using fork on Solaris will duplicate all the threads. fork1, which
2167 duplicates only the active thread, must be used instead, or spawning
2168 subprocess from a program with tasking will lead into numerous problems. */
2173 __gnat_portable_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2175 int status ATTRIBUTE_UNUSED
= 0;
2176 int finished ATTRIBUTE_UNUSED
;
2177 int pid ATTRIBUTE_UNUSED
;
2179 #if defined (__vxworks) || defined(__PikeOS__)
2182 #elif defined (_WIN32)
2183 /* args[0] must be quotes as it could contain a full pathname with spaces */
2184 char *args_0
= args
[0];
2185 args
[0] = (char *)xmalloc (strlen (args_0
) + 3);
2186 strcpy (args
[0], "\"");
2187 strcat (args
[0], args_0
);
2188 strcat (args
[0], "\"");
2190 status
= spawnvp (P_WAIT
, args_0
, (char ** const)args
);
2192 /* restore previous value */
2194 args
[0] = (char *)args_0
;
2210 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2215 finished
= waitpid (pid
, &status
, 0);
2217 if (finished
!= pid
|| WIFEXITED (status
) == 0)
2220 return WEXITSTATUS (status
);
2226 /* Create a copy of the given file descriptor.
2227 Return -1 if an error occurred. */
2230 __gnat_dup (int oldfd
)
2232 #if defined (__vxworks) && !defined (__RTP__)
2233 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2241 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2242 Return -1 if an error occurred. */
2245 __gnat_dup2 (int oldfd ATTRIBUTE_UNUSED
, int newfd ATTRIBUTE_UNUSED
)
2247 #if defined (__vxworks) && !defined (__RTP__)
2248 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2251 #elif defined (__PikeOS__)
2252 /* Not supported. */
2254 #elif defined (_WIN32)
2255 /* Special case when oldfd and newfd are identical and are the standard
2256 input, output or error as this makes Windows XP hangs. Note that we
2257 do that only for standard file descriptors that are known to be valid. */
2258 if (oldfd
== newfd
&& newfd
>= 0 && newfd
<= 2)
2261 return dup2 (oldfd
, newfd
);
2263 return dup2 (oldfd
, newfd
);
2268 __gnat_number_of_cpus (void)
2272 #if defined (__linux__) || defined (__sun__) || defined (_AIX) \
2273 || defined (__APPLE__) || defined (__FreeBSD__) || defined (__OpenBSD__) \
2274 || defined (__DragonFly__) || defined (__NetBSD__)
2275 cores
= (int) sysconf (_SC_NPROCESSORS_ONLN
);
2277 #elif defined (__hpux__)
2278 struct pst_dynamic psd
;
2279 if (pstat_getdynamic (&psd
, sizeof (psd
), 1, 0) != -1)
2280 cores
= (int) psd
.psd_proc_cnt
;
2282 #elif defined (_WIN32)
2283 SYSTEM_INFO sysinfo
;
2284 GetSystemInfo (&sysinfo
);
2285 cores
= (int) sysinfo
.dwNumberOfProcessors
;
2287 #elif defined (_WRS_CONFIG_SMP)
2288 unsigned int vxCpuConfiguredGet (void);
2290 cores
= vxCpuConfiguredGet ();
2297 /* WIN32 code to implement a wait call that wait for any child process. */
2299 #if defined (_WIN32)
2301 /* Synchronization code, to be thread safe. */
2305 /* For the Cert run times on native Windows we use dummy functions
2306 for locking and unlocking tasks since we do not support multiple
2307 threads on this configuration (Cert run time on native Windows). */
2309 static void EnterCS (void) {}
2310 static void LeaveCS (void) {}
2311 static void SignalListChanged (void) {}
2315 CRITICAL_SECTION ProcListCS
;
2316 HANDLE ProcListEvt
= NULL
;
2318 static void EnterCS (void)
2320 EnterCriticalSection(&ProcListCS
);
2323 static void LeaveCS (void)
2325 LeaveCriticalSection(&ProcListCS
);
2328 static void SignalListChanged (void)
2330 SetEvent (ProcListEvt
);
2335 static HANDLE
*HANDLES_LIST
= NULL
;
2336 static int *PID_LIST
= NULL
, plist_length
= 0, plist_max_length
= 0;
2339 add_handle (HANDLE h
, int pid
)
2341 /* -------------------- critical section -------------------- */
2344 if (plist_length
== plist_max_length
)
2346 plist_max_length
+= 100;
2348 (HANDLE
*) xrealloc (HANDLES_LIST
, sizeof (HANDLE
) * plist_max_length
);
2350 (int *) xrealloc (PID_LIST
, sizeof (int) * plist_max_length
);
2353 HANDLES_LIST
[plist_length
] = h
;
2354 PID_LIST
[plist_length
] = pid
;
2357 SignalListChanged();
2359 /* -------------------- critical section -------------------- */
2363 __gnat_win32_remove_handle (HANDLE h
, int pid
)
2368 /* -------------------- critical section -------------------- */
2371 for (j
= 0; j
< plist_length
; j
++)
2373 if ((HANDLES_LIST
[j
] == h
) || (PID_LIST
[j
] == pid
))
2377 HANDLES_LIST
[j
] = HANDLES_LIST
[plist_length
];
2378 PID_LIST
[j
] = PID_LIST
[plist_length
];
2385 /* -------------------- critical section -------------------- */
2388 SignalListChanged();
2394 win32_no_block_spawn (char *command
, char *args
[], HANDLE
*h
, int *pid
)
2398 PROCESS_INFORMATION PI
;
2399 SECURITY_ATTRIBUTES SA
;
2404 /* compute the total command line length */
2408 csize
+= strlen (args
[k
]) + 1;
2412 full_command
= (char *) xmalloc (csize
);
2415 SI
.cb
= sizeof (STARTUPINFO
);
2416 SI
.lpReserved
= NULL
;
2417 SI
.lpReserved2
= NULL
;
2418 SI
.lpDesktop
= NULL
;
2422 SI
.wShowWindow
= SW_HIDE
;
2424 /* Security attributes. */
2425 SA
.nLength
= sizeof (SECURITY_ATTRIBUTES
);
2426 SA
.bInheritHandle
= TRUE
;
2427 SA
.lpSecurityDescriptor
= NULL
;
2429 /* Prepare the command string. */
2430 strcpy (full_command
, command
);
2431 strcat (full_command
, " ");
2436 strcat (full_command
, args
[k
]);
2437 strcat (full_command
, " ");
2442 int wsize
= csize
* 2;
2443 TCHAR
*wcommand
= (TCHAR
*) xmalloc (wsize
);
2445 S2WSC (wcommand
, full_command
, wsize
);
2447 free (full_command
);
2449 result
= CreateProcess
2450 (NULL
, wcommand
, &SA
, NULL
, TRUE
,
2451 GetPriorityClass (GetCurrentProcess()), NULL
, NULL
, &SI
, &PI
);
2458 CloseHandle (PI
.hThread
);
2460 *pid
= PI
.dwProcessId
;
2470 win32_wait (int *status
)
2472 DWORD exitcode
, pid
;
2482 if (plist_length
== 0)
2488 /* -------------------- critical section -------------------- */
2491 hl_len
= plist_length
;
2494 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * hl_len
);
2495 memmove (hl
, HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2496 pidl
= (int *) xmalloc (sizeof (int) * hl_len
);
2497 memmove (pidl
, PID_LIST
, sizeof (int) * hl_len
);
2499 /* Note that index 0 contains the event handle that is signaled when the
2500 process list has changed */
2501 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * hl_len
+ 1);
2502 hl
[0] = ProcListEvt
;
2503 memmove (&hl
[1], HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2504 pidl
= (int *) xmalloc (sizeof (int) * hl_len
+ 1);
2505 memmove (&pidl
[1], PID_LIST
, sizeof (int) * hl_len
);
2510 /* -------------------- critical section -------------------- */
2512 res
= WaitForMultipleObjects (hl_len
, hl
, FALSE
, INFINITE
);
2514 /* if the ProcListEvt has been signaled then the list of processes has been
2515 updated to add or remove a handle, just loop over */
2517 if (res
- WAIT_OBJECT_0
== 0)
2524 h
= hl
[res
- WAIT_OBJECT_0
];
2525 GetExitCodeProcess (h
, &exitcode
);
2526 pid
= pidl
[res
- WAIT_OBJECT_0
];
2528 found
= __gnat_win32_remove_handle (h
, -1);
2533 /* if not found another process waiting has already handled this process */
2540 *status
= (int) exitcode
;
2547 __gnat_portable_no_block_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2550 #if defined (__vxworks) || defined (__PikeOS__)
2551 /* Not supported. */
2554 #elif defined (_WIN32)
2559 win32_no_block_spawn (args
[0], args
, &h
, &pid
);
2562 add_handle (h
, pid
);
2575 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2585 __gnat_portable_wait (int *process_status
)
2590 #if defined (__vxworks) || defined (__PikeOS__)
2591 /* Not sure what to do here, so do nothing but return zero. */
2593 #elif defined (_WIN32)
2595 pid
= win32_wait (&status
);
2599 pid
= waitpid (-1, &status
, 0);
2600 status
= status
& 0xffff;
2603 *process_status
= status
;
2608 __gnat_os_exit (int status
)
2613 /* Locate file on path, that matches a predicate */
2616 __gnat_locate_file_with_predicate (char *file_name
, char *path_val
,
2617 int (*predicate
)(char *))
2620 char *file_path
= (char *) alloca (strlen (file_name
) + 1);
2623 /* Return immediately if file_name is empty */
2625 if (*file_name
== '\0')
2628 /* Remove quotes around file_name if present */
2634 strcpy (file_path
, ptr
);
2636 ptr
= file_path
+ strlen (file_path
) - 1;
2641 /* Handle absolute pathnames. */
2643 absolute
= __gnat_is_absolute_path (file_path
, strlen (file_name
));
2647 if (predicate (file_path
))
2648 return xstrdup (file_path
);
2653 /* If file_name include directory separator(s), try it first as
2654 a path name relative to the current directory */
2655 for (ptr
= file_name
; *ptr
&& *ptr
!= '/' && *ptr
!= DIR_SEPARATOR
; ptr
++)
2660 if (predicate (file_name
))
2661 return xstrdup (file_name
);
2668 /* The result has to be smaller than path_val + file_name. */
2670 (char *) alloca (strlen (path_val
) + strlen (file_name
) + 2);
2674 /* Skip the starting quote */
2676 if (*path_val
== '"')
2679 for (ptr
= file_path
; *path_val
&& *path_val
!= PATH_SEPARATOR
; )
2680 *ptr
++ = *path_val
++;
2682 /* If directory is empty, it is the current directory*/
2684 if (ptr
== file_path
)
2691 /* Skip the ending quote */
2696 if (*ptr
!= '/' && *ptr
!= DIR_SEPARATOR
)
2697 *++ptr
= DIR_SEPARATOR
;
2699 strcpy (++ptr
, file_name
);
2701 if (predicate (file_path
))
2702 return xstrdup (file_path
);
2707 /* Skip path separator */
2716 /* Locate an executable file, give a Path value. */
2719 __gnat_locate_executable_file (char *file_name
, char *path_val
)
2721 return __gnat_locate_file_with_predicate
2722 (file_name
, path_val
, &__gnat_is_executable_file
);
2725 /* Locate a regular file, give a Path value. */
2728 __gnat_locate_regular_file (char *file_name
, char *path_val
)
2730 return __gnat_locate_file_with_predicate
2731 (file_name
, path_val
, &__gnat_is_regular_file
);
2734 /* Locate an executable given a Path argument. This routine is only used by
2735 gnatbl and should not be used otherwise. Use locate_exec_on_path
2739 __gnat_locate_exec (char *exec_name
, char *path_val
)
2742 if (!strstr (exec_name
, HOST_EXECUTABLE_SUFFIX
))
2744 char *full_exec_name
=
2746 (strlen (exec_name
) + strlen (HOST_EXECUTABLE_SUFFIX
) + 1);
2748 strcpy (full_exec_name
, exec_name
);
2749 strcat (full_exec_name
, HOST_EXECUTABLE_SUFFIX
);
2750 ptr
= __gnat_locate_executable_file (full_exec_name
, path_val
);
2753 return __gnat_locate_executable_file (exec_name
, path_val
);
2757 return __gnat_locate_executable_file (exec_name
, path_val
);
2760 /* Locate an executable using the Systems default PATH. */
2763 __gnat_locate_exec_on_path (char *exec_name
)
2767 #if defined (_WIN32)
2768 TCHAR
*wpath_val
= _tgetenv (_T("PATH"));
2770 /* In Win32 systems we expand the PATH as for XP environment
2771 variables are not automatically expanded. We also prepend the
2772 ".;" to the path to match normal NT path search semantics */
2774 #define EXPAND_BUFFER_SIZE 32767
2776 wapath_val
= (TCHAR
*) alloca (EXPAND_BUFFER_SIZE
);
2778 wapath_val
[0] = '.';
2779 wapath_val
[1] = ';';
2781 DWORD res
= ExpandEnvironmentStrings
2782 (wpath_val
, &wapath_val
[2], EXPAND_BUFFER_SIZE
- 2);
2784 if (!res
) wapath_val
[0] = _T('\0');
2786 apath_val
= (char *) alloca (EXPAND_BUFFER_SIZE
);
2788 WS2SC (apath_val
, wapath_val
, EXPAND_BUFFER_SIZE
);
2789 return __gnat_locate_exec (exec_name
, apath_val
);
2792 char *path_val
= getenv ("PATH");
2794 if (path_val
== NULL
) return NULL
;
2795 apath_val
= (char *) alloca (strlen (path_val
) + 1);
2796 strcpy (apath_val
, path_val
);
2797 return __gnat_locate_exec (exec_name
, apath_val
);
2801 /* Dummy functions for Osint import for non-VMS systems.
2802 ??? To be removed. */
2805 __gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED
,
2806 int onlydirs ATTRIBUTE_UNUSED
)
2812 __gnat_to_canonical_file_list_next (void)
2814 static char empty
[] = "";
2819 __gnat_to_canonical_file_list_free (void)
2824 __gnat_to_canonical_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2830 __gnat_to_canonical_file_spec (char *filespec
)
2836 __gnat_to_canonical_path_spec (char *pathspec
)
2842 __gnat_to_host_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2848 __gnat_to_host_file_spec (char *filespec
)
2854 __gnat_adjust_os_resource_limits (void)
2858 #if defined (__mips_vxworks)
2862 CACHE_USER_FLUSH (0, ENTIRE_CACHE
);
2866 #if defined (_WIN32)
2867 int __gnat_argument_needs_quote
= 1;
2869 int __gnat_argument_needs_quote
= 0;
2872 /* This option is used to enable/disable object files handling from the
2873 binder file by the GNAT Project module. For example, this is disabled on
2874 Windows (prior to GCC 3.4) as it is already done by the mdll module.
2875 Stating with GCC 3.4 the shared libraries are not based on mdll
2876 anymore as it uses the GCC's -shared option */
2877 #if defined (_WIN32) \
2878 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
2879 int __gnat_prj_add_obj_files
= 0;
2881 int __gnat_prj_add_obj_files
= 1;
2884 /* char used as prefix/suffix for environment variables */
2885 #if defined (_WIN32)
2886 char __gnat_environment_char
= '%';
2888 char __gnat_environment_char
= '$';
2891 /* This functions copy the file attributes from a source file to a
2894 mode = 0 : In this mode copy only the file time stamps (last access and
2895 last modification time stamps).
2897 mode = 1 : In this mode, time stamps and read/write/execute attributes are
2900 Returns 0 if operation was successful and -1 in case of error. */
2903 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED
, char *to ATTRIBUTE_UNUSED
,
2904 int mode ATTRIBUTE_UNUSED
)
2906 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2909 #elif defined (_WIN32)
2910 TCHAR wfrom
[GNAT_MAX_PATH_LEN
+ 2];
2911 TCHAR wto
[GNAT_MAX_PATH_LEN
+ 2];
2913 FILETIME fct
, flat
, flwt
;
2916 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
+ 2);
2917 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
+ 2);
2919 /* retrieve from times */
2922 (wfrom
, GENERIC_READ
, 0, NULL
, OPEN_EXISTING
, FILE_ATTRIBUTE_NORMAL
, NULL
);
2924 if (hfrom
== INVALID_HANDLE_VALUE
)
2927 res
= GetFileTime (hfrom
, &fct
, &flat
, &flwt
);
2929 CloseHandle (hfrom
);
2934 /* retrieve from times */
2937 (wto
, GENERIC_WRITE
, 0, NULL
, OPEN_EXISTING
, FILE_ATTRIBUTE_NORMAL
, NULL
);
2939 if (hto
== INVALID_HANDLE_VALUE
)
2942 res
= SetFileTime (hto
, NULL
, &flat
, &flwt
);
2949 /* Set file attributes in full mode. */
2953 DWORD attribs
= GetFileAttributes (wfrom
);
2955 if (attribs
== INVALID_FILE_ATTRIBUTES
)
2958 res
= SetFileAttributes (wto
, attribs
);
2966 GNAT_STRUCT_STAT fbuf
;
2967 struct utimbuf tbuf
;
2969 if (GNAT_STAT (from
, &fbuf
) == -1)
2974 tbuf
.actime
= fbuf
.st_atime
;
2975 tbuf
.modtime
= fbuf
.st_mtime
;
2977 if (utime (to
, &tbuf
) == -1)
2984 if (chmod (to
, fbuf
.st_mode
) == -1)
2995 __gnat_lseek (int fd
, long offset
, int whence
)
2997 return (int) lseek (fd
, offset
, whence
);
3000 /* This function returns the major version number of GCC being used. */
3002 get_gcc_version (void)
3007 return (int) (version_string
[0] - '0');
3012 * Set Close_On_Exec as indicated.
3013 * Note: this is used for both GNAT.OS_Lib and GNAT.Sockets.
3017 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED
,
3018 int close_on_exec_p ATTRIBUTE_UNUSED
)
3020 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
3021 int flags
= fcntl (fd
, F_GETFD
, 0);
3024 if (close_on_exec_p
)
3025 flags
|= FD_CLOEXEC
;
3027 flags
&= ~FD_CLOEXEC
;
3028 return fcntl (fd
, F_SETFD
, flags
);
3029 #elif defined(_WIN32)
3030 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
3031 if (h
== (HANDLE
) -1)
3033 if (close_on_exec_p
)
3034 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
, 0);
3035 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
,
3036 HANDLE_FLAG_INHERIT
);
3038 /* TODO: Unimplemented. */
3043 /* Indicates if platforms supports automatic initialization through the
3044 constructor mechanism */
3046 __gnat_binder_supports_auto_init (void)
3051 /* Indicates that Stand-Alone Libraries are automatically initialized through
3052 the constructor mechanism */
3054 __gnat_sals_init_using_constructors (void)
3056 #if defined (__vxworks) || defined (__Lynx__)
3063 #if defined (__ANDROID__)
3065 #include <pthread.h>
3068 __gnat_lwp_self (void)
3070 return (void *) pthread_self ();
3073 #elif defined (__linux__)
3074 /* There is no function in the glibc to retrieve the LWP of the current
3075 thread. We need to do a system call in order to retrieve this
3077 #include <sys/syscall.h>
3079 __gnat_lwp_self (void)
3081 return (void *) syscall (__NR_gettid
);
3086 /* glibc versions earlier than 2.7 do not define the routines to handle
3087 dynamically allocated CPU sets. For these targets, we use the static
3092 /* Dynamic cpu sets */
3095 __gnat_cpu_alloc (size_t count
)
3097 return CPU_ALLOC (count
);
3101 __gnat_cpu_alloc_size (size_t count
)
3103 return CPU_ALLOC_SIZE (count
);
3107 __gnat_cpu_free (cpu_set_t
*set
)
3113 __gnat_cpu_zero (size_t count
, cpu_set_t
*set
)
3115 CPU_ZERO_S (count
, set
);
3119 __gnat_cpu_set (int cpu
, size_t count
, cpu_set_t
*set
)
3121 /* Ada handles CPU numbers starting from 1, while C identifies the first
3122 CPU by a 0, so we need to adjust. */
3123 CPU_SET_S (cpu
- 1, count
, set
);
3126 #else /* !CPU_ALLOC */
3128 /* Static cpu sets */
3131 __gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED
)
3133 return (cpu_set_t
*) xmalloc (sizeof (cpu_set_t
));
3137 __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED
)
3139 return sizeof (cpu_set_t
);
3143 __gnat_cpu_free (cpu_set_t
*set
)
3149 __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3155 __gnat_cpu_set (int cpu
, size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3157 /* Ada handles CPU numbers starting from 1, while C identifies the first
3158 CPU by a 0, so we need to adjust. */
3159 CPU_SET (cpu
- 1, set
);
3161 #endif /* !CPU_ALLOC */
3162 #endif /* __linux__ */
3164 /* Return the load address of the executable, or 0 if not known. In the
3165 specific case of error, (void *)-1 can be returned. Beware: this unit may
3166 be in a shared library. As low-level units are needed, we allow #include
3169 #if defined (__APPLE__)
3170 #include <mach-o/dyld.h>
3174 __gnat_get_executable_load_address (void)
3176 #if defined (__APPLE__)
3177 return _dyld_get_image_header (0);
3179 #elif 0 && defined (__linux__)
3180 /* Currently disabled as it needs at least -ldl. */
3181 struct link_map
*map
= _r_debug
.r_map
;
3183 return (const void *)map
->l_addr
;