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. */
43 /* No need to redefine exit here. */
46 /* We want to use the POSIX variants of include files. */
50 #if defined (__mips_vxworks)
52 #endif /* __mips_vxworks */
54 /* If SMP, access vxCpuConfiguredGet */
55 #ifdef _WRS_CONFIG_SMP
57 #endif /* _WRS_CONFIG_SMP */
59 /* We need to know the VxWorks version because some file operations
60 (such as chmod) are only available on VxWorks 6. */
65 #if defined (__APPLE__)
69 #if defined (__hpux__)
70 #include <sys/param.h>
71 #include <sys/pstat.h>
75 #define __BSD_VISIBLE 1
85 #if defined (__vxworks) || defined (__ANDROID__)
86 /* S_IREAD and S_IWRITE are not defined in VxWorks or Android */
88 #define S_IREAD (S_IRUSR | S_IRGRP | S_IROTH)
92 #define S_IWRITE (S_IWUSR)
96 /* We don't have libiberty, so use malloc. */
97 #define xmalloc(S) malloc (S)
98 #define xrealloc(V,S) realloc (V,S)
109 #if defined (__MINGW32__) || defined (__CYGWIN__)
117 /* Current code page and CCS encoding to use, set in initialize.c. */
118 UINT CurrentCodePage
;
119 UINT CurrentCCSEncoding
;
122 #include <sys/utime.h>
124 /* For isalpha-like tests in the compiler, we're expected to resort to
125 safe-ctype.h/ISALPHA. This isn't available for the runtime library
126 build, so we fallback on ctype.h/isalpha there. */
130 #define ISALPHA isalpha
133 #elif defined (__Lynx__)
135 /* Lynx utime.h only defines the entities of interest to us if
136 defined (VMOS_DEV), so ... */
145 /* wait.h processing */
148 # include <sys/wait.h>
150 #elif defined (__vxworks) && defined (__RTP__)
152 #elif defined (__Lynx__)
153 /* ??? We really need wait.h and it includes resource.h on Lynx. GCC
154 has a resource.h header as well, included instead of the lynx
155 version in our setup, causing lots of errors. We don't really need
156 the lynx contents of this file, so just workaround the issue by
157 preventing the inclusion of the GCC header from doing anything. */
158 # define GCC_RESOURCE_H
159 # include <sys/wait.h>
160 #elif defined (__nucleus__) || defined (__PikeOS__)
161 /* No wait() or waitpid() calls available. */
164 #include <sys/wait.h>
175 #define DIR_SEPARATOR '\\'
183 /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
184 defined in the current system. On DOS-like systems these flags control
185 whether the file is opened/created in text-translation mode (CR/LF in
186 external file mapped to LF in internal file), but in Unix-like systems,
187 no text translation is required, so these flags have no effect. */
197 #ifndef HOST_EXECUTABLE_SUFFIX
198 #define HOST_EXECUTABLE_SUFFIX ""
201 #ifndef HOST_OBJECT_SUFFIX
202 #define HOST_OBJECT_SUFFIX ".o"
205 #ifndef PATH_SEPARATOR
206 #define PATH_SEPARATOR ':'
209 #ifndef DIR_SEPARATOR
210 #define DIR_SEPARATOR '/'
213 /* Check for cross-compilation. */
214 #if defined (CROSS_COMPILE) || defined (CROSS_DIRECTORY_STRUCTURE)
216 int __gnat_is_cross_compiler
= 1;
219 int __gnat_is_cross_compiler
= 0;
222 char __gnat_dir_separator
= DIR_SEPARATOR
;
224 char __gnat_path_separator
= PATH_SEPARATOR
;
226 /* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
227 the base filenames that libraries specified with -lsomelib options
228 may have. This is used by GNATMAKE to check whether an executable
229 is up-to-date or not. The syntax is
231 library_template ::= { pattern ; } pattern NUL
232 pattern ::= [ prefix ] * [ postfix ]
234 These should only specify names of static libraries as it makes
235 no sense to determine at link time if dynamic-link libraries are
236 up to date or not. Any libraries that are not found are supposed
239 * if they are needed but not present, the link
242 * otherwise they are libraries in the system paths and so
243 they are considered part of the system and not checked
246 ??? This should be part of a GNAT host-specific compiler
247 file instead of being included in all user applications
248 as well. This is only a temporary work-around for 3.11b. */
250 #ifndef GNAT_LIBRARY_TEMPLATE
251 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
254 const char *__gnat_library_template
= GNAT_LIBRARY_TEMPLATE
;
256 #if defined (__vxworks) || defined (__OPENNT) || defined(__nucleus__)
257 #define GNAT_MAX_PATH_LEN PATH_MAX
261 #if defined (__MINGW32__)
265 #include <sys/param.h>
269 #include <sys/param.h>
273 #define GNAT_MAX_PATH_LEN MAXPATHLEN
275 #define GNAT_MAX_PATH_LEN 256
280 /* Used for runtime check that Ada constant File_Attributes_Size is no
281 less than the actual size of struct file_attributes (see Osint
283 int __gnat_size_of_file_attributes
= sizeof (struct file_attributes
);
285 void __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
);
287 /* The __gnat_max_path_len variable is used to export the maximum
288 length of a path name to Ada code. max_path_len is also provided
289 for compatibility with older GNAT versions, please do not use
292 int __gnat_max_path_len
= GNAT_MAX_PATH_LEN
;
293 int max_path_len
= GNAT_MAX_PATH_LEN
;
295 /* Control whether we can use ACL on Windows. */
297 int __gnat_use_acl
= 1;
299 /* The following macro HAVE_READDIR_R should be defined if the
300 system provides the routine readdir_r.
301 ... but we never define it anywhere??? */
302 #undef HAVE_READDIR_R
304 #define MAYBE_TO_PTR32(argv) argv
306 static const char ATTR_UNSET
= 127;
308 /* Reset the file attributes as if no system call had been performed */
311 __gnat_reset_attributes (struct file_attributes
* attr
)
313 attr
->exists
= ATTR_UNSET
;
314 attr
->error
= EINVAL
;
316 attr
->writable
= ATTR_UNSET
;
317 attr
->readable
= ATTR_UNSET
;
318 attr
->executable
= ATTR_UNSET
;
320 attr
->regular
= ATTR_UNSET
;
321 attr
->symbolic_link
= ATTR_UNSET
;
322 attr
->directory
= ATTR_UNSET
;
324 attr
->timestamp
= (OS_Time
)-2;
325 attr
->file_length
= -1;
329 __gnat_error_attributes (struct file_attributes
*attr
) {
334 __gnat_current_time (void)
336 time_t res
= time (NULL
);
337 return (OS_Time
) res
;
340 /* Return the current local time as a string in the ISO 8601 format of
341 "YYYY-MM-DD HH:MM:SS.SS". The returned string is 22 + 1 (NULL) characters
345 __gnat_current_time_string (char *result
)
347 const char *format
= "%Y-%m-%d %H:%M:%S";
348 /* Format string necessary to describe the ISO 8601 format */
350 const time_t t_val
= time (NULL
);
352 strftime (result
, 22, format
, localtime (&t_val
));
353 /* Convert the local time into a string following the ISO format, copying
354 at most 22 characters into the result string. */
359 /* The sub-seconds are manually set to zero since type time_t lacks the
360 precision necessary for nanoseconds. */
364 __gnat_to_gm_time (OS_Time
*p_time
, int *p_year
, int *p_month
, int *p_day
,
365 int *p_hours
, int *p_mins
, int *p_secs
)
368 time_t time
= (time_t) *p_time
;
371 /* On Windows systems, the time is sometimes rounded up to the nearest
372 even second, so if the number of seconds is odd, increment it. */
377 res
= gmtime (&time
);
380 *p_year
= res
->tm_year
;
381 *p_month
= res
->tm_mon
;
382 *p_day
= res
->tm_mday
;
383 *p_hours
= res
->tm_hour
;
384 *p_mins
= res
->tm_min
;
385 *p_secs
= res
->tm_sec
;
388 *p_year
= *p_month
= *p_day
= *p_hours
= *p_mins
= *p_secs
= 0;
392 __gnat_to_os_time (OS_Time
*p_time
, int year
, int month
, int day
,
393 int hours
, int mins
, int secs
)
405 /* returns -1 of failing, this is s-os_lib Invalid_Time */
407 *p_time
= (OS_Time
) mktime (&v
);
410 /* Place the contents of the symbolic link named PATH in the buffer BUF,
411 which has size BUFSIZ. If PATH is a symbolic link, then return the number
412 of characters of its content in BUF. Otherwise, return -1.
413 For systems not supporting symbolic links, always return -1. */
416 __gnat_readlink (char *path ATTRIBUTE_UNUSED
,
417 char *buf ATTRIBUTE_UNUSED
,
418 size_t bufsiz ATTRIBUTE_UNUSED
)
420 #if defined (_WIN32) \
421 || defined(__vxworks) || defined (__nucleus__) || defined (__PikeOS__)
424 return readlink (path
, buf
, bufsiz
);
428 /* Creates a symbolic link named NEWPATH which contains the string OLDPATH.
429 If NEWPATH exists it will NOT be overwritten.
430 For systems not supporting symbolic links, always return -1. */
433 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED
,
434 char *newpath ATTRIBUTE_UNUSED
)
436 #if defined (_WIN32) \
437 || defined(__vxworks) || defined (__nucleus__) || defined (__PikeOS__)
440 return symlink (oldpath
, newpath
);
444 /* Try to lock a file, return 1 if success. */
446 #if defined (__vxworks) || defined (__nucleus__) \
447 || defined (_WIN32) || defined (__PikeOS__)
449 /* Version that does not use link. */
452 __gnat_try_lock (char *dir
, char *file
)
456 TCHAR wfull_path
[GNAT_MAX_PATH_LEN
];
457 TCHAR wfile
[GNAT_MAX_PATH_LEN
];
458 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
460 S2WSC (wdir
, dir
, GNAT_MAX_PATH_LEN
);
461 S2WSC (wfile
, file
, GNAT_MAX_PATH_LEN
);
463 /* ??? the code below crash on MingW64 for obscure reasons, a ticket
464 has been opened here:
466 https://sourceforge.net/p/mingw-w64/bugs/414/
468 As a workaround an equivalent set of code has been put in place below.
470 _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
473 _tcscpy (wfull_path
, wdir
);
474 _tcscat (wfull_path
, L
"\\");
475 _tcscat (wfull_path
, wfile
);
477 fd
= _topen (wfull_path
, O_CREAT
| O_EXCL
, 0600);
481 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
482 fd
= open (full_path
, O_CREAT
| O_EXCL
, 0600);
494 /* Version using link(), more secure over NFS. */
495 /* See TN 6913-016 for discussion ??? */
498 __gnat_try_lock (char *dir
, char *file
)
502 GNAT_STRUCT_STAT stat_result
;
505 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
506 sprintf (temp_file
, "%s%cTMP-%ld-%ld",
507 dir
, DIR_SEPARATOR
, (long)getpid(), (long)getppid ());
509 /* Create the temporary file and write the process number. */
510 fd
= open (temp_file
, O_CREAT
| O_WRONLY
, 0600);
516 /* Link it with the new file. */
517 link (temp_file
, full_path
);
519 /* Count the references on the old one. If we have a count of two, then
520 the link did succeed. Remove the temporary file before returning. */
521 __gnat_stat (temp_file
, &stat_result
);
523 return stat_result
.st_nlink
== 2;
527 /* Return the maximum file name length. */
530 __gnat_get_maximum_file_name_length (void)
535 /* Return nonzero if file names are case sensitive. */
537 static int file_names_case_sensitive_cache
= -1;
540 __gnat_get_file_names_case_sensitive (void)
542 if (file_names_case_sensitive_cache
== -1)
544 const char *sensitive
= getenv ("GNAT_FILE_NAME_CASE_SENSITIVE");
546 if (sensitive
!= NULL
547 && (sensitive
[0] == '0' || sensitive
[0] == '1')
548 && sensitive
[1] == '\0')
549 file_names_case_sensitive_cache
= sensitive
[0] - '0';
552 /* By default, we suppose filesystems aren't case sensitive on
553 Windows and Darwin (but they are on arm-darwin). */
554 #if defined (WINNT) || (defined (__APPLE__) && !defined (__arm__))
555 file_names_case_sensitive_cache
= 0;
557 file_names_case_sensitive_cache
= 1;
561 return file_names_case_sensitive_cache
;
564 /* Return nonzero if environment variables are case sensitive. */
567 __gnat_get_env_vars_case_sensitive (void)
577 __gnat_get_default_identifier_character_set (void)
582 /* Return the current working directory. */
585 __gnat_get_current_dir (char *dir
, int *length
)
587 #if defined (__MINGW32__)
588 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
590 _tgetcwd (wdir
, *length
);
592 WS2SC (dir
, wdir
, GNAT_MAX_PATH_LEN
);
595 getcwd (dir
, *length
);
598 *length
= strlen (dir
);
600 if (dir
[*length
- 1] != DIR_SEPARATOR
)
602 dir
[*length
] = DIR_SEPARATOR
;
608 /* Return the suffix for object files. */
611 __gnat_get_object_suffix_ptr (int *len
, const char **value
)
613 *value
= HOST_OBJECT_SUFFIX
;
618 *len
= strlen (*value
);
623 /* Return the suffix for executable files. */
626 __gnat_get_executable_suffix_ptr (int *len
, const char **value
)
628 *value
= HOST_EXECUTABLE_SUFFIX
;
632 *len
= strlen (*value
);
637 /* Return the suffix for debuggable files. Usually this is the same as the
638 executable extension. */
641 __gnat_get_debuggable_suffix_ptr (int *len
, const char **value
)
643 *value
= HOST_EXECUTABLE_SUFFIX
;
648 *len
= strlen (*value
);
653 /* Returns the OS filename and corresponding encoding. */
656 __gnat_os_filename (char *filename ATTRIBUTE_UNUSED
,
657 char *w_filename ATTRIBUTE_UNUSED
,
658 char *os_name
, int *o_length
,
659 char *encoding ATTRIBUTE_UNUSED
, int *e_length
)
661 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
662 WS2SC (os_name
, (TCHAR
*)w_filename
, (DWORD
)*o_length
);
663 *o_length
= strlen (os_name
);
664 strcpy (encoding
, "encoding=utf8");
665 *e_length
= strlen (encoding
);
667 strcpy (os_name
, filename
);
668 *o_length
= strlen (filename
);
676 __gnat_unlink (char *path
)
678 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
680 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
682 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
683 return _tunlink (wpath
);
686 return unlink (path
);
693 __gnat_rename (char *from
, char *to
)
695 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
697 TCHAR wfrom
[GNAT_MAX_PATH_LEN
], wto
[GNAT_MAX_PATH_LEN
];
699 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
);
700 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
);
701 return _trename (wfrom
, wto
);
704 return rename (from
, to
);
708 /* Changing directory. */
711 __gnat_chdir (char *path
)
713 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
715 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
717 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
718 return _tchdir (wpath
);
725 /* Removing a directory. */
728 __gnat_rmdir (char *path
)
730 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
732 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
734 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
735 return _trmdir (wpath
);
737 #elif defined (VTHREADS)
738 /* rmdir not available */
745 #if defined (_WIN32) || defined (linux) || defined (sun) \
746 || defined (__FreeBSD__)
747 #define HAS_TARGET_WCHAR_T
750 #ifdef HAS_TARGET_WCHAR_T
755 __gnat_fputwc(int c
, FILE *stream
)
757 #ifdef HAS_TARGET_WCHAR_T
758 return fputwc ((wchar_t)c
, stream
);
760 return fputc (c
, stream
);
765 __gnat_fopen (char *path
, char *mode
, int encoding ATTRIBUTE_UNUSED
)
767 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
768 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
771 S2WS (wmode
, mode
, 10);
773 if (encoding
== Encoding_Unspecified
)
774 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
775 else if (encoding
== Encoding_UTF8
)
776 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
778 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
780 return _tfopen (wpath
, wmode
);
783 return GNAT_FOPEN (path
, mode
);
788 __gnat_freopen (char *path
,
791 int encoding ATTRIBUTE_UNUSED
)
793 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
794 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
797 S2WS (wmode
, mode
, 10);
799 if (encoding
== Encoding_Unspecified
)
800 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
801 else if (encoding
== Encoding_UTF8
)
802 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
804 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
806 return _tfreopen (wpath
, wmode
, stream
);
808 return freopen (path
, mode
, stream
);
813 __gnat_open_read (char *path
, int fmode
)
816 int o_fmode
= O_BINARY
;
821 #if defined (__vxworks)
822 fd
= open (path
, O_RDONLY
| o_fmode
, 0444);
823 #elif defined (__MINGW32__)
825 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
827 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
828 fd
= _topen (wpath
, O_RDONLY
| o_fmode
, 0444);
831 fd
= GNAT_OPEN (path
, O_RDONLY
| o_fmode
);
834 return fd
< 0 ? -1 : fd
;
837 #if defined (__MINGW32__)
838 #define PERM (S_IREAD | S_IWRITE)
840 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
844 __gnat_open_rw (char *path
, int fmode
)
847 int o_fmode
= O_BINARY
;
852 #if defined (__MINGW32__)
854 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
856 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
857 fd
= _topen (wpath
, O_RDWR
| o_fmode
, PERM
);
860 fd
= GNAT_OPEN (path
, O_RDWR
| o_fmode
, PERM
);
863 return fd
< 0 ? -1 : fd
;
867 __gnat_open_create (char *path
, int fmode
)
870 int o_fmode
= O_BINARY
;
875 #if defined (__MINGW32__)
877 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
879 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
880 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
883 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
886 return fd
< 0 ? -1 : fd
;
890 __gnat_create_output_file (char *path
)
893 #if defined (__MINGW32__)
895 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
897 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
898 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
901 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
904 return fd
< 0 ? -1 : fd
;
908 __gnat_create_output_file_new (char *path
)
911 #if defined (__MINGW32__)
913 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
915 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
916 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
919 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
922 return fd
< 0 ? -1 : fd
;
926 __gnat_open_append (char *path
, int fmode
)
929 int o_fmode
= O_BINARY
;
934 #if defined (__MINGW32__)
936 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
938 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
939 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
942 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
945 return fd
< 0 ? -1 : fd
;
948 /* Open a new file. Return error (-1) if the file already exists. */
951 __gnat_open_new (char *path
, int fmode
)
954 int o_fmode
= O_BINARY
;
959 #if defined (__MINGW32__)
961 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
963 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
964 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
967 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
970 return fd
< 0 ? -1 : fd
;
973 /* Open a new temp file. Return error (-1) if the file already exists. */
976 __gnat_open_new_temp (char *path
, int fmode
)
979 int o_fmode
= O_BINARY
;
981 strcpy (path
, "GNAT-XXXXXX");
983 #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
984 || defined (linux) || defined(__GLIBC__)) && !defined (__vxworks)
985 return mkstemp (path
);
986 #elif defined (__Lynx__)
988 #elif defined (__nucleus__)
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) || defined (RTX)
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
)
1125 /* Variable used to create a series of unique names */
1126 static int counter
= 0;
1128 /* RTX in RTSS mode does not support tempnam nor tmpnam so we emulate it */
1129 strcpy (tmp_filename
, "c:\\WINDOWS\\Temp\\gnat-");
1130 sprintf (&tmp_filename
[strlen (tmp_filename
)], "%d\0", counter
++);
1132 #elif defined (__MINGW32__)
1137 /* tempnam tries to create a temporary file in directory pointed to by
1138 TMP environment variable, in c:\temp if TMP is not set, and in
1139 directory specified by P_tmpdir in stdio.h if c:\temp does not
1140 exist. The filename will be created with the prefix "gnat-". */
1142 sprintf (prefix
, "gnat-%d-", (int)getpid());
1143 pname
= (char *) _tempnam ("c:\\temp", prefix
);
1145 /* if pname is NULL, the file was not created properly, the disk is full
1146 or there is no more free temporary files */
1149 *tmp_filename
= '\0';
1151 /* If pname start with a back slash and not path information it means that
1152 the filename is valid for the current working directory. */
1154 else if (pname
[0] == '\\')
1156 strcpy (tmp_filename
, ".\\");
1157 strcat (tmp_filename
, pname
+1);
1160 strcpy (tmp_filename
, pname
);
1165 #elif defined (linux) || defined (__FreeBSD__) || defined (__NetBSD__) \
1166 || defined (__OpenBSD__) || defined(__GLIBC__) || defined (__ANDROID__)
1167 #define MAX_SAFE_PATH 1000
1168 char *tmpdir
= getenv ("TMPDIR");
1170 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1171 a buffer overflow. */
1172 if (tmpdir
== NULL
|| strlen (tmpdir
) > MAX_SAFE_PATH
)
1174 strcpy (tmp_filename
, "/cache/gnat-XXXXXX");
1176 strcpy (tmp_filename
, "/tmp/gnat-XXXXXX");
1179 sprintf (tmp_filename
, "%s/gnat-XXXXXX", tmpdir
);
1181 close (mkstemp(tmp_filename
));
1182 #elif defined (__vxworks) && !(defined (__RTP__) || defined (VTHREADS))
1186 static ushort_t seed
= 0; /* used to generate unique name */
1188 /* generate unique name */
1189 strcpy (tmp_filename
, "tmp");
1191 /* fill up the name buffer from the last position */
1193 pos
= tmp_filename
+ strlen (tmp_filename
) + index
;
1197 for (t
= seed
; 0 <= --index
; t
>>= 3)
1198 *--pos
= '0' + (t
& 07);
1200 tmpnam (tmp_filename
);
1204 /* Open directory and returns a DIR pointer. */
1206 DIR* __gnat_opendir (char *name
)
1209 /* Not supported in RTX */
1213 #elif defined (__MINGW32__)
1214 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1216 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1217 return (DIR*)_topendir (wname
);
1220 return opendir (name
);
1224 /* Read the next entry in a directory. The returned string points somewhere
1227 #if defined (sun) && defined (__SVR4)
1228 /* For Solaris, be sure to use the 64-bit version, otherwise NFS reads may
1229 fail with EOVERFLOW if the server uses 64-bit cookies. */
1230 #define dirent dirent64
1231 #define readdir readdir64
1235 __gnat_readdir (DIR *dirp
, char *buffer
, int *len
)
1238 /* Not supported in RTX */
1242 #elif defined (__MINGW32__)
1243 struct _tdirent
*dirent
= _treaddir ((_TDIR
*)dirp
);
1247 WS2SC (buffer
, dirent
->d_name
, GNAT_MAX_PATH_LEN
);
1248 *len
= strlen (buffer
);
1255 #elif defined (HAVE_READDIR_R)
1256 /* If possible, try to use the thread-safe version. */
1257 if (readdir_r (dirp
, buffer
) != NULL
)
1259 *len
= strlen (((struct dirent
*) buffer
)->d_name
);
1260 return ((struct dirent
*) buffer
)->d_name
;
1266 struct dirent
*dirent
= (struct dirent
*) readdir (dirp
);
1270 strcpy (buffer
, dirent
->d_name
);
1271 *len
= strlen (buffer
);
1280 /* Close a directory entry. */
1282 int __gnat_closedir (DIR *dirp
)
1285 /* Not supported in RTX */
1289 #elif defined (__MINGW32__)
1290 return _tclosedir ((_TDIR
*)dirp
);
1293 return closedir (dirp
);
1297 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1300 __gnat_readdir_is_thread_safe (void)
1302 #ifdef HAVE_READDIR_R
1309 #if defined (_WIN32) && !defined (RTX)
1310 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1311 static const unsigned long long w32_epoch_offset
= 11644473600ULL;
1313 /* Returns the file modification timestamp using Win32 routines which are
1314 immune against daylight saving time change. It is in fact not possible to
1315 use fstat for this purpose as the DST modify the st_mtime field of the
1319 win32_filetime (HANDLE h
)
1324 unsigned long long ull_time
;
1327 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1328 since <Jan 1st 1601>. This function must return the number of seconds
1329 since <Jan 1st 1970>. */
1331 if (GetFileTime (h
, NULL
, NULL
, &t_write
.ft_time
))
1332 return (time_t) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1336 /* As above but starting from a FILETIME. */
1338 f2t (const FILETIME
*ft
, __time64_t
*t
)
1343 unsigned long long ull_time
;
1346 t_write
.ft_time
= *ft
;
1347 *t
= (__time64_t
) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1351 /* Return a GNAT time stamp given a file name. */
1354 __gnat_file_time_name_attr (char* name
, struct file_attributes
* attr
)
1356 if (attr
->timestamp
== (OS_Time
)-2) {
1357 #if defined (_WIN32) && !defined (RTX)
1359 WIN32_FILE_ATTRIBUTE_DATA fad
;
1360 __time64_t ret
= -1;
1361 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1362 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1364 if ((res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
)))
1365 f2t (&fad
.ftLastWriteTime
, &ret
);
1366 attr
->timestamp
= (OS_Time
) ret
;
1368 __gnat_stat_to_attr (-1, name
, attr
);
1371 return attr
->timestamp
;
1375 __gnat_file_time_name (char *name
)
1377 struct file_attributes attr
;
1378 __gnat_reset_attributes (&attr
);
1379 return __gnat_file_time_name_attr (name
, &attr
);
1382 /* Return a GNAT time stamp given a file descriptor. */
1385 __gnat_file_time_fd_attr (int fd
, struct file_attributes
* attr
)
1387 if (attr
->timestamp
== (OS_Time
)-2) {
1388 #if defined (_WIN32) && !defined (RTX)
1389 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
1390 time_t ret
= win32_filetime (h
);
1391 attr
->timestamp
= (OS_Time
) ret
;
1394 __gnat_stat_to_attr (fd
, NULL
, attr
);
1398 return attr
->timestamp
;
1402 __gnat_file_time_fd (int fd
)
1404 struct file_attributes attr
;
1405 __gnat_reset_attributes (&attr
);
1406 return __gnat_file_time_fd_attr (fd
, &attr
);
1409 /* Set the file time stamp. */
1412 __gnat_set_file_time_name (char *name
, time_t time_stamp
)
1414 #if defined (__vxworks)
1416 /* Code to implement __gnat_set_file_time_name for these systems. */
1418 #elif defined (_WIN32) && !defined (RTX)
1422 unsigned long long ull_time
;
1424 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1426 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1428 HANDLE h
= CreateFile
1429 (wname
, GENERIC_WRITE
, FILE_SHARE_WRITE
, NULL
,
1430 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
,
1432 if (h
== INVALID_HANDLE_VALUE
)
1434 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1435 t_write
.ull_time
= ((unsigned long long)time_stamp
+ w32_epoch_offset
);
1436 /* Convert to 100 nanosecond units */
1437 t_write
.ull_time
*= 10000000ULL;
1439 SetFileTime(h
, NULL
, NULL
, &t_write
.ft_time
);
1444 struct utimbuf utimbuf
;
1447 /* Set modification time to requested time. */
1448 utimbuf
.modtime
= time_stamp
;
1450 /* Set access time to now in local time. */
1451 t
= time ((time_t) 0);
1452 utimbuf
.actime
= mktime (localtime (&t
));
1454 utime (name
, &utimbuf
);
1458 /* Get the list of installed standard libraries from the
1459 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1463 __gnat_get_libraries_from_registry (void)
1465 char *result
= (char *) xmalloc (1);
1469 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS) \
1473 DWORD name_size
, value_size
;
1480 /* First open the key. */
1481 res
= RegOpenKeyExA (HKEY_LOCAL_MACHINE
, "SOFTWARE", 0, KEY_READ
, ®_key
);
1483 if (res
== ERROR_SUCCESS
)
1484 res
= RegOpenKeyExA (reg_key
, "Ada Core Technologies", 0,
1485 KEY_READ
, ®_key
);
1487 if (res
== ERROR_SUCCESS
)
1488 res
= RegOpenKeyExA (reg_key
, "GNAT", 0, KEY_READ
, ®_key
);
1490 if (res
== ERROR_SUCCESS
)
1491 res
= RegOpenKeyExA (reg_key
, "Standard Libraries", 0, KEY_READ
, ®_key
);
1493 /* If the key exists, read out all the values in it and concatenate them
1495 for (index
= 0; res
== ERROR_SUCCESS
; index
++)
1497 value_size
= name_size
= 256;
1498 res
= RegEnumValueA (reg_key
, index
, name
, &name_size
, 0,
1499 &type
, (LPBYTE
)value
, &value_size
);
1501 if (res
== ERROR_SUCCESS
&& type
== REG_SZ
)
1503 char *old_result
= result
;
1505 result
= (char *) xmalloc (strlen (old_result
) + value_size
+ 2);
1506 strcpy (result
, old_result
);
1507 strcat (result
, value
);
1508 strcat (result
, ";");
1513 /* Remove the trailing ";". */
1515 result
[strlen (result
) - 1] = 0;
1521 /* Query information for the given file NAME and return it in STATBUF.
1522 * Returns 0 for success, or errno value for failure.
1525 __gnat_stat (char *name
, GNAT_STRUCT_STAT
*statbuf
)
1528 WIN32_FILE_ATTRIBUTE_DATA fad
;
1529 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1534 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1535 name_len
= _tcslen (wname
);
1537 if (name_len
> GNAT_MAX_PATH_LEN
)
1540 ZeroMemory (statbuf
, sizeof(GNAT_STRUCT_STAT
));
1542 res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
);
1545 error
= GetLastError();
1547 /* Check file existence using GetFileAttributes() which does not fail on
1548 special Windows files like con:, aux:, nul: etc... */
1550 if (GetFileAttributes(wname
) != INVALID_FILE_ATTRIBUTES
) {
1551 /* Just pretend that it is a regular and readable file */
1552 statbuf
->st_mode
= S_IFREG
| S_IREAD
| S_IWRITE
;
1557 case ERROR_ACCESS_DENIED
:
1558 case ERROR_SHARING_VIOLATION
:
1559 case ERROR_LOCK_VIOLATION
:
1560 case ERROR_SHARING_BUFFER_EXCEEDED
:
1562 case ERROR_BUFFER_OVERFLOW
:
1563 return ENAMETOOLONG
;
1564 case ERROR_NOT_ENOUGH_MEMORY
:
1571 f2t (&fad
.ftCreationTime
, &statbuf
->st_ctime
);
1572 f2t (&fad
.ftLastWriteTime
, &statbuf
->st_mtime
);
1573 f2t (&fad
.ftLastAccessTime
, &statbuf
->st_atime
);
1576 (__int64
)fad
.nFileSizeLow
| (__int64
)fad
.nFileSizeHigh
<< 32;
1578 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1579 statbuf
->st_mode
= S_IREAD
;
1581 if (fad
.dwFileAttributes
& FILE_ATTRIBUTE_DIRECTORY
)
1582 statbuf
->st_mode
|= S_IFDIR
;
1584 statbuf
->st_mode
|= S_IFREG
;
1586 if (!(fad
.dwFileAttributes
& FILE_ATTRIBUTE_READONLY
))
1587 statbuf
->st_mode
|= S_IWRITE
;
1592 return GNAT_STAT (name
, statbuf
) == 0 ? 0 : errno
;
1596 /*************************************************************************
1597 ** Check whether a file exists
1598 *************************************************************************/
1601 __gnat_file_exists_attr (char* name
, struct file_attributes
* attr
)
1603 if (attr
->exists
== ATTR_UNSET
)
1604 __gnat_stat_to_attr (-1, name
, attr
);
1606 return attr
->exists
;
1610 __gnat_file_exists (char *name
)
1612 struct file_attributes attr
;
1613 __gnat_reset_attributes (&attr
);
1614 return __gnat_file_exists_attr (name
, &attr
);
1617 /**********************************************************************
1618 ** Whether name is an absolute path
1619 **********************************************************************/
1622 __gnat_is_absolute_path (char *name
, int length
)
1625 /* On VxWorks systems, an absolute path can be represented (depending on
1626 the host platform) as either /dir/file, or device:/dir/file, or
1627 device:drive_letter:/dir/file. */
1634 for (index
= 0; index
< length
; index
++)
1636 if (name
[index
] == ':' &&
1637 ((name
[index
+ 1] == '/') ||
1638 (isalpha (name
[index
+ 1]) && index
+ 2 <= length
&&
1639 name
[index
+ 2] == '/')))
1642 else if (name
[index
] == '/')
1647 return (length
!= 0) &&
1648 (*name
== '/' || *name
== DIR_SEPARATOR
1650 || (length
> 1 && ISALPHA (name
[0]) && name
[1] == ':')
1657 __gnat_is_regular_file_attr (char* name
, struct file_attributes
* attr
)
1659 if (attr
->regular
== ATTR_UNSET
)
1660 __gnat_stat_to_attr (-1, name
, attr
);
1662 return attr
->regular
;
1666 __gnat_is_regular_file (char *name
)
1668 struct file_attributes attr
;
1670 __gnat_reset_attributes (&attr
);
1671 return __gnat_is_regular_file_attr (name
, &attr
);
1675 __gnat_is_regular_file_fd (int fd
)
1678 GNAT_STRUCT_STAT statbuf
;
1680 ret
= GNAT_FSTAT (fd
, &statbuf
);
1681 return (!ret
&& S_ISREG (statbuf
.st_mode
));
1685 __gnat_is_directory_attr (char* name
, struct file_attributes
* attr
)
1687 if (attr
->directory
== ATTR_UNSET
)
1688 __gnat_stat_to_attr (-1, name
, attr
);
1690 return attr
->directory
;
1694 __gnat_is_directory (char *name
)
1696 struct file_attributes attr
;
1698 __gnat_reset_attributes (&attr
);
1699 return __gnat_is_directory_attr (name
, &attr
);
1702 #if defined (_WIN32) && !defined (RTX)
1704 /* Returns the same constant as GetDriveType but takes a pathname as
1708 GetDriveTypeFromPath (TCHAR
*wfullpath
)
1710 TCHAR wdrv
[MAX_PATH
];
1711 TCHAR wpath
[MAX_PATH
];
1712 TCHAR wfilename
[MAX_PATH
];
1713 TCHAR wext
[MAX_PATH
];
1715 _tsplitpath (wfullpath
, wdrv
, wpath
, wfilename
, wext
);
1717 if (_tcslen (wdrv
) != 0)
1719 /* we have a drive specified. */
1720 _tcscat (wdrv
, _T("\\"));
1721 return GetDriveType (wdrv
);
1725 /* No drive specified. */
1727 /* Is this a relative path, if so get current drive type. */
1728 if (wpath
[0] != _T('\\') ||
1729 (_tcslen (wpath
) > 2 && wpath
[0] == _T('\\')
1730 && wpath
[1] != _T('\\')))
1731 return GetDriveType (NULL
);
1733 UINT result
= GetDriveType (wpath
);
1735 /* Cannot guess the drive type, is this \\.\ ? */
1737 if (result
== DRIVE_NO_ROOT_DIR
&&
1738 _tcslen (wpath
) >= 4 && wpath
[0] == _T('\\') && wpath
[1] == _T('\\')
1739 && wpath
[2] == _T('.') && wpath
[3] == _T('\\'))
1741 if (_tcslen (wpath
) == 4)
1742 _tcscat (wpath
, wfilename
);
1744 LPTSTR p
= &wpath
[4];
1745 LPTSTR b
= _tcschr (p
, _T('\\'));
1749 /* logical drive \\.\c\dir\file */
1755 _tcscat (p
, _T(":\\"));
1757 return GetDriveType (p
);
1764 /* This MingW section contains code to work with ACL. */
1766 __gnat_check_OWNER_ACL (TCHAR
*wname
,
1767 DWORD CheckAccessDesired
,
1768 GENERIC_MAPPING CheckGenericMapping
)
1770 DWORD dwAccessDesired
, dwAccessAllowed
;
1771 PRIVILEGE_SET PrivilegeSet
;
1772 DWORD dwPrivSetSize
= sizeof (PRIVILEGE_SET
);
1773 BOOL fAccessGranted
= FALSE
;
1774 HANDLE hToken
= NULL
;
1776 PSECURITY_DESCRIPTOR pSD
= NULL
;
1779 (wname
, OWNER_SECURITY_INFORMATION
|
1780 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1783 if ((pSD
= (SECURITY_DESCRIPTOR
*) HeapAlloc
1784 (GetProcessHeap (), HEAP_ZERO_MEMORY
, nLength
)) == NULL
)
1787 /* Obtain the security descriptor. */
1789 if (!GetFileSecurity
1790 (wname
, OWNER_SECURITY_INFORMATION
|
1791 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1792 pSD
, nLength
, &nLength
))
1795 if (!ImpersonateSelf (SecurityImpersonation
))
1798 if (!OpenThreadToken
1799 (GetCurrentThread(), TOKEN_DUPLICATE
| TOKEN_QUERY
, FALSE
, &hToken
))
1802 /* Undoes the effect of ImpersonateSelf. */
1806 /* We want to test for write permissions. */
1808 dwAccessDesired
= CheckAccessDesired
;
1810 MapGenericMask (&dwAccessDesired
, &CheckGenericMapping
);
1813 (pSD
, /* security descriptor to check */
1814 hToken
, /* impersonation token */
1815 dwAccessDesired
, /* requested access rights */
1816 &CheckGenericMapping
, /* pointer to GENERIC_MAPPING */
1817 &PrivilegeSet
, /* receives privileges used in check */
1818 &dwPrivSetSize
, /* size of PrivilegeSet buffer */
1819 &dwAccessAllowed
, /* receives mask of allowed access rights */
1823 CloseHandle (hToken
);
1824 HeapFree (GetProcessHeap (), 0, pSD
);
1825 return fAccessGranted
;
1829 CloseHandle (hToken
);
1830 HeapFree (GetProcessHeap (), 0, pSD
);
1835 __gnat_set_OWNER_ACL (TCHAR
*wname
,
1836 ACCESS_MODE AccessMode
,
1837 DWORD AccessPermissions
)
1839 PACL pOldDACL
= NULL
;
1840 PACL pNewDACL
= NULL
;
1841 PSECURITY_DESCRIPTOR pSD
= NULL
;
1843 TCHAR username
[100];
1846 /* Get current user, he will act as the owner */
1848 if (!GetUserName (username
, &unsize
))
1851 if (GetNamedSecurityInfo
1854 DACL_SECURITY_INFORMATION
,
1855 NULL
, NULL
, &pOldDACL
, NULL
, &pSD
) != ERROR_SUCCESS
)
1858 BuildExplicitAccessWithName
1859 (&ea
, username
, AccessPermissions
, (ACCESS_MODE
) AccessMode
, NO_INHERITANCE
);
1861 if (AccessMode
== SET_ACCESS
)
1863 /* SET_ACCESS, we want to set an explicte set of permissions, do not
1864 merge with current DACL. */
1865 if (SetEntriesInAcl (1, &ea
, NULL
, &pNewDACL
) != ERROR_SUCCESS
)
1869 if (SetEntriesInAcl (1, &ea
, pOldDACL
, &pNewDACL
) != ERROR_SUCCESS
)
1872 if (SetNamedSecurityInfo
1873 (wname
, SE_FILE_OBJECT
,
1874 DACL_SECURITY_INFORMATION
, NULL
, NULL
, pNewDACL
, NULL
) != ERROR_SUCCESS
)
1878 LocalFree (pNewDACL
);
1881 /* Check if it is possible to use ACL for wname, the file must not be on a
1885 __gnat_can_use_acl (TCHAR
*wname
)
1887 return __gnat_use_acl
&& GetDriveTypeFromPath (wname
) != DRIVE_REMOTE
;
1890 #endif /* defined (_WIN32) && !defined (RTX) */
1893 __gnat_is_readable_file_attr (char* name
, struct file_attributes
* attr
)
1895 if (attr
->readable
== ATTR_UNSET
)
1897 #if defined (_WIN32) && !defined (RTX)
1898 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1899 GENERIC_MAPPING GenericMapping
;
1901 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1903 if (__gnat_can_use_acl (wname
))
1905 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1906 GenericMapping
.GenericRead
= GENERIC_READ
;
1908 __gnat_check_OWNER_ACL (wname
, FILE_READ_DATA
, GenericMapping
);
1911 attr
->readable
= GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
;
1913 __gnat_stat_to_attr (-1, name
, attr
);
1917 return attr
->readable
;
1921 __gnat_is_readable_file (char *name
)
1923 struct file_attributes attr
;
1925 __gnat_reset_attributes (&attr
);
1926 return __gnat_is_readable_file_attr (name
, &attr
);
1930 __gnat_is_writable_file_attr (char* name
, struct file_attributes
* attr
)
1932 if (attr
->writable
== ATTR_UNSET
)
1934 #if defined (_WIN32) && !defined (RTX)
1935 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1936 GENERIC_MAPPING GenericMapping
;
1938 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1940 if (__gnat_can_use_acl (wname
))
1942 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1943 GenericMapping
.GenericWrite
= GENERIC_WRITE
;
1945 attr
->writable
= __gnat_check_OWNER_ACL
1946 (wname
, FILE_WRITE_DATA
| FILE_APPEND_DATA
, GenericMapping
)
1947 && !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
1951 !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
1954 __gnat_stat_to_attr (-1, name
, attr
);
1958 return attr
->writable
;
1962 __gnat_is_writable_file (char *name
)
1964 struct file_attributes attr
;
1966 __gnat_reset_attributes (&attr
);
1967 return __gnat_is_writable_file_attr (name
, &attr
);
1971 __gnat_is_executable_file_attr (char* name
, struct file_attributes
* attr
)
1973 if (attr
->executable
== ATTR_UNSET
)
1975 #if defined (_WIN32) && !defined (RTX)
1976 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1977 GENERIC_MAPPING GenericMapping
;
1979 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1981 if (__gnat_can_use_acl (wname
))
1983 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1984 GenericMapping
.GenericExecute
= GENERIC_EXECUTE
;
1987 __gnat_check_OWNER_ACL (wname
, FILE_EXECUTE
, GenericMapping
);
1991 TCHAR
*l
, *last
= _tcsstr(wname
, _T(".exe"));
1993 /* look for last .exe */
1995 while ((l
= _tcsstr(last
+1, _T(".exe"))))
1999 GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
2000 && (last
- wname
) == (int) (_tcslen (wname
) - 4);
2003 __gnat_stat_to_attr (-1, name
, attr
);
2007 return attr
->regular
&& attr
->executable
;
2011 __gnat_is_executable_file (char *name
)
2013 struct file_attributes attr
;
2015 __gnat_reset_attributes (&attr
);
2016 return __gnat_is_executable_file_attr (name
, &attr
);
2020 __gnat_set_writable (char *name
)
2022 #if defined (_WIN32) && !defined (RTX)
2023 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2025 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2027 if (__gnat_can_use_acl (wname
))
2028 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_WRITE
);
2031 (wname
, GetFileAttributes (wname
) & ~FILE_ATTRIBUTE_READONLY
);
2032 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2033 ! defined(__nucleus__)
2034 GNAT_STRUCT_STAT statbuf
;
2036 if (GNAT_STAT (name
, &statbuf
) == 0)
2038 statbuf
.st_mode
= statbuf
.st_mode
| S_IWUSR
;
2039 chmod (name
, statbuf
.st_mode
);
2044 /* must match definition in s-os_lib.ads */
2050 __gnat_set_executable (char *name
, int mode ATTRIBUTE_UNUSED
)
2052 #if defined (_WIN32) && !defined (RTX)
2053 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2055 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2057 if (__gnat_can_use_acl (wname
))
2058 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_EXECUTE
);
2060 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2061 ! defined(__nucleus__)
2062 GNAT_STRUCT_STAT statbuf
;
2064 if (GNAT_STAT (name
, &statbuf
) == 0)
2067 statbuf
.st_mode
= statbuf
.st_mode
| S_IXUSR
;
2069 statbuf
.st_mode
= statbuf
.st_mode
| S_IXGRP
;
2070 if (mode
& S_OTHERS
)
2071 statbuf
.st_mode
= statbuf
.st_mode
| S_IXOTH
;
2072 chmod (name
, statbuf
.st_mode
);
2078 __gnat_set_non_writable (char *name
)
2080 #if defined (_WIN32) && !defined (RTX)
2081 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2083 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2085 if (__gnat_can_use_acl (wname
))
2086 __gnat_set_OWNER_ACL
2087 (wname
, DENY_ACCESS
,
2088 FILE_WRITE_DATA
| FILE_APPEND_DATA
|
2089 FILE_WRITE_EA
| FILE_WRITE_ATTRIBUTES
);
2092 (wname
, GetFileAttributes (wname
) | FILE_ATTRIBUTE_READONLY
);
2093 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2094 ! defined(__nucleus__)
2095 GNAT_STRUCT_STAT statbuf
;
2097 if (GNAT_STAT (name
, &statbuf
) == 0)
2099 statbuf
.st_mode
= statbuf
.st_mode
& 07577;
2100 chmod (name
, statbuf
.st_mode
);
2106 __gnat_set_readable (char *name
)
2108 #if defined (_WIN32) && !defined (RTX)
2109 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2111 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2113 if (__gnat_can_use_acl (wname
))
2114 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_READ
);
2116 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2117 ! defined(__nucleus__)
2118 GNAT_STRUCT_STAT statbuf
;
2120 if (GNAT_STAT (name
, &statbuf
) == 0)
2122 chmod (name
, statbuf
.st_mode
| S_IREAD
);
2128 __gnat_set_non_readable (char *name
)
2130 #if defined (_WIN32) && !defined (RTX)
2131 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2133 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2135 if (__gnat_can_use_acl (wname
))
2136 __gnat_set_OWNER_ACL (wname
, DENY_ACCESS
, FILE_GENERIC_READ
);
2138 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2139 ! defined(__nucleus__)
2140 GNAT_STRUCT_STAT statbuf
;
2142 if (GNAT_STAT (name
, &statbuf
) == 0)
2144 chmod (name
, statbuf
.st_mode
& (~S_IREAD
));
2150 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED
,
2151 struct file_attributes
* attr
)
2153 if (attr
->symbolic_link
== ATTR_UNSET
)
2155 #if defined (__vxworks) || defined (__nucleus__)
2156 attr
->symbolic_link
= 0;
2158 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2160 GNAT_STRUCT_STAT statbuf
;
2161 ret
= GNAT_LSTAT (name
, &statbuf
);
2162 attr
->symbolic_link
= (!ret
&& S_ISLNK (statbuf
.st_mode
));
2164 attr
->symbolic_link
= 0;
2167 return attr
->symbolic_link
;
2171 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED
)
2173 struct file_attributes attr
;
2175 __gnat_reset_attributes (&attr
);
2176 return __gnat_is_symbolic_link_attr (name
, &attr
);
2179 #if defined (sun) && defined (__SVR4)
2180 /* Using fork on Solaris will duplicate all the threads. fork1, which
2181 duplicates only the active thread, must be used instead, or spawning
2182 subprocess from a program with tasking will lead into numerous problems. */
2187 __gnat_portable_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2189 int status ATTRIBUTE_UNUSED
= 0;
2190 int finished ATTRIBUTE_UNUSED
;
2191 int pid ATTRIBUTE_UNUSED
;
2193 #if defined (__vxworks) || defined(__nucleus__) || defined(RTX) \
2194 || defined(__PikeOS__)
2197 #elif defined (_WIN32)
2198 /* args[0] must be quotes as it could contain a full pathname with spaces */
2199 char *args_0
= args
[0];
2200 args
[0] = (char *)xmalloc (strlen (args_0
) + 3);
2201 strcpy (args
[0], "\"");
2202 strcat (args
[0], args_0
);
2203 strcat (args
[0], "\"");
2205 status
= spawnvp (P_WAIT
, args_0
, (char ** const)args
);
2207 /* restore previous value */
2209 args
[0] = (char *)args_0
;
2225 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2230 finished
= waitpid (pid
, &status
, 0);
2232 if (finished
!= pid
|| WIFEXITED (status
) == 0)
2235 return WEXITSTATUS (status
);
2241 /* Create a copy of the given file descriptor.
2242 Return -1 if an error occurred. */
2245 __gnat_dup (int oldfd
)
2247 #if defined (__vxworks) && !defined (__RTP__)
2248 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2256 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2257 Return -1 if an error occurred. */
2260 __gnat_dup2 (int oldfd ATTRIBUTE_UNUSED
, int newfd ATTRIBUTE_UNUSED
)
2262 #if defined (__vxworks) && !defined (__RTP__)
2263 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2266 #elif defined (__PikeOS__)
2267 /* Not supported. */
2269 #elif defined (_WIN32)
2270 /* Special case when oldfd and newfd are identical and are the standard
2271 input, output or error as this makes Windows XP hangs. Note that we
2272 do that only for standard file descriptors that are known to be valid. */
2273 if (oldfd
== newfd
&& newfd
>= 0 && newfd
<= 2)
2276 return dup2 (oldfd
, newfd
);
2278 return dup2 (oldfd
, newfd
);
2283 __gnat_number_of_cpus (void)
2287 #if defined (linux) || defined (sun) || defined (AIX) || defined (__APPLE__)
2288 cores
= (int) sysconf (_SC_NPROCESSORS_ONLN
);
2290 #elif defined (__hpux__)
2291 struct pst_dynamic psd
;
2292 if (pstat_getdynamic (&psd
, sizeof (psd
), 1, 0) != -1)
2293 cores
= (int) psd
.psd_proc_cnt
;
2295 #elif defined (_WIN32)
2296 SYSTEM_INFO sysinfo
;
2297 GetSystemInfo (&sysinfo
);
2298 cores
= (int) sysinfo
.dwNumberOfProcessors
;
2300 #elif defined (_WRS_CONFIG_SMP)
2301 unsigned int vxCpuConfiguredGet (void);
2303 cores
= vxCpuConfiguredGet ();
2310 /* WIN32 code to implement a wait call that wait for any child process. */
2312 #if defined (_WIN32) && !defined (RTX)
2314 /* Synchronization code, to be thread safe. */
2318 /* For the Cert run times on native Windows we use dummy functions
2319 for locking and unlocking tasks since we do not support multiple
2320 threads on this configuration (Cert run time on native Windows). */
2322 static void EnterCS (void) {}
2323 static void LeaveCS (void) {}
2324 static void SignalListChanged (void) {}
2328 CRITICAL_SECTION ProcListCS
;
2329 HANDLE ProcListEvt
= NULL
;
2331 static void EnterCS (void)
2333 EnterCriticalSection(&ProcListCS
);
2336 static void LeaveCS (void)
2338 LeaveCriticalSection(&ProcListCS
);
2341 static void SignalListChanged (void)
2343 SetEvent (ProcListEvt
);
2348 static HANDLE
*HANDLES_LIST
= NULL
;
2349 static int *PID_LIST
= NULL
, plist_length
= 0, plist_max_length
= 0;
2352 add_handle (HANDLE h
, int pid
)
2354 /* -------------------- critical section -------------------- */
2357 if (plist_length
== plist_max_length
)
2359 plist_max_length
+= 100;
2361 (HANDLE
*) xrealloc (HANDLES_LIST
, sizeof (HANDLE
) * plist_max_length
);
2363 (int *) xrealloc (PID_LIST
, sizeof (int) * plist_max_length
);
2366 HANDLES_LIST
[plist_length
] = h
;
2367 PID_LIST
[plist_length
] = pid
;
2370 SignalListChanged();
2372 /* -------------------- critical section -------------------- */
2376 __gnat_win32_remove_handle (HANDLE h
, int pid
)
2381 /* -------------------- critical section -------------------- */
2384 for (j
= 0; j
< plist_length
; j
++)
2386 if ((HANDLES_LIST
[j
] == h
) || (PID_LIST
[j
] == pid
))
2390 HANDLES_LIST
[j
] = HANDLES_LIST
[plist_length
];
2391 PID_LIST
[j
] = PID_LIST
[plist_length
];
2398 /* -------------------- critical section -------------------- */
2401 SignalListChanged();
2407 win32_no_block_spawn (char *command
, char *args
[], HANDLE
*h
, int *pid
)
2411 PROCESS_INFORMATION PI
;
2412 SECURITY_ATTRIBUTES SA
;
2417 /* compute the total command line length */
2421 csize
+= strlen (args
[k
]) + 1;
2425 full_command
= (char *) xmalloc (csize
);
2428 SI
.cb
= sizeof (STARTUPINFO
);
2429 SI
.lpReserved
= NULL
;
2430 SI
.lpReserved2
= NULL
;
2431 SI
.lpDesktop
= NULL
;
2435 SI
.wShowWindow
= SW_HIDE
;
2437 /* Security attributes. */
2438 SA
.nLength
= sizeof (SECURITY_ATTRIBUTES
);
2439 SA
.bInheritHandle
= TRUE
;
2440 SA
.lpSecurityDescriptor
= NULL
;
2442 /* Prepare the command string. */
2443 strcpy (full_command
, command
);
2444 strcat (full_command
, " ");
2449 strcat (full_command
, args
[k
]);
2450 strcat (full_command
, " ");
2455 int wsize
= csize
* 2;
2456 TCHAR
*wcommand
= (TCHAR
*) xmalloc (wsize
);
2458 S2WSC (wcommand
, full_command
, wsize
);
2460 free (full_command
);
2462 result
= CreateProcess
2463 (NULL
, wcommand
, &SA
, NULL
, TRUE
,
2464 GetPriorityClass (GetCurrentProcess()), NULL
, NULL
, &SI
, &PI
);
2471 CloseHandle (PI
.hThread
);
2473 *pid
= PI
.dwProcessId
;
2483 win32_wait (int *status
)
2485 DWORD exitcode
, pid
;
2495 if (plist_length
== 0)
2501 /* -------------------- critical section -------------------- */
2504 hl_len
= plist_length
;
2507 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * hl_len
);
2508 memmove (hl
, HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2509 pidl
= (int *) xmalloc (sizeof (int) * hl_len
);
2510 memmove (pidl
, PID_LIST
, sizeof (int) * hl_len
);
2512 /* Note that index 0 contains the event handle that is signaled when the
2513 process list has changed */
2514 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * hl_len
+ 1);
2515 hl
[0] = ProcListEvt
;
2516 memmove (&hl
[1], HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2517 pidl
= (int *) xmalloc (sizeof (int) * hl_len
+ 1);
2518 memmove (&pidl
[1], PID_LIST
, sizeof (int) * hl_len
);
2523 /* -------------------- critical section -------------------- */
2525 res
= WaitForMultipleObjects (hl_len
, hl
, FALSE
, INFINITE
);
2527 /* if the ProcListEvt has been signaled then the list of processes has been
2528 updated to add or remove a handle, just loop over */
2530 if (res
- WAIT_OBJECT_0
== 0)
2537 h
= hl
[res
- WAIT_OBJECT_0
];
2538 GetExitCodeProcess (h
, &exitcode
);
2539 pid
= pidl
[res
- WAIT_OBJECT_0
];
2541 found
= __gnat_win32_remove_handle (h
, -1);
2546 /* if not found another process waiting has already handled this process */
2553 *status
= (int) exitcode
;
2560 __gnat_portable_no_block_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2563 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX) \
2564 || defined (__PikeOS__)
2565 /* Not supported. */
2568 #elif defined (_WIN32)
2573 win32_no_block_spawn (args
[0], args
, &h
, &pid
);
2576 add_handle (h
, pid
);
2589 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2599 __gnat_portable_wait (int *process_status
)
2604 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX) \
2605 || defined (__PikeOS__)
2606 /* Not sure what to do here, so do nothing but return zero. */
2608 #elif defined (_WIN32)
2610 pid
= win32_wait (&status
);
2614 pid
= waitpid (-1, &status
, 0);
2615 status
= status
& 0xffff;
2618 *process_status
= status
;
2623 __gnat_os_exit (int status
)
2628 /* Locate file on path, that matches a predicate */
2631 __gnat_locate_file_with_predicate (char *file_name
, char *path_val
,
2632 int (*predicate
)(char *))
2635 char *file_path
= (char *) alloca (strlen (file_name
) + 1);
2638 /* Return immediately if file_name is empty */
2640 if (*file_name
== '\0')
2643 /* Remove quotes around file_name if present */
2649 strcpy (file_path
, ptr
);
2651 ptr
= file_path
+ strlen (file_path
) - 1;
2656 /* Handle absolute pathnames. */
2658 absolute
= __gnat_is_absolute_path (file_path
, strlen (file_name
));
2662 if (predicate (file_path
))
2663 return xstrdup (file_path
);
2668 /* If file_name include directory separator(s), try it first as
2669 a path name relative to the current directory */
2670 for (ptr
= file_name
; *ptr
&& *ptr
!= '/' && *ptr
!= DIR_SEPARATOR
; ptr
++)
2675 if (predicate (file_name
))
2676 return xstrdup (file_name
);
2683 /* The result has to be smaller than path_val + file_name. */
2685 (char *) alloca (strlen (path_val
) + strlen (file_name
) + 2);
2689 /* Skip the starting quote */
2691 if (*path_val
== '"')
2694 for (ptr
= file_path
; *path_val
&& *path_val
!= PATH_SEPARATOR
; )
2695 *ptr
++ = *path_val
++;
2697 /* If directory is empty, it is the current directory*/
2699 if (ptr
== file_path
)
2706 /* Skip the ending quote */
2711 if (*ptr
!= '/' && *ptr
!= DIR_SEPARATOR
)
2712 *++ptr
= DIR_SEPARATOR
;
2714 strcpy (++ptr
, file_name
);
2716 if (predicate (file_path
))
2717 return xstrdup (file_path
);
2722 /* Skip path separator */
2731 /* Locate an executable file, give a Path value. */
2734 __gnat_locate_executable_file (char *file_name
, char *path_val
)
2736 return __gnat_locate_file_with_predicate
2737 (file_name
, path_val
, &__gnat_is_executable_file
);
2740 /* Locate a regular file, give a Path value. */
2743 __gnat_locate_regular_file (char *file_name
, char *path_val
)
2745 return __gnat_locate_file_with_predicate
2746 (file_name
, path_val
, &__gnat_is_regular_file
);
2749 /* Locate an executable given a Path argument. This routine is only used by
2750 gnatbl and should not be used otherwise. Use locate_exec_on_path
2754 __gnat_locate_exec (char *exec_name
, char *path_val
)
2757 if (!strstr (exec_name
, HOST_EXECUTABLE_SUFFIX
))
2759 char *full_exec_name
=
2761 (strlen (exec_name
) + strlen (HOST_EXECUTABLE_SUFFIX
) + 1);
2763 strcpy (full_exec_name
, exec_name
);
2764 strcat (full_exec_name
, HOST_EXECUTABLE_SUFFIX
);
2765 ptr
= __gnat_locate_executable_file (full_exec_name
, path_val
);
2768 return __gnat_locate_executable_file (exec_name
, path_val
);
2772 return __gnat_locate_executable_file (exec_name
, path_val
);
2775 /* Locate an executable using the Systems default PATH. */
2778 __gnat_locate_exec_on_path (char *exec_name
)
2782 #if defined (_WIN32) && !defined (RTX)
2783 TCHAR
*wpath_val
= _tgetenv (_T("PATH"));
2785 /* In Win32 systems we expand the PATH as for XP environment
2786 variables are not automatically expanded. We also prepend the
2787 ".;" to the path to match normal NT path search semantics */
2789 #define EXPAND_BUFFER_SIZE 32767
2791 wapath_val
= (TCHAR
*) alloca (EXPAND_BUFFER_SIZE
);
2793 wapath_val
[0] = '.';
2794 wapath_val
[1] = ';';
2796 DWORD res
= ExpandEnvironmentStrings
2797 (wpath_val
, &wapath_val
[2], EXPAND_BUFFER_SIZE
- 2);
2799 if (!res
) wapath_val
[0] = _T('\0');
2801 apath_val
= (char *) alloca (EXPAND_BUFFER_SIZE
);
2803 WS2SC (apath_val
, wapath_val
, EXPAND_BUFFER_SIZE
);
2804 return __gnat_locate_exec (exec_name
, apath_val
);
2807 char *path_val
= getenv ("PATH");
2809 if (path_val
== NULL
) return NULL
;
2810 apath_val
= (char *) alloca (strlen (path_val
) + 1);
2811 strcpy (apath_val
, path_val
);
2812 return __gnat_locate_exec (exec_name
, apath_val
);
2816 /* Dummy functions for Osint import for non-VMS systems.
2817 ??? To be removed. */
2820 __gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED
,
2821 int onlydirs ATTRIBUTE_UNUSED
)
2827 __gnat_to_canonical_file_list_next (void)
2829 static char empty
[] = "";
2834 __gnat_to_canonical_file_list_free (void)
2839 __gnat_to_canonical_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2845 __gnat_to_canonical_file_spec (char *filespec
)
2851 __gnat_to_canonical_path_spec (char *pathspec
)
2857 __gnat_to_host_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2863 __gnat_to_host_file_spec (char *filespec
)
2869 __gnat_adjust_os_resource_limits (void)
2873 #if defined (__mips_vxworks)
2877 CACHE_USER_FLUSH (0, ENTIRE_CACHE
);
2881 #if defined (_WIN32)
2882 int __gnat_argument_needs_quote
= 1;
2884 int __gnat_argument_needs_quote
= 0;
2887 /* This option is used to enable/disable object files handling from the
2888 binder file by the GNAT Project module. For example, this is disabled on
2889 Windows (prior to GCC 3.4) as it is already done by the mdll module.
2890 Stating with GCC 3.4 the shared libraries are not based on mdll
2891 anymore as it uses the GCC's -shared option */
2892 #if defined (_WIN32) \
2893 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
2894 int __gnat_prj_add_obj_files
= 0;
2896 int __gnat_prj_add_obj_files
= 1;
2899 /* char used as prefix/suffix for environment variables */
2900 #if defined (_WIN32)
2901 char __gnat_environment_char
= '%';
2903 char __gnat_environment_char
= '$';
2906 /* This functions copy the file attributes from a source file to a
2909 mode = 0 : In this mode copy only the file time stamps (last access and
2910 last modification time stamps).
2912 mode = 1 : In this mode, time stamps and read/write/execute attributes are
2915 Returns 0 if operation was successful and -1 in case of error. */
2918 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED
, char *to ATTRIBUTE_UNUSED
,
2919 int mode ATTRIBUTE_UNUSED
)
2921 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) || \
2922 defined (__nucleus__)
2925 #elif defined (_WIN32) && !defined (RTX)
2926 TCHAR wfrom
[GNAT_MAX_PATH_LEN
+ 2];
2927 TCHAR wto
[GNAT_MAX_PATH_LEN
+ 2];
2929 FILETIME fct
, flat
, flwt
;
2932 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
+ 2);
2933 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
+ 2);
2935 /* retrieve from times */
2938 (wfrom
, GENERIC_READ
, 0, NULL
, OPEN_EXISTING
, FILE_ATTRIBUTE_NORMAL
, NULL
);
2940 if (hfrom
== INVALID_HANDLE_VALUE
)
2943 res
= GetFileTime (hfrom
, &fct
, &flat
, &flwt
);
2945 CloseHandle (hfrom
);
2950 /* retrieve from times */
2953 (wto
, GENERIC_WRITE
, 0, NULL
, OPEN_EXISTING
, FILE_ATTRIBUTE_NORMAL
, NULL
);
2955 if (hto
== INVALID_HANDLE_VALUE
)
2958 res
= SetFileTime (hto
, NULL
, &flat
, &flwt
);
2965 /* Set file attributes in full mode. */
2969 DWORD attribs
= GetFileAttributes (wfrom
);
2971 if (attribs
== INVALID_FILE_ATTRIBUTES
)
2974 res
= SetFileAttributes (wto
, attribs
);
2982 GNAT_STRUCT_STAT fbuf
;
2983 struct utimbuf tbuf
;
2985 if (GNAT_STAT (from
, &fbuf
) == -1)
2990 tbuf
.actime
= fbuf
.st_atime
;
2991 tbuf
.modtime
= fbuf
.st_mtime
;
2993 if (utime (to
, &tbuf
) == -1)
3000 if (chmod (to
, fbuf
.st_mode
) == -1)
3011 __gnat_lseek (int fd
, long offset
, int whence
)
3013 return (int) lseek (fd
, offset
, whence
);
3016 /* This function returns the major version number of GCC being used. */
3018 get_gcc_version (void)
3023 return (int) (version_string
[0] - '0');
3028 * Set Close_On_Exec as indicated.
3029 * Note: this is used for both GNAT.OS_Lib and GNAT.Sockets.
3033 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED
,
3034 int close_on_exec_p ATTRIBUTE_UNUSED
)
3036 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
3037 int flags
= fcntl (fd
, F_GETFD
, 0);
3040 if (close_on_exec_p
)
3041 flags
|= FD_CLOEXEC
;
3043 flags
&= ~FD_CLOEXEC
;
3044 return fcntl (fd
, F_SETFD
, flags
);
3045 #elif defined(_WIN32)
3046 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
3047 if (h
== (HANDLE
) -1)
3049 if (close_on_exec_p
)
3050 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
, 0);
3051 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
,
3052 HANDLE_FLAG_INHERIT
);
3054 /* TODO: Unimplemented. */
3059 /* Indicates if platforms supports automatic initialization through the
3060 constructor mechanism */
3062 __gnat_binder_supports_auto_init (void)
3067 /* Indicates that Stand-Alone Libraries are automatically initialized through
3068 the constructor mechanism */
3070 __gnat_sals_init_using_constructors (void)
3072 #if defined (__vxworks) || defined (__Lynx__)
3081 /* In RTX mode, the procedure to get the time (as file time) is different
3082 in RTSS mode and Win32 mode. In order to avoid duplicating an Ada file,
3083 we introduce an intermediate procedure to link against the corresponding
3084 one in each situation. */
3086 extern void GetTimeAsFileTime (LPFILETIME pTime
);
3088 void GetTimeAsFileTime (LPFILETIME pTime
)
3091 RtGetRtssTimeAsFileTime (pTime
); /* RTSS interface */
3093 GetSystemTimeAsFileTime (pTime
); /* w32 interface */
3098 /* Add symbol that is required to link. It would otherwise be taken from
3099 libgcc.a and it would try to use the gcc constructors that are not
3100 supported by Microsoft linker. */
3102 extern void __main (void);
3110 #if defined (__ANDROID__)
3112 #include <pthread.h>
3115 __gnat_lwp_self (void)
3117 return (void *) pthread_self ();
3120 #elif defined (linux)
3121 /* There is no function in the glibc to retrieve the LWP of the current
3122 thread. We need to do a system call in order to retrieve this
3124 #include <sys/syscall.h>
3126 __gnat_lwp_self (void)
3128 return (void *) syscall (__NR_gettid
);
3133 /* glibc versions earlier than 2.7 do not define the routines to handle
3134 dynamically allocated CPU sets. For these targets, we use the static
3139 /* Dynamic cpu sets */
3142 __gnat_cpu_alloc (size_t count
)
3144 return CPU_ALLOC (count
);
3148 __gnat_cpu_alloc_size (size_t count
)
3150 return CPU_ALLOC_SIZE (count
);
3154 __gnat_cpu_free (cpu_set_t
*set
)
3160 __gnat_cpu_zero (size_t count
, cpu_set_t
*set
)
3162 CPU_ZERO_S (count
, set
);
3166 __gnat_cpu_set (int cpu
, size_t count
, cpu_set_t
*set
)
3168 /* Ada handles CPU numbers starting from 1, while C identifies the first
3169 CPU by a 0, so we need to adjust. */
3170 CPU_SET_S (cpu
- 1, count
, set
);
3173 #else /* !CPU_ALLOC */
3175 /* Static cpu sets */
3178 __gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED
)
3180 return (cpu_set_t
*) xmalloc (sizeof (cpu_set_t
));
3184 __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED
)
3186 return sizeof (cpu_set_t
);
3190 __gnat_cpu_free (cpu_set_t
*set
)
3196 __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3202 __gnat_cpu_set (int cpu
, size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3204 /* Ada handles CPU numbers starting from 1, while C identifies the first
3205 CPU by a 0, so we need to adjust. */
3206 CPU_SET (cpu
- 1, set
);
3208 #endif /* !CPU_ALLOC */
3211 /* Return the load address of the executable, or 0 if not known. In the
3212 specific case of error, (void *)-1 can be returned. Beware: this unit may
3213 be in a shared library. As low-level units are needed, we allow #include
3216 #if defined (__APPLE__)
3217 #include <mach-o/dyld.h>
3218 #elif 0 && defined (__linux__)
3223 __gnat_get_executable_load_address (void)
3225 #if defined (__APPLE__)
3226 return _dyld_get_image_header (0);
3228 #elif 0 && defined (__linux__)
3229 /* Currently disabled as it needs at least -ldl. */
3230 struct link_map
*map
= _r_debug
.r_map
;
3232 return (const void *)map
->l_addr
;