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) \
556 || (defined (__APPLE__) && !(defined (__arm__) || defined (__arm64__)))
557 file_names_case_sensitive_cache
= 0;
559 file_names_case_sensitive_cache
= 1;
563 return file_names_case_sensitive_cache
;
566 /* Return nonzero if environment variables are case sensitive. */
569 __gnat_get_env_vars_case_sensitive (void)
579 __gnat_get_default_identifier_character_set (void)
584 /* Return the current working directory. */
587 __gnat_get_current_dir (char *dir
, int *length
)
589 #if defined (__MINGW32__)
590 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
592 _tgetcwd (wdir
, *length
);
594 WS2SC (dir
, wdir
, GNAT_MAX_PATH_LEN
);
597 getcwd (dir
, *length
);
600 *length
= strlen (dir
);
602 if (dir
[*length
- 1] != DIR_SEPARATOR
)
604 dir
[*length
] = DIR_SEPARATOR
;
610 /* Return the suffix for object files. */
613 __gnat_get_object_suffix_ptr (int *len
, const char **value
)
615 *value
= HOST_OBJECT_SUFFIX
;
620 *len
= strlen (*value
);
625 /* Return the suffix for executable files. */
628 __gnat_get_executable_suffix_ptr (int *len
, const char **value
)
630 *value
= HOST_EXECUTABLE_SUFFIX
;
634 *len
= strlen (*value
);
639 /* Return the suffix for debuggable files. Usually this is the same as the
640 executable extension. */
643 __gnat_get_debuggable_suffix_ptr (int *len
, const char **value
)
645 *value
= HOST_EXECUTABLE_SUFFIX
;
650 *len
= strlen (*value
);
655 /* Returns the OS filename and corresponding encoding. */
658 __gnat_os_filename (char *filename ATTRIBUTE_UNUSED
,
659 char *w_filename ATTRIBUTE_UNUSED
,
660 char *os_name
, int *o_length
,
661 char *encoding ATTRIBUTE_UNUSED
, int *e_length
)
663 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
664 WS2SC (os_name
, (TCHAR
*)w_filename
, (DWORD
)*o_length
);
665 *o_length
= strlen (os_name
);
666 strcpy (encoding
, "encoding=utf8");
667 *e_length
= strlen (encoding
);
669 strcpy (os_name
, filename
);
670 *o_length
= strlen (filename
);
678 __gnat_unlink (char *path
)
680 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
682 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
684 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
685 return _tunlink (wpath
);
688 return unlink (path
);
695 __gnat_rename (char *from
, char *to
)
697 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
699 TCHAR wfrom
[GNAT_MAX_PATH_LEN
], wto
[GNAT_MAX_PATH_LEN
];
701 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
);
702 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
);
703 return _trename (wfrom
, wto
);
706 return rename (from
, to
);
710 /* Changing directory. */
713 __gnat_chdir (char *path
)
715 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
717 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
719 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
720 return _tchdir (wpath
);
727 /* Removing a directory. */
730 __gnat_rmdir (char *path
)
732 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
734 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
736 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
737 return _trmdir (wpath
);
739 #elif defined (VTHREADS)
740 /* rmdir not available */
747 #if defined (_WIN32) || defined (__linux__) || defined (__sun__) \
748 || defined (__FreeBSD__) || defined(__DragonFly__)
749 #define HAS_TARGET_WCHAR_T
752 #ifdef HAS_TARGET_WCHAR_T
757 __gnat_fputwc(int c
, FILE *stream
)
759 #ifdef HAS_TARGET_WCHAR_T
760 return fputwc ((wchar_t)c
, stream
);
762 return fputc (c
, stream
);
767 __gnat_fopen (char *path
, char *mode
, int encoding ATTRIBUTE_UNUSED
)
769 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
770 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
773 S2WS (wmode
, mode
, 10);
775 if (encoding
== Encoding_Unspecified
)
776 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
777 else if (encoding
== Encoding_UTF8
)
778 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
780 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
782 return _tfopen (wpath
, wmode
);
785 return GNAT_FOPEN (path
, mode
);
790 __gnat_freopen (char *path
,
793 int encoding ATTRIBUTE_UNUSED
)
795 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
796 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
799 S2WS (wmode
, mode
, 10);
801 if (encoding
== Encoding_Unspecified
)
802 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
803 else if (encoding
== Encoding_UTF8
)
804 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
806 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
808 return _tfreopen (wpath
, wmode
, stream
);
810 return freopen (path
, mode
, stream
);
815 __gnat_open_read (char *path
, int fmode
)
818 int o_fmode
= O_BINARY
;
823 #if defined (__vxworks)
824 fd
= open (path
, O_RDONLY
| o_fmode
, 0444);
825 #elif defined (__MINGW32__)
827 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
829 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
830 fd
= _topen (wpath
, O_RDONLY
| o_fmode
, 0444);
833 fd
= GNAT_OPEN (path
, O_RDONLY
| o_fmode
);
836 return fd
< 0 ? -1 : fd
;
839 #if defined (__MINGW32__)
840 #define PERM (S_IREAD | S_IWRITE)
842 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
846 __gnat_open_rw (char *path
, int fmode
)
849 int o_fmode
= O_BINARY
;
854 #if defined (__MINGW32__)
856 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
858 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
859 fd
= _topen (wpath
, O_RDWR
| o_fmode
, PERM
);
862 fd
= GNAT_OPEN (path
, O_RDWR
| o_fmode
, PERM
);
865 return fd
< 0 ? -1 : fd
;
869 __gnat_open_create (char *path
, int fmode
)
872 int o_fmode
= O_BINARY
;
877 #if defined (__MINGW32__)
879 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
881 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
882 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
885 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
888 return fd
< 0 ? -1 : fd
;
892 __gnat_create_output_file (char *path
)
895 #if defined (__MINGW32__)
897 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
899 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
900 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
903 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
906 return fd
< 0 ? -1 : fd
;
910 __gnat_create_output_file_new (char *path
)
913 #if defined (__MINGW32__)
915 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
917 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
918 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
921 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
924 return fd
< 0 ? -1 : fd
;
928 __gnat_open_append (char *path
, int fmode
)
931 int o_fmode
= O_BINARY
;
936 #if defined (__MINGW32__)
938 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
940 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
941 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
944 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
947 return fd
< 0 ? -1 : fd
;
950 /* Open a new file. Return error (-1) if the file already exists. */
953 __gnat_open_new (char *path
, int fmode
)
956 int o_fmode
= O_BINARY
;
961 #if defined (__MINGW32__)
963 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
965 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
966 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
969 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
972 return fd
< 0 ? -1 : fd
;
975 /* Open a new temp file. Return error (-1) if the file already exists. */
978 __gnat_open_new_temp (char *path
, int fmode
)
981 int o_fmode
= O_BINARY
;
983 strcpy (path
, "GNAT-XXXXXX");
985 #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
986 || defined (__linux__) || defined (__GLIBC__) || defined (__ANDROID__) \
987 || defined (__DragonFly__)) && !defined (__vxworks)
988 return mkstemp (path
);
989 #elif defined (__Lynx__)
992 if (mktemp (path
) == NULL
)
999 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
1000 return fd
< 0 ? -1 : fd
;
1004 __gnat_open (char *path
, int fmode
)
1008 #if defined (__MINGW32__)
1010 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1012 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1013 fd
= _topen (wpath
, fmode
, PERM
);
1016 fd
= GNAT_OPEN (path
, fmode
, PERM
);
1019 return fd
< 0 ? -1 : fd
;
1022 /****************************************************************
1023 ** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information
1024 ** as possible from it, storing the result in a cache for later reuse
1025 ****************************************************************/
1028 __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
)
1030 GNAT_STRUCT_STAT statbuf
;
1034 /* GNAT_FSTAT returns -1 and sets errno for failure */
1035 ret
= GNAT_FSTAT (fd
, &statbuf
);
1036 error
= ret
? errno
: 0;
1039 /* __gnat_stat returns errno value directly */
1040 error
= __gnat_stat (name
, &statbuf
);
1041 ret
= error
? -1 : 0;
1045 * A missing file is reported as an attr structure with error == 0 and
1049 if (error
== 0 || error
== ENOENT
)
1052 attr
->error
= error
;
1054 attr
->regular
= (!ret
&& S_ISREG (statbuf
.st_mode
));
1055 attr
->directory
= (!ret
&& S_ISDIR (statbuf
.st_mode
));
1058 attr
->file_length
= 0;
1060 /* st_size may be 32 bits, or 64 bits which is converted to long. We
1061 don't return a useful value for files larger than 2 gigabytes in
1063 attr
->file_length
= statbuf
.st_size
; /* all systems */
1065 attr
->exists
= !ret
;
1067 #if !defined (_WIN32)
1068 /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
1069 attr
->readable
= (!ret
&& (statbuf
.st_mode
& S_IRUSR
));
1070 attr
->writable
= (!ret
&& (statbuf
.st_mode
& S_IWUSR
));
1071 attr
->executable
= (!ret
&& (statbuf
.st_mode
& S_IXUSR
));
1075 attr
->timestamp
= (OS_Time
)-1;
1077 attr
->timestamp
= (OS_Time
)statbuf
.st_mtime
;
1081 /****************************************************************
1082 ** Return the number of bytes in the specified file
1083 ****************************************************************/
1086 __gnat_file_length_attr (int fd
, char* name
, struct file_attributes
* attr
)
1088 if (attr
->file_length
== -1) {
1089 __gnat_stat_to_attr (fd
, name
, attr
);
1092 return attr
->file_length
;
1096 __gnat_file_length (int fd
)
1098 struct file_attributes attr
;
1099 __gnat_reset_attributes (&attr
);
1100 return __gnat_file_length_attr (fd
, NULL
, &attr
);
1104 __gnat_file_length_long (int fd
)
1106 struct file_attributes attr
;
1107 __gnat_reset_attributes (&attr
);
1108 return (long)__gnat_file_length_attr (fd
, NULL
, &attr
);
1112 __gnat_named_file_length (char *name
)
1114 struct file_attributes attr
;
1115 __gnat_reset_attributes (&attr
);
1116 return __gnat_file_length_attr (-1, name
, &attr
);
1119 /* Create a temporary filename and put it in string pointed to by
1123 __gnat_tmp_name (char *tmp_filename
)
1125 #if defined (__MINGW32__)
1130 /* tempnam tries to create a temporary file in directory pointed to by
1131 TMP environment variable, in c:\temp if TMP is not set, and in
1132 directory specified by P_tmpdir in stdio.h if c:\temp does not
1133 exist. The filename will be created with the prefix "gnat-". */
1135 sprintf (prefix
, "gnat-%d-", (int)getpid());
1136 pname
= (char *) _tempnam ("c:\\temp", prefix
);
1138 /* if pname is NULL, the file was not created properly, the disk is full
1139 or there is no more free temporary files */
1142 *tmp_filename
= '\0';
1144 /* If pname start with a back slash and not path information it means that
1145 the filename is valid for the current working directory. */
1147 else if (pname
[0] == '\\')
1149 strcpy (tmp_filename
, ".\\");
1150 strcat (tmp_filename
, pname
+1);
1153 strcpy (tmp_filename
, pname
);
1158 #elif defined (__linux__) || defined (__FreeBSD__) || defined (__NetBSD__) \
1159 || defined (__OpenBSD__) || defined (__GLIBC__) || defined (__ANDROID__) \
1160 || defined (__DragonFly__)
1161 #define MAX_SAFE_PATH 1000
1162 char *tmpdir
= getenv ("TMPDIR");
1164 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1165 a buffer overflow. */
1166 if (tmpdir
== NULL
|| strlen (tmpdir
) > MAX_SAFE_PATH
)
1168 strcpy (tmp_filename
, "/cache/gnat-XXXXXX");
1170 strcpy (tmp_filename
, "/tmp/gnat-XXXXXX");
1173 sprintf (tmp_filename
, "%s/gnat-XXXXXX", tmpdir
);
1175 close (mkstemp(tmp_filename
));
1176 #elif defined (__vxworks) && !defined (VTHREADS)
1180 static ushort_t seed
= 0; /* used to generate unique name */
1182 /* Generate a unique name. */
1183 strcpy (tmp_filename
, "tmp");
1186 savepos
= pos
= tmp_filename
+ strlen (tmp_filename
) + index
;
1194 /* Fill up the name buffer from the last position. */
1196 for (t
= seed
; 0 <= --index
; t
>>= 3)
1197 *--pos
= '0' + (t
& 07);
1199 /* Check to see if its unique, if not bump the seed and try again. */
1200 f
= fopen (tmp_filename
, "r");
1208 tmpnam (tmp_filename
);
1212 /* Open directory and returns a DIR pointer. */
1214 DIR* __gnat_opendir (char *name
)
1216 #if defined (__MINGW32__)
1217 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1219 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1220 return (DIR*)_topendir (wname
);
1223 return opendir (name
);
1227 /* Read the next entry in a directory. The returned string points somewhere
1230 #if defined (__sun__)
1231 /* For Solaris, be sure to use the 64-bit version, otherwise NFS reads may
1232 fail with EOVERFLOW if the server uses 64-bit cookies. */
1233 #define dirent dirent64
1234 #define readdir readdir64
1238 __gnat_readdir (DIR *dirp
, char *buffer
, int *len
)
1240 #if defined (__MINGW32__)
1241 struct _tdirent
*dirent
= _treaddir ((_TDIR
*)dirp
);
1245 WS2SC (buffer
, dirent
->d_name
, GNAT_MAX_PATH_LEN
);
1246 *len
= strlen (buffer
);
1253 #elif defined (HAVE_READDIR_R)
1254 /* If possible, try to use the thread-safe version. */
1255 if (readdir_r (dirp
, buffer
) != NULL
)
1257 *len
= strlen (((struct dirent
*) buffer
)->d_name
);
1258 return ((struct dirent
*) buffer
)->d_name
;
1264 struct dirent
*dirent
= (struct dirent
*) readdir (dirp
);
1268 strcpy (buffer
, dirent
->d_name
);
1269 *len
= strlen (buffer
);
1278 /* Close a directory entry. */
1280 int __gnat_closedir (DIR *dirp
)
1282 #if defined (__MINGW32__)
1283 return _tclosedir ((_TDIR
*)dirp
);
1286 return closedir (dirp
);
1290 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1293 __gnat_readdir_is_thread_safe (void)
1295 #ifdef HAVE_READDIR_R
1302 #if defined (_WIN32)
1303 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1304 static const unsigned long long w32_epoch_offset
= 11644473600ULL;
1306 /* Returns the file modification timestamp using Win32 routines which are
1307 immune against daylight saving time change. It is in fact not possible to
1308 use fstat for this purpose as the DST modify the st_mtime field of the
1312 win32_filetime (HANDLE h
)
1317 unsigned long long ull_time
;
1320 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1321 since <Jan 1st 1601>. This function must return the number of seconds
1322 since <Jan 1st 1970>. */
1324 if (GetFileTime (h
, NULL
, NULL
, &t_write
.ft_time
))
1325 return (time_t) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1329 /* As above but starting from a FILETIME. */
1331 f2t (const FILETIME
*ft
, __time64_t
*t
)
1336 unsigned long long ull_time
;
1339 t_write
.ft_time
= *ft
;
1340 *t
= (__time64_t
) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1344 /* Return a GNAT time stamp given a file name. */
1347 __gnat_file_time_name_attr (char* name
, struct file_attributes
* attr
)
1349 if (attr
->timestamp
== (OS_Time
)-2) {
1350 #if defined (_WIN32)
1352 WIN32_FILE_ATTRIBUTE_DATA fad
;
1353 __time64_t ret
= -1;
1354 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1355 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1357 if ((res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
)))
1358 f2t (&fad
.ftLastWriteTime
, &ret
);
1359 attr
->timestamp
= (OS_Time
) ret
;
1361 __gnat_stat_to_attr (-1, name
, attr
);
1364 return attr
->timestamp
;
1368 __gnat_file_time_name (char *name
)
1370 struct file_attributes attr
;
1371 __gnat_reset_attributes (&attr
);
1372 return __gnat_file_time_name_attr (name
, &attr
);
1375 /* Return a GNAT time stamp given a file descriptor. */
1378 __gnat_file_time_fd_attr (int fd
, struct file_attributes
* attr
)
1380 if (attr
->timestamp
== (OS_Time
)-2) {
1381 #if defined (_WIN32)
1382 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
1383 time_t ret
= win32_filetime (h
);
1384 attr
->timestamp
= (OS_Time
) ret
;
1387 __gnat_stat_to_attr (fd
, NULL
, attr
);
1391 return attr
->timestamp
;
1395 __gnat_file_time_fd (int fd
)
1397 struct file_attributes attr
;
1398 __gnat_reset_attributes (&attr
);
1399 return __gnat_file_time_fd_attr (fd
, &attr
);
1402 /* Set the file time stamp. */
1405 __gnat_set_file_time_name (char *name
, time_t time_stamp
)
1407 #if defined (__vxworks)
1409 /* Code to implement __gnat_set_file_time_name for these systems. */
1411 #elif defined (_WIN32)
1415 unsigned long long ull_time
;
1417 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1419 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1421 HANDLE h
= CreateFile
1422 (wname
, GENERIC_WRITE
, FILE_SHARE_WRITE
, NULL
,
1423 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
,
1425 if (h
== INVALID_HANDLE_VALUE
)
1427 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1428 t_write
.ull_time
= ((unsigned long long)time_stamp
+ w32_epoch_offset
);
1429 /* Convert to 100 nanosecond units */
1430 t_write
.ull_time
*= 10000000ULL;
1432 SetFileTime(h
, NULL
, NULL
, &t_write
.ft_time
);
1437 struct utimbuf utimbuf
;
1440 /* Set modification time to requested time. */
1441 utimbuf
.modtime
= time_stamp
;
1443 /* Set access time to now in local time. */
1444 t
= time ((time_t) 0);
1445 utimbuf
.actime
= mktime (localtime (&t
));
1447 utime (name
, &utimbuf
);
1451 /* Get the list of installed standard libraries from the
1452 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1456 __gnat_get_libraries_from_registry (void)
1458 char *result
= (char *) xmalloc (1);
1462 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
1465 DWORD name_size
, value_size
;
1472 /* First open the key. */
1473 res
= RegOpenKeyExA (HKEY_LOCAL_MACHINE
, "SOFTWARE", 0, KEY_READ
, ®_key
);
1475 if (res
== ERROR_SUCCESS
)
1476 res
= RegOpenKeyExA (reg_key
, "Ada Core Technologies", 0,
1477 KEY_READ
, ®_key
);
1479 if (res
== ERROR_SUCCESS
)
1480 res
= RegOpenKeyExA (reg_key
, "GNAT", 0, KEY_READ
, ®_key
);
1482 if (res
== ERROR_SUCCESS
)
1483 res
= RegOpenKeyExA (reg_key
, "Standard Libraries", 0, KEY_READ
, ®_key
);
1485 /* If the key exists, read out all the values in it and concatenate them
1487 for (index
= 0; res
== ERROR_SUCCESS
; index
++)
1489 value_size
= name_size
= 256;
1490 res
= RegEnumValueA (reg_key
, index
, name
, &name_size
, 0,
1491 &type
, (LPBYTE
)value
, &value_size
);
1493 if (res
== ERROR_SUCCESS
&& type
== REG_SZ
)
1495 char *old_result
= result
;
1497 result
= (char *) xmalloc (strlen (old_result
) + value_size
+ 2);
1498 strcpy (result
, old_result
);
1499 strcat (result
, value
);
1500 strcat (result
, ";");
1505 /* Remove the trailing ";". */
1507 result
[strlen (result
) - 1] = 0;
1513 /* Query information for the given file NAME and return it in STATBUF.
1514 * Returns 0 for success, or errno value for failure.
1517 __gnat_stat (char *name
, GNAT_STRUCT_STAT
*statbuf
)
1520 WIN32_FILE_ATTRIBUTE_DATA fad
;
1521 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1526 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1527 name_len
= _tcslen (wname
);
1529 if (name_len
> GNAT_MAX_PATH_LEN
)
1532 ZeroMemory (statbuf
, sizeof(GNAT_STRUCT_STAT
));
1534 res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
);
1537 error
= GetLastError();
1539 /* Check file existence using GetFileAttributes() which does not fail on
1540 special Windows files like con:, aux:, nul: etc... */
1542 if (GetFileAttributes(wname
) != INVALID_FILE_ATTRIBUTES
) {
1543 /* Just pretend that it is a regular and readable file */
1544 statbuf
->st_mode
= S_IFREG
| S_IREAD
| S_IWRITE
;
1549 case ERROR_ACCESS_DENIED
:
1550 case ERROR_SHARING_VIOLATION
:
1551 case ERROR_LOCK_VIOLATION
:
1552 case ERROR_SHARING_BUFFER_EXCEEDED
:
1554 case ERROR_BUFFER_OVERFLOW
:
1555 return ENAMETOOLONG
;
1556 case ERROR_NOT_ENOUGH_MEMORY
:
1563 f2t (&fad
.ftCreationTime
, &statbuf
->st_ctime
);
1564 f2t (&fad
.ftLastWriteTime
, &statbuf
->st_mtime
);
1565 f2t (&fad
.ftLastAccessTime
, &statbuf
->st_atime
);
1568 (__int64
)fad
.nFileSizeLow
| (__int64
)fad
.nFileSizeHigh
<< 32;
1570 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1571 statbuf
->st_mode
= S_IREAD
;
1573 if (fad
.dwFileAttributes
& FILE_ATTRIBUTE_DIRECTORY
)
1574 statbuf
->st_mode
|= S_IFDIR
;
1576 statbuf
->st_mode
|= S_IFREG
;
1578 if (!(fad
.dwFileAttributes
& FILE_ATTRIBUTE_READONLY
))
1579 statbuf
->st_mode
|= S_IWRITE
;
1584 return GNAT_STAT (name
, statbuf
) == 0 ? 0 : errno
;
1588 /*************************************************************************
1589 ** Check whether a file exists
1590 *************************************************************************/
1593 __gnat_file_exists_attr (char* name
, struct file_attributes
* attr
)
1595 if (attr
->exists
== ATTR_UNSET
)
1596 __gnat_stat_to_attr (-1, name
, attr
);
1598 return attr
->exists
;
1602 __gnat_file_exists (char *name
)
1604 struct file_attributes attr
;
1605 __gnat_reset_attributes (&attr
);
1606 return __gnat_file_exists_attr (name
, &attr
);
1609 /**********************************************************************
1610 ** Whether name is an absolute path
1611 **********************************************************************/
1614 __gnat_is_absolute_path (char *name
, int length
)
1617 /* On VxWorks systems, an absolute path can be represented (depending on
1618 the host platform) as either /dir/file, or device:/dir/file, or
1619 device:drive_letter:/dir/file. */
1626 for (index
= 0; index
< length
; index
++)
1628 if (name
[index
] == ':' &&
1629 ((name
[index
+ 1] == '/') ||
1630 (isalpha (name
[index
+ 1]) && index
+ 2 <= length
&&
1631 name
[index
+ 2] == '/')))
1634 else if (name
[index
] == '/')
1639 return (length
!= 0) &&
1640 (*name
== '/' || *name
== DIR_SEPARATOR
1642 || (length
> 1 && ISALPHA (name
[0]) && name
[1] == ':')
1649 __gnat_is_regular_file_attr (char* name
, struct file_attributes
* attr
)
1651 if (attr
->regular
== ATTR_UNSET
)
1652 __gnat_stat_to_attr (-1, name
, attr
);
1654 return attr
->regular
;
1658 __gnat_is_regular_file (char *name
)
1660 struct file_attributes attr
;
1662 __gnat_reset_attributes (&attr
);
1663 return __gnat_is_regular_file_attr (name
, &attr
);
1667 __gnat_is_regular_file_fd (int fd
)
1670 GNAT_STRUCT_STAT statbuf
;
1672 ret
= GNAT_FSTAT (fd
, &statbuf
);
1673 return (!ret
&& S_ISREG (statbuf
.st_mode
));
1677 __gnat_is_directory_attr (char* name
, struct file_attributes
* attr
)
1679 if (attr
->directory
== ATTR_UNSET
)
1680 __gnat_stat_to_attr (-1, name
, attr
);
1682 return attr
->directory
;
1686 __gnat_is_directory (char *name
)
1688 struct file_attributes attr
;
1690 __gnat_reset_attributes (&attr
);
1691 return __gnat_is_directory_attr (name
, &attr
);
1694 #if defined (_WIN32)
1696 /* Returns the same constant as GetDriveType but takes a pathname as
1700 GetDriveTypeFromPath (TCHAR
*wfullpath
)
1702 TCHAR wdrv
[MAX_PATH
];
1703 TCHAR wpath
[MAX_PATH
];
1704 TCHAR wfilename
[MAX_PATH
];
1705 TCHAR wext
[MAX_PATH
];
1707 _tsplitpath (wfullpath
, wdrv
, wpath
, wfilename
, wext
);
1709 if (_tcslen (wdrv
) != 0)
1711 /* we have a drive specified. */
1712 _tcscat (wdrv
, _T("\\"));
1713 return GetDriveType (wdrv
);
1717 /* No drive specified. */
1719 /* Is this a relative path, if so get current drive type. */
1720 if (wpath
[0] != _T('\\') ||
1721 (_tcslen (wpath
) > 2 && wpath
[0] == _T('\\')
1722 && wpath
[1] != _T('\\')))
1723 return GetDriveType (NULL
);
1725 UINT result
= GetDriveType (wpath
);
1727 /* Cannot guess the drive type, is this \\.\ ? */
1729 if (result
== DRIVE_NO_ROOT_DIR
&&
1730 _tcslen (wpath
) >= 4 && wpath
[0] == _T('\\') && wpath
[1] == _T('\\')
1731 && wpath
[2] == _T('.') && wpath
[3] == _T('\\'))
1733 if (_tcslen (wpath
) == 4)
1734 _tcscat (wpath
, wfilename
);
1736 LPTSTR p
= &wpath
[4];
1737 LPTSTR b
= _tcschr (p
, _T('\\'));
1741 /* logical drive \\.\c\dir\file */
1747 _tcscat (p
, _T(":\\"));
1749 return GetDriveType (p
);
1756 /* This MingW section contains code to work with ACL. */
1758 __gnat_check_OWNER_ACL (TCHAR
*wname
,
1759 DWORD CheckAccessDesired
,
1760 GENERIC_MAPPING CheckGenericMapping
)
1762 DWORD dwAccessDesired
, dwAccessAllowed
;
1763 PRIVILEGE_SET PrivilegeSet
;
1764 DWORD dwPrivSetSize
= sizeof (PRIVILEGE_SET
);
1765 BOOL fAccessGranted
= FALSE
;
1766 HANDLE hToken
= NULL
;
1768 PSECURITY_DESCRIPTOR pSD
= NULL
;
1771 (wname
, OWNER_SECURITY_INFORMATION
|
1772 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1775 if ((pSD
= (SECURITY_DESCRIPTOR
*) HeapAlloc
1776 (GetProcessHeap (), HEAP_ZERO_MEMORY
, nLength
)) == NULL
)
1779 /* Obtain the security descriptor. */
1781 if (!GetFileSecurity
1782 (wname
, OWNER_SECURITY_INFORMATION
|
1783 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1784 pSD
, nLength
, &nLength
))
1787 if (!ImpersonateSelf (SecurityImpersonation
))
1790 if (!OpenThreadToken
1791 (GetCurrentThread(), TOKEN_DUPLICATE
| TOKEN_QUERY
, FALSE
, &hToken
))
1794 /* Undoes the effect of ImpersonateSelf. */
1798 /* We want to test for write permissions. */
1800 dwAccessDesired
= CheckAccessDesired
;
1802 MapGenericMask (&dwAccessDesired
, &CheckGenericMapping
);
1805 (pSD
, /* security descriptor to check */
1806 hToken
, /* impersonation token */
1807 dwAccessDesired
, /* requested access rights */
1808 &CheckGenericMapping
, /* pointer to GENERIC_MAPPING */
1809 &PrivilegeSet
, /* receives privileges used in check */
1810 &dwPrivSetSize
, /* size of PrivilegeSet buffer */
1811 &dwAccessAllowed
, /* receives mask of allowed access rights */
1815 CloseHandle (hToken
);
1816 HeapFree (GetProcessHeap (), 0, pSD
);
1817 return fAccessGranted
;
1821 CloseHandle (hToken
);
1822 HeapFree (GetProcessHeap (), 0, pSD
);
1827 __gnat_set_OWNER_ACL (TCHAR
*wname
,
1828 ACCESS_MODE AccessMode
,
1829 DWORD AccessPermissions
)
1831 PACL pOldDACL
= NULL
;
1832 PACL pNewDACL
= NULL
;
1833 PSECURITY_DESCRIPTOR pSD
= NULL
;
1835 TCHAR username
[100];
1838 /* Get current user, he will act as the owner */
1840 if (!GetUserName (username
, &unsize
))
1843 if (GetNamedSecurityInfo
1846 DACL_SECURITY_INFORMATION
,
1847 NULL
, NULL
, &pOldDACL
, NULL
, &pSD
) != ERROR_SUCCESS
)
1850 BuildExplicitAccessWithName
1851 (&ea
, username
, AccessPermissions
, (ACCESS_MODE
) AccessMode
, NO_INHERITANCE
);
1853 if (AccessMode
== SET_ACCESS
)
1855 /* SET_ACCESS, we want to set an explicte set of permissions, do not
1856 merge with current DACL. */
1857 if (SetEntriesInAcl (1, &ea
, NULL
, &pNewDACL
) != ERROR_SUCCESS
)
1861 if (SetEntriesInAcl (1, &ea
, pOldDACL
, &pNewDACL
) != ERROR_SUCCESS
)
1864 if (SetNamedSecurityInfo
1865 (wname
, SE_FILE_OBJECT
,
1866 DACL_SECURITY_INFORMATION
, NULL
, NULL
, pNewDACL
, NULL
) != ERROR_SUCCESS
)
1870 LocalFree (pNewDACL
);
1873 /* Check if it is possible to use ACL for wname, the file must not be on a
1877 __gnat_can_use_acl (TCHAR
*wname
)
1879 return __gnat_use_acl
&& GetDriveTypeFromPath (wname
) != DRIVE_REMOTE
;
1882 #endif /* defined (_WIN32) */
1885 __gnat_is_readable_file_attr (char* name
, struct file_attributes
* attr
)
1887 if (attr
->readable
== ATTR_UNSET
)
1889 #if defined (_WIN32)
1890 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1891 GENERIC_MAPPING GenericMapping
;
1893 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1895 if (__gnat_can_use_acl (wname
))
1897 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1898 GenericMapping
.GenericRead
= GENERIC_READ
;
1900 __gnat_check_OWNER_ACL (wname
, FILE_READ_DATA
, GenericMapping
);
1903 attr
->readable
= GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
;
1905 __gnat_stat_to_attr (-1, name
, attr
);
1909 return attr
->readable
;
1913 __gnat_is_readable_file (char *name
)
1915 struct file_attributes attr
;
1917 __gnat_reset_attributes (&attr
);
1918 return __gnat_is_readable_file_attr (name
, &attr
);
1922 __gnat_is_writable_file_attr (char* name
, struct file_attributes
* attr
)
1924 if (attr
->writable
== ATTR_UNSET
)
1926 #if defined (_WIN32)
1927 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1928 GENERIC_MAPPING GenericMapping
;
1930 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1932 if (__gnat_can_use_acl (wname
))
1934 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1935 GenericMapping
.GenericWrite
= GENERIC_WRITE
;
1937 attr
->writable
= __gnat_check_OWNER_ACL
1938 (wname
, FILE_WRITE_DATA
| FILE_APPEND_DATA
, GenericMapping
)
1939 && !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
1943 !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
1946 __gnat_stat_to_attr (-1, name
, attr
);
1950 return attr
->writable
;
1954 __gnat_is_writable_file (char *name
)
1956 struct file_attributes attr
;
1958 __gnat_reset_attributes (&attr
);
1959 return __gnat_is_writable_file_attr (name
, &attr
);
1963 __gnat_is_executable_file_attr (char* name
, struct file_attributes
* attr
)
1965 if (attr
->executable
== ATTR_UNSET
)
1967 #if defined (_WIN32)
1968 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1969 GENERIC_MAPPING GenericMapping
;
1971 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1973 if (__gnat_can_use_acl (wname
))
1975 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1976 GenericMapping
.GenericExecute
= GENERIC_EXECUTE
;
1979 __gnat_check_OWNER_ACL (wname
, FILE_EXECUTE
, GenericMapping
);
1983 TCHAR
*l
, *last
= _tcsstr(wname
, _T(".exe"));
1985 /* look for last .exe */
1987 while ((l
= _tcsstr(last
+1, _T(".exe"))))
1991 GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
1992 && (last
- wname
) == (int) (_tcslen (wname
) - 4);
1995 __gnat_stat_to_attr (-1, name
, attr
);
1999 return attr
->regular
&& attr
->executable
;
2003 __gnat_is_executable_file (char *name
)
2005 struct file_attributes attr
;
2007 __gnat_reset_attributes (&attr
);
2008 return __gnat_is_executable_file_attr (name
, &attr
);
2012 __gnat_set_writable (char *name
)
2014 #if defined (_WIN32)
2015 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2017 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2019 if (__gnat_can_use_acl (wname
))
2020 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_WRITE
);
2023 (wname
, GetFileAttributes (wname
) & ~FILE_ATTRIBUTE_READONLY
);
2024 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2025 GNAT_STRUCT_STAT statbuf
;
2027 if (GNAT_STAT (name
, &statbuf
) == 0)
2029 statbuf
.st_mode
= statbuf
.st_mode
| S_IWUSR
;
2030 chmod (name
, statbuf
.st_mode
);
2035 /* must match definition in s-os_lib.ads */
2041 __gnat_set_executable (char *name
, int mode ATTRIBUTE_UNUSED
)
2043 #if defined (_WIN32)
2044 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2046 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2048 if (__gnat_can_use_acl (wname
))
2049 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_EXECUTE
);
2051 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2052 GNAT_STRUCT_STAT statbuf
;
2054 if (GNAT_STAT (name
, &statbuf
) == 0)
2057 statbuf
.st_mode
= statbuf
.st_mode
| S_IXUSR
;
2059 statbuf
.st_mode
= statbuf
.st_mode
| S_IXGRP
;
2060 if (mode
& S_OTHERS
)
2061 statbuf
.st_mode
= statbuf
.st_mode
| S_IXOTH
;
2062 chmod (name
, statbuf
.st_mode
);
2068 __gnat_set_non_writable (char *name
)
2070 #if defined (_WIN32)
2071 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2073 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2075 if (__gnat_can_use_acl (wname
))
2076 __gnat_set_OWNER_ACL
2077 (wname
, DENY_ACCESS
,
2078 FILE_WRITE_DATA
| FILE_APPEND_DATA
|
2079 FILE_WRITE_EA
| FILE_WRITE_ATTRIBUTES
);
2082 (wname
, GetFileAttributes (wname
) | FILE_ATTRIBUTE_READONLY
);
2083 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2084 GNAT_STRUCT_STAT statbuf
;
2086 if (GNAT_STAT (name
, &statbuf
) == 0)
2088 statbuf
.st_mode
= statbuf
.st_mode
& 07577;
2089 chmod (name
, statbuf
.st_mode
);
2095 __gnat_set_readable (char *name
)
2097 #if defined (_WIN32)
2098 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2100 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2102 if (__gnat_can_use_acl (wname
))
2103 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_READ
);
2105 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2106 GNAT_STRUCT_STAT statbuf
;
2108 if (GNAT_STAT (name
, &statbuf
) == 0)
2110 chmod (name
, statbuf
.st_mode
| S_IREAD
);
2116 __gnat_set_non_readable (char *name
)
2118 #if defined (_WIN32)
2119 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2121 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2123 if (__gnat_can_use_acl (wname
))
2124 __gnat_set_OWNER_ACL (wname
, DENY_ACCESS
, FILE_GENERIC_READ
);
2126 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2127 GNAT_STRUCT_STAT statbuf
;
2129 if (GNAT_STAT (name
, &statbuf
) == 0)
2131 chmod (name
, statbuf
.st_mode
& (~S_IREAD
));
2137 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED
,
2138 struct file_attributes
* attr
)
2140 if (attr
->symbolic_link
== ATTR_UNSET
)
2142 #if defined (__vxworks)
2143 attr
->symbolic_link
= 0;
2145 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2147 GNAT_STRUCT_STAT statbuf
;
2148 ret
= GNAT_LSTAT (name
, &statbuf
);
2149 attr
->symbolic_link
= (!ret
&& S_ISLNK (statbuf
.st_mode
));
2151 attr
->symbolic_link
= 0;
2154 return attr
->symbolic_link
;
2158 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED
)
2160 struct file_attributes attr
;
2162 __gnat_reset_attributes (&attr
);
2163 return __gnat_is_symbolic_link_attr (name
, &attr
);
2166 #if defined (__sun__)
2167 /* Using fork on Solaris will duplicate all the threads. fork1, which
2168 duplicates only the active thread, must be used instead, or spawning
2169 subprocess from a program with tasking will lead into numerous problems. */
2174 __gnat_portable_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2176 int status ATTRIBUTE_UNUSED
= 0;
2177 int finished ATTRIBUTE_UNUSED
;
2178 int pid ATTRIBUTE_UNUSED
;
2180 #if defined (__vxworks) || defined(__PikeOS__)
2183 #elif defined (_WIN32)
2184 /* args[0] must be quotes as it could contain a full pathname with spaces */
2185 char *args_0
= args
[0];
2186 args
[0] = (char *)xmalloc (strlen (args_0
) + 3);
2187 strcpy (args
[0], "\"");
2188 strcat (args
[0], args_0
);
2189 strcat (args
[0], "\"");
2191 status
= spawnvp (P_WAIT
, args_0
, (char ** const)args
);
2193 /* restore previous value */
2195 args
[0] = (char *)args_0
;
2211 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2216 finished
= waitpid (pid
, &status
, 0);
2218 if (finished
!= pid
|| WIFEXITED (status
) == 0)
2221 return WEXITSTATUS (status
);
2227 /* Create a copy of the given file descriptor.
2228 Return -1 if an error occurred. */
2231 __gnat_dup (int oldfd
)
2233 #if defined (__vxworks) && !defined (__RTP__)
2234 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2242 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2243 Return -1 if an error occurred. */
2246 __gnat_dup2 (int oldfd ATTRIBUTE_UNUSED
, int newfd ATTRIBUTE_UNUSED
)
2248 #if defined (__vxworks) && !defined (__RTP__)
2249 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2252 #elif defined (__PikeOS__)
2253 /* Not supported. */
2255 #elif defined (_WIN32)
2256 /* Special case when oldfd and newfd are identical and are the standard
2257 input, output or error as this makes Windows XP hangs. Note that we
2258 do that only for standard file descriptors that are known to be valid. */
2259 if (oldfd
== newfd
&& newfd
>= 0 && newfd
<= 2)
2262 return dup2 (oldfd
, newfd
);
2264 return dup2 (oldfd
, newfd
);
2269 __gnat_number_of_cpus (void)
2273 #if defined (__linux__) || defined (__sun__) || defined (_AIX) \
2274 || defined (__APPLE__) || defined (__FreeBSD__) || defined (__OpenBSD__) \
2275 || defined (__DragonFly__) || defined (__NetBSD__)
2276 cores
= (int) sysconf (_SC_NPROCESSORS_ONLN
);
2278 #elif defined (__hpux__)
2279 struct pst_dynamic psd
;
2280 if (pstat_getdynamic (&psd
, sizeof (psd
), 1, 0) != -1)
2281 cores
= (int) psd
.psd_proc_cnt
;
2283 #elif defined (_WIN32)
2284 SYSTEM_INFO sysinfo
;
2285 GetSystemInfo (&sysinfo
);
2286 cores
= (int) sysinfo
.dwNumberOfProcessors
;
2288 #elif defined (_WRS_CONFIG_SMP)
2289 unsigned int vxCpuConfiguredGet (void);
2291 cores
= vxCpuConfiguredGet ();
2298 /* WIN32 code to implement a wait call that wait for any child process. */
2300 #if defined (_WIN32)
2302 /* Synchronization code, to be thread safe. */
2306 /* For the Cert run times on native Windows we use dummy functions
2307 for locking and unlocking tasks since we do not support multiple
2308 threads on this configuration (Cert run time on native Windows). */
2310 static void EnterCS (void) {}
2311 static void LeaveCS (void) {}
2312 static void SignalListChanged (void) {}
2316 CRITICAL_SECTION ProcListCS
;
2317 HANDLE ProcListEvt
= NULL
;
2319 static void EnterCS (void)
2321 EnterCriticalSection(&ProcListCS
);
2324 static void LeaveCS (void)
2326 LeaveCriticalSection(&ProcListCS
);
2329 static void SignalListChanged (void)
2331 SetEvent (ProcListEvt
);
2336 static HANDLE
*HANDLES_LIST
= NULL
;
2337 static int *PID_LIST
= NULL
, plist_length
= 0, plist_max_length
= 0;
2340 add_handle (HANDLE h
, int pid
)
2342 /* -------------------- critical section -------------------- */
2345 if (plist_length
== plist_max_length
)
2347 plist_max_length
+= 100;
2349 (HANDLE
*) xrealloc (HANDLES_LIST
, sizeof (HANDLE
) * plist_max_length
);
2351 (int *) xrealloc (PID_LIST
, sizeof (int) * plist_max_length
);
2354 HANDLES_LIST
[plist_length
] = h
;
2355 PID_LIST
[plist_length
] = pid
;
2358 SignalListChanged();
2360 /* -------------------- critical section -------------------- */
2364 __gnat_win32_remove_handle (HANDLE h
, int pid
)
2369 /* -------------------- critical section -------------------- */
2372 for (j
= 0; j
< plist_length
; j
++)
2374 if ((HANDLES_LIST
[j
] == h
) || (PID_LIST
[j
] == pid
))
2378 HANDLES_LIST
[j
] = HANDLES_LIST
[plist_length
];
2379 PID_LIST
[j
] = PID_LIST
[plist_length
];
2386 /* -------------------- critical section -------------------- */
2389 SignalListChanged();
2395 win32_no_block_spawn (char *command
, char *args
[], HANDLE
*h
, int *pid
)
2399 PROCESS_INFORMATION PI
;
2400 SECURITY_ATTRIBUTES SA
;
2405 /* compute the total command line length */
2409 csize
+= strlen (args
[k
]) + 1;
2413 full_command
= (char *) xmalloc (csize
);
2416 SI
.cb
= sizeof (STARTUPINFO
);
2417 SI
.lpReserved
= NULL
;
2418 SI
.lpReserved2
= NULL
;
2419 SI
.lpDesktop
= NULL
;
2423 SI
.wShowWindow
= SW_HIDE
;
2425 /* Security attributes. */
2426 SA
.nLength
= sizeof (SECURITY_ATTRIBUTES
);
2427 SA
.bInheritHandle
= TRUE
;
2428 SA
.lpSecurityDescriptor
= NULL
;
2430 /* Prepare the command string. */
2431 strcpy (full_command
, command
);
2432 strcat (full_command
, " ");
2437 strcat (full_command
, args
[k
]);
2438 strcat (full_command
, " ");
2443 int wsize
= csize
* 2;
2444 TCHAR
*wcommand
= (TCHAR
*) xmalloc (wsize
);
2446 S2WSC (wcommand
, full_command
, wsize
);
2448 free (full_command
);
2450 result
= CreateProcess
2451 (NULL
, wcommand
, &SA
, NULL
, TRUE
,
2452 GetPriorityClass (GetCurrentProcess()), NULL
, NULL
, &SI
, &PI
);
2459 CloseHandle (PI
.hThread
);
2461 *pid
= PI
.dwProcessId
;
2471 win32_wait (int *status
)
2473 DWORD exitcode
, pid
;
2483 if (plist_length
== 0)
2489 /* -------------------- critical section -------------------- */
2492 hl_len
= plist_length
;
2495 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * hl_len
);
2496 memmove (hl
, HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2497 pidl
= (int *) xmalloc (sizeof (int) * hl_len
);
2498 memmove (pidl
, PID_LIST
, sizeof (int) * hl_len
);
2500 /* Note that index 0 contains the event handle that is signaled when the
2501 process list has changed */
2502 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * hl_len
+ 1);
2503 hl
[0] = ProcListEvt
;
2504 memmove (&hl
[1], HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2505 pidl
= (int *) xmalloc (sizeof (int) * hl_len
+ 1);
2506 memmove (&pidl
[1], PID_LIST
, sizeof (int) * hl_len
);
2511 /* -------------------- critical section -------------------- */
2513 res
= WaitForMultipleObjects (hl_len
, hl
, FALSE
, INFINITE
);
2515 /* if the ProcListEvt has been signaled then the list of processes has been
2516 updated to add or remove a handle, just loop over */
2518 if (res
- WAIT_OBJECT_0
== 0)
2525 h
= hl
[res
- WAIT_OBJECT_0
];
2526 GetExitCodeProcess (h
, &exitcode
);
2527 pid
= pidl
[res
- WAIT_OBJECT_0
];
2529 found
= __gnat_win32_remove_handle (h
, -1);
2534 /* if not found another process waiting has already handled this process */
2541 *status
= (int) exitcode
;
2548 __gnat_portable_no_block_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2551 #if defined (__vxworks) || defined (__PikeOS__)
2552 /* Not supported. */
2555 #elif defined (_WIN32)
2560 win32_no_block_spawn (args
[0], args
, &h
, &pid
);
2563 add_handle (h
, pid
);
2576 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2586 __gnat_portable_wait (int *process_status
)
2591 #if defined (__vxworks) || defined (__PikeOS__)
2592 /* Not sure what to do here, so do nothing but return zero. */
2594 #elif defined (_WIN32)
2596 pid
= win32_wait (&status
);
2600 pid
= waitpid (-1, &status
, 0);
2601 status
= status
& 0xffff;
2604 *process_status
= status
;
2609 __gnat_os_exit (int status
)
2614 /* Locate file on path, that matches a predicate */
2617 __gnat_locate_file_with_predicate (char *file_name
, char *path_val
,
2618 int (*predicate
)(char *))
2621 char *file_path
= (char *) alloca (strlen (file_name
) + 1);
2624 /* Return immediately if file_name is empty */
2626 if (*file_name
== '\0')
2629 /* Remove quotes around file_name if present */
2635 strcpy (file_path
, ptr
);
2637 ptr
= file_path
+ strlen (file_path
) - 1;
2642 /* Handle absolute pathnames. */
2644 absolute
= __gnat_is_absolute_path (file_path
, strlen (file_name
));
2648 if (predicate (file_path
))
2649 return xstrdup (file_path
);
2654 /* If file_name include directory separator(s), try it first as
2655 a path name relative to the current directory */
2656 for (ptr
= file_name
; *ptr
&& *ptr
!= '/' && *ptr
!= DIR_SEPARATOR
; ptr
++)
2661 if (predicate (file_name
))
2662 return xstrdup (file_name
);
2669 /* The result has to be smaller than path_val + file_name. */
2671 (char *) alloca (strlen (path_val
) + strlen (file_name
) + 2);
2675 /* Skip the starting quote */
2677 if (*path_val
== '"')
2680 for (ptr
= file_path
; *path_val
&& *path_val
!= PATH_SEPARATOR
; )
2681 *ptr
++ = *path_val
++;
2683 /* If directory is empty, it is the current directory*/
2685 if (ptr
== file_path
)
2692 /* Skip the ending quote */
2697 if (*ptr
!= '/' && *ptr
!= DIR_SEPARATOR
)
2698 *++ptr
= DIR_SEPARATOR
;
2700 strcpy (++ptr
, file_name
);
2702 if (predicate (file_path
))
2703 return xstrdup (file_path
);
2708 /* Skip path separator */
2717 /* Locate an executable file, give a Path value. */
2720 __gnat_locate_executable_file (char *file_name
, char *path_val
)
2722 return __gnat_locate_file_with_predicate
2723 (file_name
, path_val
, &__gnat_is_executable_file
);
2726 /* Locate a regular file, give a Path value. */
2729 __gnat_locate_regular_file (char *file_name
, char *path_val
)
2731 return __gnat_locate_file_with_predicate
2732 (file_name
, path_val
, &__gnat_is_regular_file
);
2735 /* Locate an executable given a Path argument. This routine is only used by
2736 gnatbl and should not be used otherwise. Use locate_exec_on_path
2740 __gnat_locate_exec (char *exec_name
, char *path_val
)
2743 if (!strstr (exec_name
, HOST_EXECUTABLE_SUFFIX
))
2745 char *full_exec_name
=
2747 (strlen (exec_name
) + strlen (HOST_EXECUTABLE_SUFFIX
) + 1);
2749 strcpy (full_exec_name
, exec_name
);
2750 strcat (full_exec_name
, HOST_EXECUTABLE_SUFFIX
);
2751 ptr
= __gnat_locate_executable_file (full_exec_name
, path_val
);
2754 return __gnat_locate_executable_file (exec_name
, path_val
);
2758 return __gnat_locate_executable_file (exec_name
, path_val
);
2761 /* Locate an executable using the Systems default PATH. */
2764 __gnat_locate_exec_on_path (char *exec_name
)
2768 #if defined (_WIN32)
2769 TCHAR
*wpath_val
= _tgetenv (_T("PATH"));
2771 /* In Win32 systems we expand the PATH as for XP environment
2772 variables are not automatically expanded. We also prepend the
2773 ".;" to the path to match normal NT path search semantics */
2775 #define EXPAND_BUFFER_SIZE 32767
2777 wapath_val
= (TCHAR
*) alloca (EXPAND_BUFFER_SIZE
);
2779 wapath_val
[0] = '.';
2780 wapath_val
[1] = ';';
2782 DWORD res
= ExpandEnvironmentStrings
2783 (wpath_val
, &wapath_val
[2], EXPAND_BUFFER_SIZE
- 2);
2785 if (!res
) wapath_val
[0] = _T('\0');
2787 apath_val
= (char *) alloca (EXPAND_BUFFER_SIZE
);
2789 WS2SC (apath_val
, wapath_val
, EXPAND_BUFFER_SIZE
);
2792 char *path_val
= getenv ("PATH");
2794 /* If PATH is not defined, proceed with __gnat_locate_exec anyway, so we can
2795 find files that contain directory names. */
2797 if (path_val
== NULL
) path_val
= "";
2798 apath_val
= (char *) alloca (strlen (path_val
) + 1);
2799 strcpy (apath_val
, path_val
);
2802 return __gnat_locate_exec (exec_name
, apath_val
);
2805 /* Dummy functions for Osint import for non-VMS systems.
2806 ??? To be removed. */
2809 __gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED
,
2810 int onlydirs ATTRIBUTE_UNUSED
)
2816 __gnat_to_canonical_file_list_next (void)
2818 static char empty
[] = "";
2823 __gnat_to_canonical_file_list_free (void)
2828 __gnat_to_canonical_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2834 __gnat_to_canonical_file_spec (char *filespec
)
2840 __gnat_to_canonical_path_spec (char *pathspec
)
2846 __gnat_to_host_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2852 __gnat_to_host_file_spec (char *filespec
)
2858 __gnat_adjust_os_resource_limits (void)
2862 #if defined (__mips_vxworks)
2866 CACHE_USER_FLUSH (0, ENTIRE_CACHE
);
2870 #if defined (_WIN32)
2871 int __gnat_argument_needs_quote
= 1;
2873 int __gnat_argument_needs_quote
= 0;
2876 /* This option is used to enable/disable object files handling from the
2877 binder file by the GNAT Project module. For example, this is disabled on
2878 Windows (prior to GCC 3.4) as it is already done by the mdll module.
2879 Stating with GCC 3.4 the shared libraries are not based on mdll
2880 anymore as it uses the GCC's -shared option */
2881 #if defined (_WIN32) \
2882 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
2883 int __gnat_prj_add_obj_files
= 0;
2885 int __gnat_prj_add_obj_files
= 1;
2888 /* char used as prefix/suffix for environment variables */
2889 #if defined (_WIN32)
2890 char __gnat_environment_char
= '%';
2892 char __gnat_environment_char
= '$';
2895 /* This functions copy the file attributes from a source file to a
2898 mode = 0 : In this mode copy only the file time stamps (last access and
2899 last modification time stamps).
2901 mode = 1 : In this mode, time stamps and read/write/execute attributes are
2904 Returns 0 if operation was successful and -1 in case of error. */
2907 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED
, char *to ATTRIBUTE_UNUSED
,
2908 int mode ATTRIBUTE_UNUSED
)
2910 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6)
2913 #elif defined (_WIN32)
2914 TCHAR wfrom
[GNAT_MAX_PATH_LEN
+ 2];
2915 TCHAR wto
[GNAT_MAX_PATH_LEN
+ 2];
2917 FILETIME fct
, flat
, flwt
;
2920 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
+ 2);
2921 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
+ 2);
2923 /* retrieve from times */
2926 (wfrom
, GENERIC_READ
, 0, NULL
, OPEN_EXISTING
, FILE_ATTRIBUTE_NORMAL
, NULL
);
2928 if (hfrom
== INVALID_HANDLE_VALUE
)
2931 res
= GetFileTime (hfrom
, &fct
, &flat
, &flwt
);
2933 CloseHandle (hfrom
);
2938 /* retrieve from times */
2941 (wto
, GENERIC_WRITE
, 0, NULL
, OPEN_EXISTING
, FILE_ATTRIBUTE_NORMAL
, NULL
);
2943 if (hto
== INVALID_HANDLE_VALUE
)
2946 res
= SetFileTime (hto
, NULL
, &flat
, &flwt
);
2953 /* Set file attributes in full mode. */
2957 DWORD attribs
= GetFileAttributes (wfrom
);
2959 if (attribs
== INVALID_FILE_ATTRIBUTES
)
2962 res
= SetFileAttributes (wto
, attribs
);
2970 GNAT_STRUCT_STAT fbuf
;
2971 struct utimbuf tbuf
;
2973 if (GNAT_STAT (from
, &fbuf
) == -1)
2978 tbuf
.actime
= fbuf
.st_atime
;
2979 tbuf
.modtime
= fbuf
.st_mtime
;
2981 if (utime (to
, &tbuf
) == -1)
2988 if (chmod (to
, fbuf
.st_mode
) == -1)
2999 __gnat_lseek (int fd
, long offset
, int whence
)
3001 return (int) lseek (fd
, offset
, whence
);
3004 /* This function returns the major version number of GCC being used. */
3006 get_gcc_version (void)
3011 return (int) (version_string
[0] - '0');
3016 * Set Close_On_Exec as indicated.
3017 * Note: this is used for both GNAT.OS_Lib and GNAT.Sockets.
3021 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED
,
3022 int close_on_exec_p ATTRIBUTE_UNUSED
)
3024 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
3025 int flags
= fcntl (fd
, F_GETFD
, 0);
3028 if (close_on_exec_p
)
3029 flags
|= FD_CLOEXEC
;
3031 flags
&= ~FD_CLOEXEC
;
3032 return fcntl (fd
, F_SETFD
, flags
);
3033 #elif defined(_WIN32)
3034 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
3035 if (h
== (HANDLE
) -1)
3037 if (close_on_exec_p
)
3038 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
, 0);
3039 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
,
3040 HANDLE_FLAG_INHERIT
);
3042 /* TODO: Unimplemented. */
3047 /* Indicates if platforms supports automatic initialization through the
3048 constructor mechanism */
3050 __gnat_binder_supports_auto_init (void)
3055 /* Indicates that Stand-Alone Libraries are automatically initialized through
3056 the constructor mechanism */
3058 __gnat_sals_init_using_constructors (void)
3060 #if defined (__vxworks) || defined (__Lynx__)
3067 #if defined (__linux__) || defined (__ANDROID__)
3068 /* There is no function in the glibc to retrieve the LWP of the current
3069 thread. We need to do a system call in order to retrieve this
3071 #include <sys/syscall.h>
3073 __gnat_lwp_self (void)
3075 return (void *) syscall (__NR_gettid
);
3079 #if defined (__linux__)
3082 /* glibc versions earlier than 2.7 do not define the routines to handle
3083 dynamically allocated CPU sets. For these targets, we use the static
3088 /* Dynamic cpu sets */
3091 __gnat_cpu_alloc (size_t count
)
3093 return CPU_ALLOC (count
);
3097 __gnat_cpu_alloc_size (size_t count
)
3099 return CPU_ALLOC_SIZE (count
);
3103 __gnat_cpu_free (cpu_set_t
*set
)
3109 __gnat_cpu_zero (size_t count
, cpu_set_t
*set
)
3111 CPU_ZERO_S (count
, set
);
3115 __gnat_cpu_set (int cpu
, size_t count
, cpu_set_t
*set
)
3117 /* Ada handles CPU numbers starting from 1, while C identifies the first
3118 CPU by a 0, so we need to adjust. */
3119 CPU_SET_S (cpu
- 1, count
, set
);
3122 #else /* !CPU_ALLOC */
3124 /* Static cpu sets */
3127 __gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED
)
3129 return (cpu_set_t
*) xmalloc (sizeof (cpu_set_t
));
3133 __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED
)
3135 return sizeof (cpu_set_t
);
3139 __gnat_cpu_free (cpu_set_t
*set
)
3145 __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3151 __gnat_cpu_set (int cpu
, size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3153 /* Ada handles CPU numbers starting from 1, while C identifies the first
3154 CPU by a 0, so we need to adjust. */
3155 CPU_SET (cpu
- 1, set
);
3157 #endif /* !CPU_ALLOC */
3158 #endif /* __linux__ */
3160 /* Return the load address of the executable, or 0 if not known. In the
3161 specific case of error, (void *)-1 can be returned. Beware: this unit may
3162 be in a shared library. As low-level units are needed, we allow #include
3165 #if defined (__APPLE__)
3166 #include <mach-o/dyld.h>
3170 __gnat_get_executable_load_address (void)
3172 #if defined (__APPLE__)
3173 return _dyld_get_image_header (0);
3175 #elif 0 && defined (__linux__)
3176 /* Currently disabled as it needs at least -ldl. */
3177 struct link_map
*map
= _r_debug
.r_map
;
3179 return (const void *)map
->l_addr
;