1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
9 * Copyright (C) 1992-2014, 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__)
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 #undef HAVE_READDIR_R
303 #define MAYBE_TO_PTR32(argv) argv
305 static const char ATTR_UNSET
= 127;
307 /* Reset the file attributes as if no system call had been performed */
310 __gnat_reset_attributes (struct file_attributes
* attr
)
312 attr
->exists
= ATTR_UNSET
;
313 attr
->error
= EINVAL
;
315 attr
->writable
= ATTR_UNSET
;
316 attr
->readable
= ATTR_UNSET
;
317 attr
->executable
= ATTR_UNSET
;
319 attr
->regular
= ATTR_UNSET
;
320 attr
->symbolic_link
= ATTR_UNSET
;
321 attr
->directory
= ATTR_UNSET
;
323 attr
->timestamp
= (OS_Time
)-2;
324 attr
->file_length
= -1;
328 __gnat_error_attributes (struct file_attributes
*attr
) {
333 __gnat_current_time (void)
335 time_t res
= time (NULL
);
336 return (OS_Time
) res
;
339 /* Return the current local time as a string in the ISO 8601 format of
340 "YYYY-MM-DD HH:MM:SS.SS". The returned string is 22 + 1 (NULL) characters
344 __gnat_current_time_string (char *result
)
346 const char *format
= "%Y-%m-%d %H:%M:%S";
347 /* Format string necessary to describe the ISO 8601 format */
349 const time_t t_val
= time (NULL
);
351 strftime (result
, 22, format
, localtime (&t_val
));
352 /* Convert the local time into a string following the ISO format, copying
353 at most 22 characters into the result string. */
358 /* The sub-seconds are manually set to zero since type time_t lacks the
359 precision necessary for nanoseconds. */
363 __gnat_to_gm_time (OS_Time
*p_time
, int *p_year
, int *p_month
, int *p_day
,
364 int *p_hours
, int *p_mins
, int *p_secs
)
367 time_t time
= (time_t) *p_time
;
370 /* On Windows systems, the time is sometimes rounded up to the nearest
371 even second, so if the number of seconds is odd, increment it. */
376 res
= gmtime (&time
);
379 *p_year
= res
->tm_year
;
380 *p_month
= res
->tm_mon
;
381 *p_day
= res
->tm_mday
;
382 *p_hours
= res
->tm_hour
;
383 *p_mins
= res
->tm_min
;
384 *p_secs
= res
->tm_sec
;
387 *p_year
= *p_month
= *p_day
= *p_hours
= *p_mins
= *p_secs
= 0;
391 __gnat_to_os_time (OS_Time
*p_time
, int year
, int month
, int day
,
392 int hours
, int mins
, int secs
)
404 /* returns -1 of failing, this is s-os_lib Invalid_Time */
406 *p_time
= (OS_Time
) mktime (&v
);
409 /* Place the contents of the symbolic link named PATH in the buffer BUF,
410 which has size BUFSIZ. If PATH is a symbolic link, then return the number
411 of characters of its content in BUF. Otherwise, return -1.
412 For systems not supporting symbolic links, always return -1. */
415 __gnat_readlink (char *path ATTRIBUTE_UNUSED
,
416 char *buf ATTRIBUTE_UNUSED
,
417 size_t bufsiz ATTRIBUTE_UNUSED
)
419 #if defined (_WIN32) \
420 || defined(__vxworks) || defined (__nucleus__) || defined (__PikeOS__)
423 return readlink (path
, buf
, bufsiz
);
427 /* Creates a symbolic link named NEWPATH which contains the string OLDPATH.
428 If NEWPATH exists it will NOT be overwritten.
429 For systems not supporting symbolic links, always return -1. */
432 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED
,
433 char *newpath ATTRIBUTE_UNUSED
)
435 #if defined (_WIN32) \
436 || defined(__vxworks) || defined (__nucleus__) || defined (__PikeOS__)
439 return symlink (oldpath
, newpath
);
443 /* Try to lock a file, return 1 if success. */
445 #if defined (__vxworks) || defined (__nucleus__) \
446 || defined (_WIN32) || defined (__PikeOS__)
448 /* Version that does not use link. */
451 __gnat_try_lock (char *dir
, char *file
)
455 TCHAR wfull_path
[GNAT_MAX_PATH_LEN
];
456 TCHAR wfile
[GNAT_MAX_PATH_LEN
];
457 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
459 S2WSC (wdir
, dir
, GNAT_MAX_PATH_LEN
);
460 S2WSC (wfile
, file
, GNAT_MAX_PATH_LEN
);
462 _stprintf (wfull_path
, _T("%s%c%s"), wdir
, _T(DIR_SEPARATOR
), wfile
);
463 fd
= _topen (wfull_path
, O_CREAT
| O_EXCL
, 0600);
467 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
468 fd
= open (full_path
, O_CREAT
| O_EXCL
, 0600);
480 /* Version using link(), more secure over NFS. */
481 /* See TN 6913-016 for discussion ??? */
484 __gnat_try_lock (char *dir
, char *file
)
488 GNAT_STRUCT_STAT stat_result
;
491 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
492 sprintf (temp_file
, "%s%cTMP-%ld-%ld",
493 dir
, DIR_SEPARATOR
, (long)getpid(), (long)getppid ());
495 /* Create the temporary file and write the process number. */
496 fd
= open (temp_file
, O_CREAT
| O_WRONLY
, 0600);
502 /* Link it with the new file. */
503 link (temp_file
, full_path
);
505 /* Count the references on the old one. If we have a count of two, then
506 the link did succeed. Remove the temporary file before returning. */
507 __gnat_stat (temp_file
, &stat_result
);
509 return stat_result
.st_nlink
== 2;
513 /* Return the maximum file name length. */
516 __gnat_get_maximum_file_name_length (void)
521 /* Return nonzero if file names are case sensitive. */
523 static int file_names_case_sensitive_cache
= -1;
526 __gnat_get_file_names_case_sensitive (void)
528 if (file_names_case_sensitive_cache
== -1)
530 const char *sensitive
= getenv ("GNAT_FILE_NAME_CASE_SENSITIVE");
532 if (sensitive
!= NULL
533 && (sensitive
[0] == '0' || sensitive
[0] == '1')
534 && sensitive
[1] == '\0')
535 file_names_case_sensitive_cache
= sensitive
[0] - '0';
537 #if defined (WINNT) || defined (__APPLE__)
538 file_names_case_sensitive_cache
= 0;
540 file_names_case_sensitive_cache
= 1;
543 return file_names_case_sensitive_cache
;
546 /* Return nonzero if environment variables are case sensitive. */
549 __gnat_get_env_vars_case_sensitive (void)
559 __gnat_get_default_identifier_character_set (void)
564 /* Return the current working directory. */
567 __gnat_get_current_dir (char *dir
, int *length
)
569 #if defined (__MINGW32__)
570 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
572 _tgetcwd (wdir
, *length
);
574 WS2SC (dir
, wdir
, GNAT_MAX_PATH_LEN
);
577 getcwd (dir
, *length
);
580 *length
= strlen (dir
);
582 if (dir
[*length
- 1] != DIR_SEPARATOR
)
584 dir
[*length
] = DIR_SEPARATOR
;
590 /* Return the suffix for object files. */
593 __gnat_get_object_suffix_ptr (int *len
, const char **value
)
595 *value
= HOST_OBJECT_SUFFIX
;
600 *len
= strlen (*value
);
605 /* Return the suffix for executable files. */
608 __gnat_get_executable_suffix_ptr (int *len
, const char **value
)
610 *value
= HOST_EXECUTABLE_SUFFIX
;
614 *len
= strlen (*value
);
619 /* Return the suffix for debuggable files. Usually this is the same as the
620 executable extension. */
623 __gnat_get_debuggable_suffix_ptr (int *len
, const char **value
)
625 *value
= HOST_EXECUTABLE_SUFFIX
;
630 *len
= strlen (*value
);
635 /* Returns the OS filename and corresponding encoding. */
638 __gnat_os_filename (char *filename ATTRIBUTE_UNUSED
,
639 char *w_filename ATTRIBUTE_UNUSED
,
640 char *os_name
, int *o_length
,
641 char *encoding ATTRIBUTE_UNUSED
, int *e_length
)
643 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
644 WS2SC (os_name
, (TCHAR
*)w_filename
, (DWORD
)*o_length
);
645 *o_length
= strlen (os_name
);
646 strcpy (encoding
, "encoding=utf8");
647 *e_length
= strlen (encoding
);
649 strcpy (os_name
, filename
);
650 *o_length
= strlen (filename
);
658 __gnat_unlink (char *path
)
660 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
662 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
664 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
665 return _tunlink (wpath
);
668 return unlink (path
);
675 __gnat_rename (char *from
, char *to
)
677 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
679 TCHAR wfrom
[GNAT_MAX_PATH_LEN
], wto
[GNAT_MAX_PATH_LEN
];
681 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
);
682 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
);
683 return _trename (wfrom
, wto
);
686 return rename (from
, to
);
690 /* Changing directory. */
693 __gnat_chdir (char *path
)
695 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
697 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
699 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
700 return _tchdir (wpath
);
707 /* Removing a directory. */
710 __gnat_rmdir (char *path
)
712 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
714 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
716 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
717 return _trmdir (wpath
);
719 #elif defined (VTHREADS)
720 /* rmdir not available */
727 #if defined (_WIN32) || defined (linux) || defined (sun) \
728 || defined (__FreeBSD__)
729 #define HAS_TARGET_WCHAR_T
732 #ifdef HAS_TARGET_WCHAR_T
737 __gnat_fputwc(int c
, FILE *stream
)
739 #ifdef HAS_TARGET_WCHAR_T
740 return fputwc ((wchar_t)c
, stream
);
742 return fputc (c
, stream
);
747 __gnat_fopen (char *path
, char *mode
, int encoding ATTRIBUTE_UNUSED
)
749 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
750 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
753 S2WS (wmode
, mode
, 10);
755 if (encoding
== Encoding_Unspecified
)
756 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
757 else if (encoding
== Encoding_UTF8
)
758 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
760 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
762 return _tfopen (wpath
, wmode
);
765 return GNAT_FOPEN (path
, mode
);
770 __gnat_freopen (char *path
,
773 int encoding ATTRIBUTE_UNUSED
)
775 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
776 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
779 S2WS (wmode
, mode
, 10);
781 if (encoding
== Encoding_Unspecified
)
782 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
783 else if (encoding
== Encoding_UTF8
)
784 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
786 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
788 return _tfreopen (wpath
, wmode
, stream
);
790 return freopen (path
, mode
, stream
);
795 __gnat_open_read (char *path
, int fmode
)
798 int o_fmode
= O_BINARY
;
803 #if defined (__vxworks)
804 fd
= open (path
, O_RDONLY
| o_fmode
, 0444);
805 #elif defined (__MINGW32__)
807 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
809 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
810 fd
= _topen (wpath
, O_RDONLY
| o_fmode
, 0444);
813 fd
= GNAT_OPEN (path
, O_RDONLY
| o_fmode
);
816 return fd
< 0 ? -1 : fd
;
819 #if defined (__MINGW32__)
820 #define PERM (S_IREAD | S_IWRITE)
822 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
826 __gnat_open_rw (char *path
, int fmode
)
829 int o_fmode
= O_BINARY
;
834 #if defined (__MINGW32__)
836 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
838 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
839 fd
= _topen (wpath
, O_RDWR
| o_fmode
, PERM
);
842 fd
= GNAT_OPEN (path
, O_RDWR
| o_fmode
, PERM
);
845 return fd
< 0 ? -1 : fd
;
849 __gnat_open_create (char *path
, int fmode
)
852 int o_fmode
= O_BINARY
;
857 #if defined (__MINGW32__)
859 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
861 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
862 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
865 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
868 return fd
< 0 ? -1 : fd
;
872 __gnat_create_output_file (char *path
)
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_TEXT
, PERM
);
883 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
886 return fd
< 0 ? -1 : fd
;
890 __gnat_create_output_file_new (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
| O_EXCL
, PERM
);
901 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
904 return fd
< 0 ? -1 : fd
;
908 __gnat_open_append (char *path
, int fmode
)
911 int o_fmode
= O_BINARY
;
916 #if defined (__MINGW32__)
918 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
920 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
921 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
924 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
927 return fd
< 0 ? -1 : fd
;
930 /* Open a new file. Return error (-1) if the file already exists. */
933 __gnat_open_new (char *path
, int fmode
)
936 int o_fmode
= O_BINARY
;
941 #if defined (__MINGW32__)
943 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
945 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
946 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
949 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
952 return fd
< 0 ? -1 : fd
;
955 /* Open a new temp file. Return error (-1) if the file already exists. */
958 __gnat_open_new_temp (char *path
, int fmode
)
961 int o_fmode
= O_BINARY
;
963 strcpy (path
, "GNAT-XXXXXX");
965 #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
966 || defined (linux) || defined(__GLIBC__)) && !defined (__vxworks)
967 return mkstemp (path
);
968 #elif defined (__Lynx__)
970 #elif defined (__nucleus__)
973 if (mktemp (path
) == NULL
)
980 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
981 return fd
< 0 ? -1 : fd
;
985 __gnat_open (char *path
, int fmode
)
989 #if defined (__MINGW32__)
991 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
993 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
994 fd
= _topen (wpath
, fmode
, PERM
);
997 fd
= GNAT_OPEN (path
, fmode
, PERM
);
1000 return fd
< 0 ? -1 : fd
;
1003 /****************************************************************
1004 ** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information
1005 ** as possible from it, storing the result in a cache for later reuse
1006 ****************************************************************/
1009 __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
)
1011 GNAT_STRUCT_STAT statbuf
;
1015 /* GNAT_FSTAT returns -1 and sets errno for failure */
1016 ret
= GNAT_FSTAT (fd
, &statbuf
);
1017 error
= ret
? errno
: 0;
1020 /* __gnat_stat returns errno value directly */
1021 error
= __gnat_stat (name
, &statbuf
);
1022 ret
= error
? -1 : 0;
1026 * A missing file is reported as an attr structure with error == 0 and
1030 if (error
== 0 || error
== ENOENT
)
1033 attr
->error
= error
;
1035 attr
->regular
= (!ret
&& S_ISREG (statbuf
.st_mode
));
1036 attr
->directory
= (!ret
&& S_ISDIR (statbuf
.st_mode
));
1039 attr
->file_length
= 0;
1041 /* st_size may be 32 bits, or 64 bits which is converted to long. We
1042 don't return a useful value for files larger than 2 gigabytes in
1044 attr
->file_length
= statbuf
.st_size
; /* all systems */
1046 attr
->exists
= !ret
;
1048 #if !defined (_WIN32) || defined (RTX)
1049 /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
1050 attr
->readable
= (!ret
&& (statbuf
.st_mode
& S_IRUSR
));
1051 attr
->writable
= (!ret
&& (statbuf
.st_mode
& S_IWUSR
));
1052 attr
->executable
= (!ret
&& (statbuf
.st_mode
& S_IXUSR
));
1056 attr
->timestamp
= (OS_Time
)-1;
1058 attr
->timestamp
= (OS_Time
)statbuf
.st_mtime
;
1062 /****************************************************************
1063 ** Return the number of bytes in the specified file
1064 ****************************************************************/
1067 __gnat_file_length_attr (int fd
, char* name
, struct file_attributes
* attr
)
1069 if (attr
->file_length
== -1) {
1070 __gnat_stat_to_attr (fd
, name
, attr
);
1073 return attr
->file_length
;
1077 __gnat_file_length (int fd
)
1079 struct file_attributes attr
;
1080 __gnat_reset_attributes (&attr
);
1081 return __gnat_file_length_attr (fd
, NULL
, &attr
);
1085 __gnat_file_length_long (int fd
)
1087 struct file_attributes attr
;
1088 __gnat_reset_attributes (&attr
);
1089 return (long)__gnat_file_length_attr (fd
, NULL
, &attr
);
1093 __gnat_named_file_length (char *name
)
1095 struct file_attributes attr
;
1096 __gnat_reset_attributes (&attr
);
1097 return __gnat_file_length_attr (-1, name
, &attr
);
1100 /* Create a temporary filename and put it in string pointed to by
1104 __gnat_tmp_name (char *tmp_filename
)
1107 /* Variable used to create a series of unique names */
1108 static int counter
= 0;
1110 /* RTX in RTSS mode does not support tempnam nor tmpnam so we emulate it */
1111 strcpy (tmp_filename
, "c:\\WINDOWS\\Temp\\gnat-");
1112 sprintf (&tmp_filename
[strlen (tmp_filename
)], "%d\0", counter
++);
1114 #elif defined (__MINGW32__)
1119 /* tempnam tries to create a temporary file in directory pointed to by
1120 TMP environment variable, in c:\temp if TMP is not set, and in
1121 directory specified by P_tmpdir in stdio.h if c:\temp does not
1122 exist. The filename will be created with the prefix "gnat-". */
1124 sprintf (prefix
, "gnat-%d-", (int)getpid());
1125 pname
= (char *) _tempnam ("c:\\temp", prefix
);
1127 /* if pname is NULL, the file was not created properly, the disk is full
1128 or there is no more free temporary files */
1131 *tmp_filename
= '\0';
1133 /* If pname start with a back slash and not path information it means that
1134 the filename is valid for the current working directory. */
1136 else if (pname
[0] == '\\')
1138 strcpy (tmp_filename
, ".\\");
1139 strcat (tmp_filename
, pname
+1);
1142 strcpy (tmp_filename
, pname
);
1147 #elif defined (linux) || defined (__FreeBSD__) || defined (__NetBSD__) \
1148 || defined (__OpenBSD__) || defined(__GLIBC__) || defined (__ANDROID__)
1149 #define MAX_SAFE_PATH 1000
1150 char *tmpdir
= getenv ("TMPDIR");
1152 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1153 a buffer overflow. */
1154 if (tmpdir
== NULL
|| strlen (tmpdir
) > MAX_SAFE_PATH
)
1156 strcpy (tmp_filename
, "/cache/gnat-XXXXXX");
1158 strcpy (tmp_filename
, "/tmp/gnat-XXXXXX");
1161 sprintf (tmp_filename
, "%s/gnat-XXXXXX", tmpdir
);
1163 close (mkstemp(tmp_filename
));
1164 #elif defined (__vxworks) && !(defined (__RTP__) || defined (VTHREADS))
1168 static ushort_t seed
= 0; /* used to generate unique name */
1170 /* generate unique name */
1171 strcpy (tmp_filename
, "tmp");
1173 /* fill up the name buffer from the last position */
1175 pos
= tmp_filename
+ strlen (tmp_filename
) + index
;
1179 for (t
= seed
; 0 <= --index
; t
>>= 3)
1180 *--pos
= '0' + (t
& 07);
1182 tmpnam (tmp_filename
);
1186 /* Open directory and returns a DIR pointer. */
1188 DIR* __gnat_opendir (char *name
)
1191 /* Not supported in RTX */
1195 #elif defined (__MINGW32__)
1196 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1198 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1199 return (DIR*)_topendir (wname
);
1202 return opendir (name
);
1206 /* Read the next entry in a directory. The returned string points somewhere
1210 __gnat_readdir (DIR *dirp
, char *buffer
, int *len
)
1213 /* Not supported in RTX */
1217 #elif defined (__MINGW32__)
1218 struct _tdirent
*dirent
= _treaddir ((_TDIR
*)dirp
);
1222 WS2SC (buffer
, dirent
->d_name
, GNAT_MAX_PATH_LEN
);
1223 *len
= strlen (buffer
);
1230 #elif defined (HAVE_READDIR_R)
1231 /* If possible, try to use the thread-safe version. */
1232 if (readdir_r (dirp
, buffer
) != NULL
)
1234 *len
= strlen (((struct dirent
*) buffer
)->d_name
);
1235 return ((struct dirent
*) buffer
)->d_name
;
1241 struct dirent
*dirent
= (struct dirent
*) readdir (dirp
);
1245 strcpy (buffer
, dirent
->d_name
);
1246 *len
= strlen (buffer
);
1255 /* Close a directory entry. */
1257 int __gnat_closedir (DIR *dirp
)
1260 /* Not supported in RTX */
1264 #elif defined (__MINGW32__)
1265 return _tclosedir ((_TDIR
*)dirp
);
1268 return closedir (dirp
);
1272 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1275 __gnat_readdir_is_thread_safe (void)
1277 #ifdef HAVE_READDIR_R
1284 #if defined (_WIN32) && !defined (RTX)
1285 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1286 static const unsigned long long w32_epoch_offset
= 11644473600ULL;
1288 /* Returns the file modification timestamp using Win32 routines which are
1289 immune against daylight saving time change. It is in fact not possible to
1290 use fstat for this purpose as the DST modify the st_mtime field of the
1294 win32_filetime (HANDLE h
)
1299 unsigned long long ull_time
;
1302 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1303 since <Jan 1st 1601>. This function must return the number of seconds
1304 since <Jan 1st 1970>. */
1306 if (GetFileTime (h
, NULL
, NULL
, &t_write
.ft_time
))
1307 return (time_t) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1311 /* As above but starting from a FILETIME. */
1313 f2t (const FILETIME
*ft
, time_t *t
)
1318 unsigned long long ull_time
;
1321 t_write
.ft_time
= *ft
;
1322 *t
= (time_t) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1326 /* Return a GNAT time stamp given a file name. */
1329 __gnat_file_time_name_attr (char* name
, struct file_attributes
* attr
)
1331 if (attr
->timestamp
== (OS_Time
)-2) {
1332 #if defined (_WIN32) && !defined (RTX)
1334 WIN32_FILE_ATTRIBUTE_DATA fad
;
1336 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1337 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1339 if ((res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
)))
1340 f2t (&fad
.ftLastWriteTime
, &ret
);
1341 attr
->timestamp
= (OS_Time
) ret
;
1343 __gnat_stat_to_attr (-1, name
, attr
);
1346 return attr
->timestamp
;
1350 __gnat_file_time_name (char *name
)
1352 struct file_attributes attr
;
1353 __gnat_reset_attributes (&attr
);
1354 return __gnat_file_time_name_attr (name
, &attr
);
1357 /* Return a GNAT time stamp given a file descriptor. */
1360 __gnat_file_time_fd_attr (int fd
, struct file_attributes
* attr
)
1362 if (attr
->timestamp
== (OS_Time
)-2) {
1363 #if defined (_WIN32) && !defined (RTX)
1364 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
1365 time_t ret
= win32_filetime (h
);
1366 attr
->timestamp
= (OS_Time
) ret
;
1369 __gnat_stat_to_attr (fd
, NULL
, attr
);
1373 return attr
->timestamp
;
1377 __gnat_file_time_fd (int fd
)
1379 struct file_attributes attr
;
1380 __gnat_reset_attributes (&attr
);
1381 return __gnat_file_time_fd_attr (fd
, &attr
);
1384 /* Set the file time stamp. */
1387 __gnat_set_file_time_name (char *name
, time_t time_stamp
)
1389 #if defined (__vxworks)
1391 /* Code to implement __gnat_set_file_time_name for these systems. */
1393 #elif defined (_WIN32) && !defined (RTX)
1397 unsigned long long ull_time
;
1399 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1401 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1403 HANDLE h
= CreateFile
1404 (wname
, GENERIC_WRITE
, FILE_SHARE_WRITE
, NULL
,
1405 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
,
1407 if (h
== INVALID_HANDLE_VALUE
)
1409 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1410 t_write
.ull_time
= ((unsigned long long)time_stamp
+ w32_epoch_offset
);
1411 /* Convert to 100 nanosecond units */
1412 t_write
.ull_time
*= 10000000ULL;
1414 SetFileTime(h
, NULL
, NULL
, &t_write
.ft_time
);
1419 struct utimbuf utimbuf
;
1422 /* Set modification time to requested time. */
1423 utimbuf
.modtime
= time_stamp
;
1425 /* Set access time to now in local time. */
1426 t
= time ((time_t) 0);
1427 utimbuf
.actime
= mktime (localtime (&t
));
1429 utime (name
, &utimbuf
);
1433 /* Get the list of installed standard libraries from the
1434 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1438 __gnat_get_libraries_from_registry (void)
1440 char *result
= (char *) xmalloc (1);
1444 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS) \
1448 DWORD name_size
, value_size
;
1455 /* First open the key. */
1456 res
= RegOpenKeyExA (HKEY_LOCAL_MACHINE
, "SOFTWARE", 0, KEY_READ
, ®_key
);
1458 if (res
== ERROR_SUCCESS
)
1459 res
= RegOpenKeyExA (reg_key
, "Ada Core Technologies", 0,
1460 KEY_READ
, ®_key
);
1462 if (res
== ERROR_SUCCESS
)
1463 res
= RegOpenKeyExA (reg_key
, "GNAT", 0, KEY_READ
, ®_key
);
1465 if (res
== ERROR_SUCCESS
)
1466 res
= RegOpenKeyExA (reg_key
, "Standard Libraries", 0, KEY_READ
, ®_key
);
1468 /* If the key exists, read out all the values in it and concatenate them
1470 for (index
= 0; res
== ERROR_SUCCESS
; index
++)
1472 value_size
= name_size
= 256;
1473 res
= RegEnumValueA (reg_key
, index
, name
, &name_size
, 0,
1474 &type
, (LPBYTE
)value
, &value_size
);
1476 if (res
== ERROR_SUCCESS
&& type
== REG_SZ
)
1478 char *old_result
= result
;
1480 result
= (char *) xmalloc (strlen (old_result
) + value_size
+ 2);
1481 strcpy (result
, old_result
);
1482 strcat (result
, value
);
1483 strcat (result
, ";");
1488 /* Remove the trailing ";". */
1490 result
[strlen (result
) - 1] = 0;
1496 /* Query information for the given file NAME and return it in STATBUF.
1497 * Returns 0 for success, or errno value for failure.
1500 __gnat_stat (char *name
, GNAT_STRUCT_STAT
*statbuf
)
1503 WIN32_FILE_ATTRIBUTE_DATA fad
;
1504 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1509 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1510 name_len
= _tcslen (wname
);
1512 if (name_len
> GNAT_MAX_PATH_LEN
)
1515 ZeroMemory (statbuf
, sizeof(GNAT_STRUCT_STAT
));
1517 res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
);
1520 error
= GetLastError();
1522 /* Check file existence using GetFileAttributes() which does not fail on
1523 special Windows files like con:, aux:, nul: etc... */
1525 if (GetFileAttributes(wname
) != INVALID_FILE_ATTRIBUTES
) {
1526 /* Just pretend that it is a regular and readable file */
1527 statbuf
->st_mode
= S_IFREG
| S_IREAD
| S_IWRITE
;
1532 case ERROR_ACCESS_DENIED
:
1533 case ERROR_SHARING_VIOLATION
:
1534 case ERROR_LOCK_VIOLATION
:
1535 case ERROR_SHARING_BUFFER_EXCEEDED
:
1537 case ERROR_BUFFER_OVERFLOW
:
1538 return ENAMETOOLONG
;
1539 case ERROR_NOT_ENOUGH_MEMORY
:
1546 f2t (&fad
.ftCreationTime
, &statbuf
->st_ctime
);
1547 f2t (&fad
.ftLastWriteTime
, &statbuf
->st_mtime
);
1548 f2t (&fad
.ftLastAccessTime
, &statbuf
->st_atime
);
1551 (__int64
)fad
.nFileSizeLow
| (__int64
)fad
.nFileSizeHigh
<< 32;
1553 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1554 statbuf
->st_mode
= S_IREAD
;
1556 if (fad
.dwFileAttributes
& FILE_ATTRIBUTE_DIRECTORY
)
1557 statbuf
->st_mode
|= S_IFDIR
;
1559 statbuf
->st_mode
|= S_IFREG
;
1561 if (!(fad
.dwFileAttributes
& FILE_ATTRIBUTE_READONLY
))
1562 statbuf
->st_mode
|= S_IWRITE
;
1567 return GNAT_STAT (name
, statbuf
) == 0 ? 0 : errno
;
1571 /*************************************************************************
1572 ** Check whether a file exists
1573 *************************************************************************/
1576 __gnat_file_exists_attr (char* name
, struct file_attributes
* attr
)
1578 if (attr
->exists
== ATTR_UNSET
)
1579 __gnat_stat_to_attr (-1, name
, attr
);
1581 return attr
->exists
;
1585 __gnat_file_exists (char *name
)
1587 struct file_attributes attr
;
1588 __gnat_reset_attributes (&attr
);
1589 return __gnat_file_exists_attr (name
, &attr
);
1592 /**********************************************************************
1593 ** Whether name is an absolute path
1594 **********************************************************************/
1597 __gnat_is_absolute_path (char *name
, int length
)
1600 /* On VxWorks systems, an absolute path can be represented (depending on
1601 the host platform) as either /dir/file, or device:/dir/file, or
1602 device:drive_letter:/dir/file. */
1609 for (index
= 0; index
< length
; index
++)
1611 if (name
[index
] == ':' &&
1612 ((name
[index
+ 1] == '/') ||
1613 (isalpha (name
[index
+ 1]) && index
+ 2 <= length
&&
1614 name
[index
+ 2] == '/')))
1617 else if (name
[index
] == '/')
1622 return (length
!= 0) &&
1623 (*name
== '/' || *name
== DIR_SEPARATOR
1625 || (length
> 1 && ISALPHA (name
[0]) && name
[1] == ':')
1632 __gnat_is_regular_file_attr (char* name
, struct file_attributes
* attr
)
1634 if (attr
->regular
== ATTR_UNSET
)
1635 __gnat_stat_to_attr (-1, name
, attr
);
1637 return attr
->regular
;
1641 __gnat_is_regular_file (char *name
)
1643 struct file_attributes attr
;
1645 __gnat_reset_attributes (&attr
);
1646 return __gnat_is_regular_file_attr (name
, &attr
);
1650 __gnat_is_regular_file_fd (int fd
)
1653 GNAT_STRUCT_STAT statbuf
;
1655 ret
= GNAT_FSTAT (fd
, &statbuf
);
1656 return (!ret
&& S_ISREG (statbuf
.st_mode
));
1660 __gnat_is_directory_attr (char* name
, struct file_attributes
* attr
)
1662 if (attr
->directory
== ATTR_UNSET
)
1663 __gnat_stat_to_attr (-1, name
, attr
);
1665 return attr
->directory
;
1669 __gnat_is_directory (char *name
)
1671 struct file_attributes attr
;
1673 __gnat_reset_attributes (&attr
);
1674 return __gnat_is_directory_attr (name
, &attr
);
1677 #if defined (_WIN32) && !defined (RTX)
1679 /* Returns the same constant as GetDriveType but takes a pathname as
1683 GetDriveTypeFromPath (TCHAR
*wfullpath
)
1685 TCHAR wdrv
[MAX_PATH
];
1686 TCHAR wpath
[MAX_PATH
];
1687 TCHAR wfilename
[MAX_PATH
];
1688 TCHAR wext
[MAX_PATH
];
1690 _tsplitpath (wfullpath
, wdrv
, wpath
, wfilename
, wext
);
1692 if (_tcslen (wdrv
) != 0)
1694 /* we have a drive specified. */
1695 _tcscat (wdrv
, _T("\\"));
1696 return GetDriveType (wdrv
);
1700 /* No drive specified. */
1702 /* Is this a relative path, if so get current drive type. */
1703 if (wpath
[0] != _T('\\') ||
1704 (_tcslen (wpath
) > 2 && wpath
[0] == _T('\\')
1705 && wpath
[1] != _T('\\')))
1706 return GetDriveType (NULL
);
1708 UINT result
= GetDriveType (wpath
);
1710 /* Cannot guess the drive type, is this \\.\ ? */
1712 if (result
== DRIVE_NO_ROOT_DIR
&&
1713 _tcslen (wpath
) >= 4 && wpath
[0] == _T('\\') && wpath
[1] == _T('\\')
1714 && wpath
[2] == _T('.') && wpath
[3] == _T('\\'))
1716 if (_tcslen (wpath
) == 4)
1717 _tcscat (wpath
, wfilename
);
1719 LPTSTR p
= &wpath
[4];
1720 LPTSTR b
= _tcschr (p
, _T('\\'));
1724 /* logical drive \\.\c\dir\file */
1730 _tcscat (p
, _T(":\\"));
1732 return GetDriveType (p
);
1739 /* This MingW section contains code to work with ACL. */
1741 __gnat_check_OWNER_ACL (TCHAR
*wname
,
1742 DWORD CheckAccessDesired
,
1743 GENERIC_MAPPING CheckGenericMapping
)
1745 DWORD dwAccessDesired
, dwAccessAllowed
;
1746 PRIVILEGE_SET PrivilegeSet
;
1747 DWORD dwPrivSetSize
= sizeof (PRIVILEGE_SET
);
1748 BOOL fAccessGranted
= FALSE
;
1749 HANDLE hToken
= NULL
;
1751 SECURITY_DESCRIPTOR
* pSD
= NULL
;
1754 (wname
, OWNER_SECURITY_INFORMATION
|
1755 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1758 if ((pSD
= (SECURITY_DESCRIPTOR
*) HeapAlloc
1759 (GetProcessHeap (), HEAP_ZERO_MEMORY
, nLength
)) == NULL
)
1762 /* Obtain the security descriptor. */
1764 if (!GetFileSecurity
1765 (wname
, OWNER_SECURITY_INFORMATION
|
1766 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1767 pSD
, nLength
, &nLength
))
1770 if (!ImpersonateSelf (SecurityImpersonation
))
1773 if (!OpenThreadToken
1774 (GetCurrentThread(), TOKEN_DUPLICATE
| TOKEN_QUERY
, FALSE
, &hToken
))
1777 /* Undoes the effect of ImpersonateSelf. */
1781 /* We want to test for write permissions. */
1783 dwAccessDesired
= CheckAccessDesired
;
1785 MapGenericMask (&dwAccessDesired
, &CheckGenericMapping
);
1788 (pSD
, /* security descriptor to check */
1789 hToken
, /* impersonation token */
1790 dwAccessDesired
, /* requested access rights */
1791 &CheckGenericMapping
, /* pointer to GENERIC_MAPPING */
1792 &PrivilegeSet
, /* receives privileges used in check */
1793 &dwPrivSetSize
, /* size of PrivilegeSet buffer */
1794 &dwAccessAllowed
, /* receives mask of allowed access rights */
1798 CloseHandle (hToken
);
1799 HeapFree (GetProcessHeap (), 0, pSD
);
1800 return fAccessGranted
;
1804 CloseHandle (hToken
);
1805 HeapFree (GetProcessHeap (), 0, pSD
);
1810 __gnat_set_OWNER_ACL (TCHAR
*wname
,
1812 DWORD AccessPermissions
)
1814 PACL pOldDACL
= NULL
;
1815 PACL pNewDACL
= NULL
;
1816 PSECURITY_DESCRIPTOR pSD
= NULL
;
1818 TCHAR username
[100];
1821 /* Get current user, he will act as the owner */
1823 if (!GetUserName (username
, &unsize
))
1826 if (GetNamedSecurityInfo
1829 DACL_SECURITY_INFORMATION
,
1830 NULL
, NULL
, &pOldDACL
, NULL
, &pSD
) != ERROR_SUCCESS
)
1833 BuildExplicitAccessWithName
1834 (&ea
, username
, AccessPermissions
, (ACCESS_MODE
) AccessMode
, NO_INHERITANCE
);
1836 if (AccessMode
== SET_ACCESS
)
1838 /* SET_ACCESS, we want to set an explicte set of permissions, do not
1839 merge with current DACL. */
1840 if (SetEntriesInAcl (1, &ea
, NULL
, &pNewDACL
) != ERROR_SUCCESS
)
1844 if (SetEntriesInAcl (1, &ea
, pOldDACL
, &pNewDACL
) != ERROR_SUCCESS
)
1847 if (SetNamedSecurityInfo
1848 (wname
, SE_FILE_OBJECT
,
1849 DACL_SECURITY_INFORMATION
, NULL
, NULL
, pNewDACL
, NULL
) != ERROR_SUCCESS
)
1853 LocalFree (pNewDACL
);
1856 /* Check if it is possible to use ACL for wname, the file must not be on a
1860 __gnat_can_use_acl (TCHAR
*wname
)
1862 return __gnat_use_acl
&& GetDriveTypeFromPath (wname
) != DRIVE_REMOTE
;
1865 #endif /* defined (_WIN32) && !defined (RTX) */
1868 __gnat_is_readable_file_attr (char* name
, struct file_attributes
* attr
)
1870 if (attr
->readable
== ATTR_UNSET
)
1872 #if defined (_WIN32) && !defined (RTX)
1873 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1874 GENERIC_MAPPING GenericMapping
;
1876 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1878 if (__gnat_can_use_acl (wname
))
1880 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1881 GenericMapping
.GenericRead
= GENERIC_READ
;
1883 __gnat_check_OWNER_ACL (wname
, FILE_READ_DATA
, GenericMapping
);
1886 attr
->readable
= GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
;
1888 __gnat_stat_to_attr (-1, name
, attr
);
1892 return attr
->readable
;
1896 __gnat_is_readable_file (char *name
)
1898 struct file_attributes attr
;
1900 __gnat_reset_attributes (&attr
);
1901 return __gnat_is_readable_file_attr (name
, &attr
);
1905 __gnat_is_writable_file_attr (char* name
, struct file_attributes
* attr
)
1907 if (attr
->writable
== ATTR_UNSET
)
1909 #if defined (_WIN32) && !defined (RTX)
1910 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1911 GENERIC_MAPPING GenericMapping
;
1913 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1915 if (__gnat_can_use_acl (wname
))
1917 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1918 GenericMapping
.GenericWrite
= GENERIC_WRITE
;
1920 attr
->writable
= __gnat_check_OWNER_ACL
1921 (wname
, FILE_WRITE_DATA
| FILE_APPEND_DATA
, GenericMapping
)
1922 && !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
1926 !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
1929 __gnat_stat_to_attr (-1, name
, attr
);
1933 return attr
->writable
;
1937 __gnat_is_writable_file (char *name
)
1939 struct file_attributes attr
;
1941 __gnat_reset_attributes (&attr
);
1942 return __gnat_is_writable_file_attr (name
, &attr
);
1946 __gnat_is_executable_file_attr (char* name
, struct file_attributes
* attr
)
1948 if (attr
->executable
== ATTR_UNSET
)
1950 #if defined (_WIN32) && !defined (RTX)
1951 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1952 GENERIC_MAPPING GenericMapping
;
1954 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1956 if (__gnat_can_use_acl (wname
))
1958 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1959 GenericMapping
.GenericExecute
= GENERIC_EXECUTE
;
1962 __gnat_check_OWNER_ACL (wname
, FILE_EXECUTE
, GenericMapping
);
1966 TCHAR
*l
, *last
= _tcsstr(wname
, _T(".exe"));
1968 /* look for last .exe */
1970 while ((l
= _tcsstr(last
+1, _T(".exe"))))
1974 GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
1975 && (last
- wname
) == (int) (_tcslen (wname
) - 4);
1978 __gnat_stat_to_attr (-1, name
, attr
);
1982 return attr
->regular
&& attr
->executable
;
1986 __gnat_is_executable_file (char *name
)
1988 struct file_attributes attr
;
1990 __gnat_reset_attributes (&attr
);
1991 return __gnat_is_executable_file_attr (name
, &attr
);
1995 __gnat_set_writable (char *name
)
1997 #if defined (_WIN32) && !defined (RTX)
1998 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2000 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2002 if (__gnat_can_use_acl (wname
))
2003 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_WRITE
);
2006 (wname
, GetFileAttributes (wname
) & ~FILE_ATTRIBUTE_READONLY
);
2007 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2008 ! defined(__nucleus__)
2009 GNAT_STRUCT_STAT statbuf
;
2011 if (GNAT_STAT (name
, &statbuf
) == 0)
2013 statbuf
.st_mode
= statbuf
.st_mode
| S_IWUSR
;
2014 chmod (name
, statbuf
.st_mode
);
2019 /* must match definition in s-os_lib.ads */
2025 __gnat_set_executable (char *name
, int mode
)
2027 #if defined (_WIN32) && !defined (RTX)
2028 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2030 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2032 if (__gnat_can_use_acl (wname
))
2033 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_EXECUTE
);
2035 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2036 ! defined(__nucleus__)
2037 GNAT_STRUCT_STAT statbuf
;
2039 if (GNAT_STAT (name
, &statbuf
) == 0)
2042 statbuf
.st_mode
= statbuf
.st_mode
| S_IXUSR
;
2044 statbuf
.st_mode
= statbuf
.st_mode
| S_IXGRP
;
2045 if (mode
& S_OTHERS
)
2046 statbuf
.st_mode
= statbuf
.st_mode
| S_IXOTH
;
2047 chmod (name
, statbuf
.st_mode
);
2053 __gnat_set_non_writable (char *name
)
2055 #if defined (_WIN32) && !defined (RTX)
2056 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2058 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2060 if (__gnat_can_use_acl (wname
))
2061 __gnat_set_OWNER_ACL
2062 (wname
, DENY_ACCESS
,
2063 FILE_WRITE_DATA
| FILE_APPEND_DATA
|
2064 FILE_WRITE_EA
| FILE_WRITE_ATTRIBUTES
);
2067 (wname
, GetFileAttributes (wname
) | FILE_ATTRIBUTE_READONLY
);
2068 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2069 ! defined(__nucleus__)
2070 GNAT_STRUCT_STAT statbuf
;
2072 if (GNAT_STAT (name
, &statbuf
) == 0)
2074 statbuf
.st_mode
= statbuf
.st_mode
& 07577;
2075 chmod (name
, statbuf
.st_mode
);
2081 __gnat_set_readable (char *name
)
2083 #if defined (_WIN32) && !defined (RTX)
2084 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2086 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2088 if (__gnat_can_use_acl (wname
))
2089 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_READ
);
2091 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2092 ! defined(__nucleus__)
2093 GNAT_STRUCT_STAT statbuf
;
2095 if (GNAT_STAT (name
, &statbuf
) == 0)
2097 chmod (name
, statbuf
.st_mode
| S_IREAD
);
2103 __gnat_set_non_readable (char *name
)
2105 #if defined (_WIN32) && !defined (RTX)
2106 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2108 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2110 if (__gnat_can_use_acl (wname
))
2111 __gnat_set_OWNER_ACL (wname
, DENY_ACCESS
, FILE_GENERIC_READ
);
2113 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2114 ! defined(__nucleus__)
2115 GNAT_STRUCT_STAT statbuf
;
2117 if (GNAT_STAT (name
, &statbuf
) == 0)
2119 chmod (name
, statbuf
.st_mode
& (~S_IREAD
));
2125 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED
,
2126 struct file_attributes
* attr
)
2128 if (attr
->symbolic_link
== ATTR_UNSET
)
2130 #if defined (__vxworks) || defined (__nucleus__)
2131 attr
->symbolic_link
= 0;
2133 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2135 GNAT_STRUCT_STAT statbuf
;
2136 ret
= GNAT_LSTAT (name
, &statbuf
);
2137 attr
->symbolic_link
= (!ret
&& S_ISLNK (statbuf
.st_mode
));
2139 attr
->symbolic_link
= 0;
2142 return attr
->symbolic_link
;
2146 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED
)
2148 struct file_attributes attr
;
2150 __gnat_reset_attributes (&attr
);
2151 return __gnat_is_symbolic_link_attr (name
, &attr
);
2154 #if defined (sun) && defined (__SVR4)
2155 /* Using fork on Solaris will duplicate all the threads. fork1, which
2156 duplicates only the active thread, must be used instead, or spawning
2157 subprocess from a program with tasking will lead into numerous problems. */
2162 __gnat_portable_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2164 int status ATTRIBUTE_UNUSED
= 0;
2165 int finished ATTRIBUTE_UNUSED
;
2166 int pid ATTRIBUTE_UNUSED
;
2168 #if defined (__vxworks) || defined(__nucleus__) || defined(RTX) \
2169 || defined(__PikeOS__)
2172 #elif defined (_WIN32)
2173 /* args[0] must be quotes as it could contain a full pathname with spaces */
2174 char *args_0
= args
[0];
2175 args
[0] = (char *)xmalloc (strlen (args_0
) + 3);
2176 strcpy (args
[0], "\"");
2177 strcat (args
[0], args_0
);
2178 strcat (args
[0], "\"");
2180 status
= spawnvp (P_WAIT
, args_0
, (char* const*)args
);
2182 /* restore previous value */
2184 args
[0] = (char *)args_0
;
2200 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2205 finished
= waitpid (pid
, &status
, 0);
2207 if (finished
!= pid
|| WIFEXITED (status
) == 0)
2210 return WEXITSTATUS (status
);
2216 /* Create a copy of the given file descriptor.
2217 Return -1 if an error occurred. */
2220 __gnat_dup (int oldfd
)
2222 #if defined (__vxworks) && !defined (__RTP__)
2223 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2231 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2232 Return -1 if an error occurred. */
2235 __gnat_dup2 (int oldfd ATTRIBUTE_UNUSED
, int newfd ATTRIBUTE_UNUSED
)
2237 #if defined (__vxworks) && !defined (__RTP__)
2238 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2241 #elif defined (__PikeOS__)
2242 /* Not supported. */
2244 #elif defined (_WIN32)
2245 /* Special case when oldfd and newfd are identical and are the standard
2246 input, output or error as this makes Windows XP hangs. Note that we
2247 do that only for standard file descriptors that are known to be valid. */
2248 if (oldfd
== newfd
&& newfd
>= 0 && newfd
<= 2)
2251 return dup2 (oldfd
, newfd
);
2253 return dup2 (oldfd
, newfd
);
2258 __gnat_number_of_cpus (void)
2262 #if defined (linux) || defined (sun) || defined (AIX) || defined (__APPLE__)
2263 cores
= (int) sysconf (_SC_NPROCESSORS_ONLN
);
2265 #elif defined (__hpux__)
2266 struct pst_dynamic psd
;
2267 if (pstat_getdynamic (&psd
, sizeof (psd
), 1, 0) != -1)
2268 cores
= (int) psd
.psd_proc_cnt
;
2270 #elif defined (_WIN32)
2271 SYSTEM_INFO sysinfo
;
2272 GetSystemInfo (&sysinfo
);
2273 cores
= (int) sysinfo
.dwNumberOfProcessors
;
2275 #elif defined (_WRS_CONFIG_SMP)
2276 unsigned int vxCpuConfiguredGet (void);
2278 cores
= vxCpuConfiguredGet ();
2285 /* WIN32 code to implement a wait call that wait for any child process. */
2287 #if defined (_WIN32) && !defined (RTX)
2289 /* Synchronization code, to be thread safe. */
2293 /* For the Cert run times on native Windows we use dummy functions
2294 for locking and unlocking tasks since we do not support multiple
2295 threads on this configuration (Cert run time on native Windows). */
2297 static void dummy (void)
2301 void (*Lock_Task
) () = &dummy
;
2302 void (*Unlock_Task
) () = &dummy
;
2306 #define Lock_Task system__soft_links__lock_task
2307 extern void (*Lock_Task
) (void);
2309 #define Unlock_Task system__soft_links__unlock_task
2310 extern void (*Unlock_Task
) (void);
2314 static HANDLE
*HANDLES_LIST
= NULL
;
2315 static int *PID_LIST
= NULL
, plist_length
= 0, plist_max_length
= 0;
2318 add_handle (HANDLE h
, int pid
)
2321 /* -------------------- critical section -------------------- */
2324 if (plist_length
== plist_max_length
)
2326 plist_max_length
+= 1000;
2328 (void **) xrealloc (HANDLES_LIST
, sizeof (HANDLE
) * plist_max_length
);
2330 (int *) xrealloc (PID_LIST
, sizeof (int) * plist_max_length
);
2333 HANDLES_LIST
[plist_length
] = h
;
2334 PID_LIST
[plist_length
] = pid
;
2338 /* -------------------- critical section -------------------- */
2342 __gnat_win32_remove_handle (HANDLE h
, int pid
)
2346 /* -------------------- critical section -------------------- */
2349 for (j
= 0; j
< plist_length
; j
++)
2351 if ((HANDLES_LIST
[j
] == h
) || (PID_LIST
[j
] == pid
))
2355 HANDLES_LIST
[j
] = HANDLES_LIST
[plist_length
];
2356 PID_LIST
[j
] = PID_LIST
[plist_length
];
2362 /* -------------------- critical section -------------------- */
2366 win32_no_block_spawn (char *command
, char *args
[], HANDLE
*h
, int *pid
)
2370 PROCESS_INFORMATION PI
;
2371 SECURITY_ATTRIBUTES SA
;
2376 /* compute the total command line length */
2380 csize
+= strlen (args
[k
]) + 1;
2384 full_command
= (char *) xmalloc (csize
);
2387 SI
.cb
= sizeof (STARTUPINFO
);
2388 SI
.lpReserved
= NULL
;
2389 SI
.lpReserved2
= NULL
;
2390 SI
.lpDesktop
= NULL
;
2394 SI
.wShowWindow
= SW_HIDE
;
2396 /* Security attributes. */
2397 SA
.nLength
= sizeof (SECURITY_ATTRIBUTES
);
2398 SA
.bInheritHandle
= TRUE
;
2399 SA
.lpSecurityDescriptor
= NULL
;
2401 /* Prepare the command string. */
2402 strcpy (full_command
, command
);
2403 strcat (full_command
, " ");
2408 strcat (full_command
, args
[k
]);
2409 strcat (full_command
, " ");
2414 int wsize
= csize
* 2;
2415 TCHAR
*wcommand
= (TCHAR
*) xmalloc (wsize
);
2417 S2WSC (wcommand
, full_command
, wsize
);
2419 free (full_command
);
2421 result
= CreateProcess
2422 (NULL
, wcommand
, &SA
, NULL
, TRUE
,
2423 GetPriorityClass (GetCurrentProcess()), NULL
, NULL
, &SI
, &PI
);
2430 CloseHandle (PI
.hThread
);
2432 *pid
= PI
.dwProcessId
;
2442 win32_wait (int *status
)
2444 DWORD exitcode
, pid
;
2451 if (plist_length
== 0)
2459 /* -------------------- critical section -------------------- */
2462 hl_len
= plist_length
;
2464 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * hl_len
);
2466 memmove (hl
, HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2469 /* -------------------- critical section -------------------- */
2471 res
= WaitForMultipleObjects (hl_len
, hl
, FALSE
, INFINITE
);
2472 h
= hl
[res
- WAIT_OBJECT_0
];
2474 GetExitCodeProcess (h
, &exitcode
);
2475 pid
= PID_LIST
[res
- WAIT_OBJECT_0
];
2476 __gnat_win32_remove_handle (h
, -1);
2480 *status
= (int) exitcode
;
2487 __gnat_portable_no_block_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2490 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX) \
2491 || defined (__PikeOS__)
2492 /* Not supported. */
2495 #elif defined (_WIN32)
2500 win32_no_block_spawn (args
[0], args
, &h
, &pid
);
2503 add_handle (h
, pid
);
2516 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2526 __gnat_portable_wait (int *process_status
)
2531 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX) \
2532 || defined (__PikeOS__)
2533 /* Not sure what to do here, so do nothing but return zero. */
2535 #elif defined (_WIN32)
2537 pid
= win32_wait (&status
);
2541 pid
= waitpid (-1, &status
, 0);
2542 status
= status
& 0xffff;
2545 *process_status
= status
;
2550 __gnat_os_exit (int status
)
2555 /* Locate file on path, that matches a predicate */
2558 __gnat_locate_file_with_predicate (char *file_name
, char *path_val
,
2559 int (*predicate
)(char *))
2562 char *file_path
= (char *) alloca (strlen (file_name
) + 1);
2565 /* Return immediately if file_name is empty */
2567 if (*file_name
== '\0')
2570 /* Remove quotes around file_name if present */
2576 strcpy (file_path
, ptr
);
2578 ptr
= file_path
+ strlen (file_path
) - 1;
2583 /* Handle absolute pathnames. */
2585 absolute
= __gnat_is_absolute_path (file_path
, strlen (file_name
));
2589 if (predicate (file_path
))
2590 return xstrdup (file_path
);
2595 /* If file_name include directory separator(s), try it first as
2596 a path name relative to the current directory */
2597 for (ptr
= file_name
; *ptr
&& *ptr
!= '/' && *ptr
!= DIR_SEPARATOR
; ptr
++)
2602 if (predicate (file_name
))
2603 return xstrdup (file_name
);
2610 /* The result has to be smaller than path_val + file_name. */
2612 (char *) alloca (strlen (path_val
) + strlen (file_name
) + 2);
2616 /* Skip the starting quote */
2618 if (*path_val
== '"')
2621 for (ptr
= file_path
; *path_val
&& *path_val
!= PATH_SEPARATOR
; )
2622 *ptr
++ = *path_val
++;
2624 /* If directory is empty, it is the current directory*/
2626 if (ptr
== file_path
)
2633 /* Skip the ending quote */
2638 if (*ptr
!= '/' && *ptr
!= DIR_SEPARATOR
)
2639 *++ptr
= DIR_SEPARATOR
;
2641 strcpy (++ptr
, file_name
);
2643 if (predicate (file_path
))
2644 return xstrdup (file_path
);
2649 /* Skip path separator */
2658 /* Locate an executable file, give a Path value. */
2661 __gnat_locate_executable_file (char *file_name
, char *path_val
)
2663 return __gnat_locate_file_with_predicate
2664 (file_name
, path_val
, &__gnat_is_executable_file
);
2667 /* Locate a regular file, give a Path value. */
2670 __gnat_locate_regular_file (char *file_name
, char *path_val
)
2672 return __gnat_locate_file_with_predicate
2673 (file_name
, path_val
, &__gnat_is_regular_file
);
2676 /* Locate an executable given a Path argument. This routine is only used by
2677 gnatbl and should not be used otherwise. Use locate_exec_on_path
2681 __gnat_locate_exec (char *exec_name
, char *path_val
)
2684 if (!strstr (exec_name
, HOST_EXECUTABLE_SUFFIX
))
2686 char *full_exec_name
=
2688 (strlen (exec_name
) + strlen (HOST_EXECUTABLE_SUFFIX
) + 1);
2690 strcpy (full_exec_name
, exec_name
);
2691 strcat (full_exec_name
, HOST_EXECUTABLE_SUFFIX
);
2692 ptr
= __gnat_locate_executable_file (full_exec_name
, path_val
);
2695 return __gnat_locate_executable_file (exec_name
, path_val
);
2699 return __gnat_locate_executable_file (exec_name
, path_val
);
2702 /* Locate an executable using the Systems default PATH. */
2705 __gnat_locate_exec_on_path (char *exec_name
)
2709 #if defined (_WIN32) && !defined (RTX)
2710 TCHAR
*wpath_val
= _tgetenv (_T("PATH"));
2712 /* In Win32 systems we expand the PATH as for XP environment
2713 variables are not automatically expanded. We also prepend the
2714 ".;" to the path to match normal NT path search semantics */
2716 #define EXPAND_BUFFER_SIZE 32767
2718 wapath_val
= (TCHAR
*) alloca (EXPAND_BUFFER_SIZE
);
2720 wapath_val
[0] = '.';
2721 wapath_val
[1] = ';';
2723 DWORD res
= ExpandEnvironmentStrings
2724 (wpath_val
, &wapath_val
[2], EXPAND_BUFFER_SIZE
- 2);
2726 if (!res
) wapath_val
[0] = _T('\0');
2728 apath_val
= (char *) alloca (EXPAND_BUFFER_SIZE
);
2730 WS2SC (apath_val
, wapath_val
, EXPAND_BUFFER_SIZE
);
2731 return __gnat_locate_exec (exec_name
, apath_val
);
2734 char *path_val
= getenv ("PATH");
2736 if (path_val
== NULL
) return NULL
;
2737 apath_val
= (char *) alloca (strlen (path_val
) + 1);
2738 strcpy (apath_val
, path_val
);
2739 return __gnat_locate_exec (exec_name
, apath_val
);
2743 /* Dummy functions for Osint import for non-VMS systems.
2744 ??? To be removed. */
2747 __gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED
,
2748 int onlydirs ATTRIBUTE_UNUSED
)
2754 __gnat_to_canonical_file_list_next (void)
2756 static char empty
[] = "";
2761 __gnat_to_canonical_file_list_free (void)
2766 __gnat_to_canonical_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2772 __gnat_to_canonical_file_spec (char *filespec
)
2778 __gnat_to_canonical_path_spec (char *pathspec
)
2784 __gnat_to_host_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2790 __gnat_to_host_file_spec (char *filespec
)
2796 __gnat_adjust_os_resource_limits (void)
2800 #if defined (__mips_vxworks)
2804 CACHE_USER_FLUSH (0, ENTIRE_CACHE
);
2808 #if defined (_WIN32)
2809 int __gnat_argument_needs_quote
= 1;
2811 int __gnat_argument_needs_quote
= 0;
2814 /* This option is used to enable/disable object files handling from the
2815 binder file by the GNAT Project module. For example, this is disabled on
2816 Windows (prior to GCC 3.4) as it is already done by the mdll module.
2817 Stating with GCC 3.4 the shared libraries are not based on mdll
2818 anymore as it uses the GCC's -shared option */
2819 #if defined (_WIN32) \
2820 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
2821 int __gnat_prj_add_obj_files
= 0;
2823 int __gnat_prj_add_obj_files
= 1;
2826 /* char used as prefix/suffix for environment variables */
2827 #if defined (_WIN32)
2828 char __gnat_environment_char
= '%';
2830 char __gnat_environment_char
= '$';
2833 /* This functions copy the file attributes from a source file to a
2836 mode = 0 : In this mode copy only the file time stamps (last access and
2837 last modification time stamps).
2839 mode = 1 : In this mode, time stamps and read/write/execute attributes are
2842 Returns 0 if operation was successful and -1 in case of error. */
2845 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED
, char *to ATTRIBUTE_UNUSED
,
2846 int mode ATTRIBUTE_UNUSED
)
2848 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) || \
2849 defined (__nucleus__)
2852 #elif defined (_WIN32) && !defined (RTX)
2853 TCHAR wfrom
[GNAT_MAX_PATH_LEN
+ 2];
2854 TCHAR wto
[GNAT_MAX_PATH_LEN
+ 2];
2856 FILETIME fct
, flat
, flwt
;
2859 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
+ 2);
2860 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
+ 2);
2862 /* retrieve from times */
2865 (wfrom
, GENERIC_READ
, 0, NULL
, OPEN_EXISTING
, FILE_ATTRIBUTE_NORMAL
, NULL
);
2867 if (hfrom
== INVALID_HANDLE_VALUE
)
2870 res
= GetFileTime (hfrom
, &fct
, &flat
, &flwt
);
2872 CloseHandle (hfrom
);
2877 /* retrieve from times */
2880 (wto
, GENERIC_WRITE
, 0, NULL
, OPEN_EXISTING
, FILE_ATTRIBUTE_NORMAL
, NULL
);
2882 if (hto
== INVALID_HANDLE_VALUE
)
2885 res
= SetFileTime (hto
, NULL
, &flat
, &flwt
);
2892 /* Set file attributes in full mode. */
2896 DWORD attribs
= GetFileAttributes (wfrom
);
2898 if (attribs
== INVALID_FILE_ATTRIBUTES
)
2901 res
= SetFileAttributes (wto
, attribs
);
2909 GNAT_STRUCT_STAT fbuf
;
2910 struct utimbuf tbuf
;
2912 if (GNAT_STAT (from
, &fbuf
) == -1)
2917 tbuf
.actime
= fbuf
.st_atime
;
2918 tbuf
.modtime
= fbuf
.st_mtime
;
2920 if (utime (to
, &tbuf
) == -1)
2927 if (chmod (to
, fbuf
.st_mode
) == -1)
2938 __gnat_lseek (int fd
, long offset
, int whence
)
2940 return (int) lseek (fd
, offset
, whence
);
2943 /* This function returns the major version number of GCC being used. */
2945 get_gcc_version (void)
2950 return (int) (version_string
[0] - '0');
2955 * Set Close_On_Exec as indicated.
2956 * Note: this is used for both GNAT.OS_Lib and GNAT.Sockets.
2960 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED
,
2961 int close_on_exec_p ATTRIBUTE_UNUSED
)
2963 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
2964 int flags
= fcntl (fd
, F_GETFD
, 0);
2967 if (close_on_exec_p
)
2968 flags
|= FD_CLOEXEC
;
2970 flags
&= ~FD_CLOEXEC
;
2971 return fcntl (fd
, F_SETFD
, flags
);
2972 #elif defined(_WIN32)
2973 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
2974 if (h
== (HANDLE
) -1)
2976 if (close_on_exec_p
)
2977 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
, 0);
2978 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
,
2979 HANDLE_FLAG_INHERIT
);
2981 /* TODO: Unimplemented. */
2986 /* Indicates if platforms supports automatic initialization through the
2987 constructor mechanism */
2989 __gnat_binder_supports_auto_init (void)
2994 /* Indicates that Stand-Alone Libraries are automatically initialized through
2995 the constructor mechanism */
2997 __gnat_sals_init_using_constructors (void)
2999 #if defined (__vxworks) || defined (__Lynx__)
3008 /* In RTX mode, the procedure to get the time (as file time) is different
3009 in RTSS mode and Win32 mode. In order to avoid duplicating an Ada file,
3010 we introduce an intermediate procedure to link against the corresponding
3011 one in each situation. */
3013 extern void GetTimeAsFileTime (LPFILETIME pTime
);
3015 void GetTimeAsFileTime (LPFILETIME pTime
)
3018 RtGetRtssTimeAsFileTime (pTime
); /* RTSS interface */
3020 GetSystemTimeAsFileTime (pTime
); /* w32 interface */
3025 /* Add symbol that is required to link. It would otherwise be taken from
3026 libgcc.a and it would try to use the gcc constructors that are not
3027 supported by Microsoft linker. */
3029 extern void __main (void);
3037 #if defined (__ANDROID__)
3039 #include <pthread.h>
3042 __gnat_lwp_self (void)
3044 return (void *) pthread_self ();
3047 #elif defined (linux)
3048 /* There is no function in the glibc to retrieve the LWP of the current
3049 thread. We need to do a system call in order to retrieve this
3051 #include <sys/syscall.h>
3053 __gnat_lwp_self (void)
3055 return (void *) syscall (__NR_gettid
);
3060 /* glibc versions earlier than 2.7 do not define the routines to handle
3061 dynamically allocated CPU sets. For these targets, we use the static
3066 /* Dynamic cpu sets */
3069 __gnat_cpu_alloc (size_t count
)
3071 return CPU_ALLOC (count
);
3075 __gnat_cpu_alloc_size (size_t count
)
3077 return CPU_ALLOC_SIZE (count
);
3081 __gnat_cpu_free (cpu_set_t
*set
)
3087 __gnat_cpu_zero (size_t count
, cpu_set_t
*set
)
3089 CPU_ZERO_S (count
, set
);
3093 __gnat_cpu_set (int cpu
, size_t count
, cpu_set_t
*set
)
3095 /* Ada handles CPU numbers starting from 1, while C identifies the first
3096 CPU by a 0, so we need to adjust. */
3097 CPU_SET_S (cpu
- 1, count
, set
);
3100 #else /* !CPU_ALLOC */
3102 /* Static cpu sets */
3105 __gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED
)
3107 return (cpu_set_t
*) xmalloc (sizeof (cpu_set_t
));
3111 __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED
)
3113 return sizeof (cpu_set_t
);
3117 __gnat_cpu_free (cpu_set_t
*set
)
3123 __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3129 __gnat_cpu_set (int cpu
, size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3131 /* Ada handles CPU numbers starting from 1, while C identifies the first
3132 CPU by a 0, so we need to adjust. */
3133 CPU_SET (cpu
- 1, set
);
3135 #endif /* !CPU_ALLOC */
3138 /* Return the load address of the executable, or 0 if not known. In the
3139 specific case of error, (void *)-1 can be returned. Beware: this unit may
3140 be in a shared library. As low-level units are needed, we allow #include
3143 #if defined (__APPLE__)
3144 #include <mach-o/dyld.h>
3145 #elif 0 && defined (__linux__)
3150 __gnat_get_executable_load_address (void)
3152 #if defined (__APPLE__)
3153 return _dyld_get_image_header (0);
3155 #elif 0 && defined (__linux__)
3156 /* Currently disabled as it needs at least -ldl. */
3157 struct link_map
*map
= _r_debug
.r_map
;
3159 return (const void *)map
->l_addr
;