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 /* ??? the code below crash on MingW64 for obscure reasons, a ticket
463 has been opened here:
465 https://sourceforge.net/p/mingw-w64/bugs/414/
467 As a workaround an equivalent set of code has been put in place below.
469 _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
472 _tcscpy (wfull_path
, wdir
);
473 _tcscat (wfull_path
, L
"\\");
474 _tcscat (wfull_path
, wfile
);
476 fd
= _topen (wfull_path
, O_CREAT
| O_EXCL
, 0600);
480 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
481 fd
= open (full_path
, O_CREAT
| O_EXCL
, 0600);
493 /* Version using link(), more secure over NFS. */
494 /* See TN 6913-016 for discussion ??? */
497 __gnat_try_lock (char *dir
, char *file
)
501 GNAT_STRUCT_STAT stat_result
;
504 sprintf (full_path
, "%s%c%s", dir
, DIR_SEPARATOR
, file
);
505 sprintf (temp_file
, "%s%cTMP-%ld-%ld",
506 dir
, DIR_SEPARATOR
, (long)getpid(), (long)getppid ());
508 /* Create the temporary file and write the process number. */
509 fd
= open (temp_file
, O_CREAT
| O_WRONLY
, 0600);
515 /* Link it with the new file. */
516 link (temp_file
, full_path
);
518 /* Count the references on the old one. If we have a count of two, then
519 the link did succeed. Remove the temporary file before returning. */
520 __gnat_stat (temp_file
, &stat_result
);
522 return stat_result
.st_nlink
== 2;
526 /* Return the maximum file name length. */
529 __gnat_get_maximum_file_name_length (void)
534 /* Return nonzero if file names are case sensitive. */
536 static int file_names_case_sensitive_cache
= -1;
539 __gnat_get_file_names_case_sensitive (void)
541 if (file_names_case_sensitive_cache
== -1)
543 const char *sensitive
= getenv ("GNAT_FILE_NAME_CASE_SENSITIVE");
545 if (sensitive
!= NULL
546 && (sensitive
[0] == '0' || sensitive
[0] == '1')
547 && sensitive
[1] == '\0')
548 file_names_case_sensitive_cache
= sensitive
[0] - '0';
550 #if defined (WINNT) || defined (__APPLE__)
551 file_names_case_sensitive_cache
= 0;
553 file_names_case_sensitive_cache
= 1;
556 return file_names_case_sensitive_cache
;
559 /* Return nonzero if environment variables are case sensitive. */
562 __gnat_get_env_vars_case_sensitive (void)
572 __gnat_get_default_identifier_character_set (void)
577 /* Return the current working directory. */
580 __gnat_get_current_dir (char *dir
, int *length
)
582 #if defined (__MINGW32__)
583 TCHAR wdir
[GNAT_MAX_PATH_LEN
];
585 _tgetcwd (wdir
, *length
);
587 WS2SC (dir
, wdir
, GNAT_MAX_PATH_LEN
);
590 getcwd (dir
, *length
);
593 *length
= strlen (dir
);
595 if (dir
[*length
- 1] != DIR_SEPARATOR
)
597 dir
[*length
] = DIR_SEPARATOR
;
603 /* Return the suffix for object files. */
606 __gnat_get_object_suffix_ptr (int *len
, const char **value
)
608 *value
= HOST_OBJECT_SUFFIX
;
613 *len
= strlen (*value
);
618 /* Return the suffix for executable files. */
621 __gnat_get_executable_suffix_ptr (int *len
, const char **value
)
623 *value
= HOST_EXECUTABLE_SUFFIX
;
627 *len
= strlen (*value
);
632 /* Return the suffix for debuggable files. Usually this is the same as the
633 executable extension. */
636 __gnat_get_debuggable_suffix_ptr (int *len
, const char **value
)
638 *value
= HOST_EXECUTABLE_SUFFIX
;
643 *len
= strlen (*value
);
648 /* Returns the OS filename and corresponding encoding. */
651 __gnat_os_filename (char *filename ATTRIBUTE_UNUSED
,
652 char *w_filename ATTRIBUTE_UNUSED
,
653 char *os_name
, int *o_length
,
654 char *encoding ATTRIBUTE_UNUSED
, int *e_length
)
656 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
657 WS2SC (os_name
, (TCHAR
*)w_filename
, (DWORD
)*o_length
);
658 *o_length
= strlen (os_name
);
659 strcpy (encoding
, "encoding=utf8");
660 *e_length
= strlen (encoding
);
662 strcpy (os_name
, filename
);
663 *o_length
= strlen (filename
);
671 __gnat_unlink (char *path
)
673 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
675 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
677 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
678 return _tunlink (wpath
);
681 return unlink (path
);
688 __gnat_rename (char *from
, char *to
)
690 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
692 TCHAR wfrom
[GNAT_MAX_PATH_LEN
], wto
[GNAT_MAX_PATH_LEN
];
694 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
);
695 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
);
696 return _trename (wfrom
, wto
);
699 return rename (from
, to
);
703 /* Changing directory. */
706 __gnat_chdir (char *path
)
708 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
710 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
712 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
713 return _tchdir (wpath
);
720 /* Removing a directory. */
723 __gnat_rmdir (char *path
)
725 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
727 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
729 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
730 return _trmdir (wpath
);
732 #elif defined (VTHREADS)
733 /* rmdir not available */
740 #if defined (_WIN32) || defined (linux) || defined (sun) \
741 || defined (__FreeBSD__)
742 #define HAS_TARGET_WCHAR_T
745 #ifdef HAS_TARGET_WCHAR_T
750 __gnat_fputwc(int c
, FILE *stream
)
752 #ifdef HAS_TARGET_WCHAR_T
753 return fputwc ((wchar_t)c
, stream
);
755 return fputc (c
, stream
);
760 __gnat_fopen (char *path
, char *mode
, int encoding ATTRIBUTE_UNUSED
)
762 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
763 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
766 S2WS (wmode
, mode
, 10);
768 if (encoding
== Encoding_Unspecified
)
769 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
770 else if (encoding
== Encoding_UTF8
)
771 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
773 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
775 return _tfopen (wpath
, wmode
);
778 return GNAT_FOPEN (path
, mode
);
783 __gnat_freopen (char *path
,
786 int encoding ATTRIBUTE_UNUSED
)
788 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
789 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
792 S2WS (wmode
, mode
, 10);
794 if (encoding
== Encoding_Unspecified
)
795 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
796 else if (encoding
== Encoding_UTF8
)
797 S2WSU (wpath
, path
, GNAT_MAX_PATH_LEN
);
799 S2WS (wpath
, path
, GNAT_MAX_PATH_LEN
);
801 return _tfreopen (wpath
, wmode
, stream
);
803 return freopen (path
, mode
, stream
);
808 __gnat_open_read (char *path
, int fmode
)
811 int o_fmode
= O_BINARY
;
816 #if defined (__vxworks)
817 fd
= open (path
, O_RDONLY
| o_fmode
, 0444);
818 #elif defined (__MINGW32__)
820 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
822 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
823 fd
= _topen (wpath
, O_RDONLY
| o_fmode
, 0444);
826 fd
= GNAT_OPEN (path
, O_RDONLY
| o_fmode
);
829 return fd
< 0 ? -1 : fd
;
832 #if defined (__MINGW32__)
833 #define PERM (S_IREAD | S_IWRITE)
835 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
839 __gnat_open_rw (char *path
, int fmode
)
842 int o_fmode
= O_BINARY
;
847 #if defined (__MINGW32__)
849 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
851 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
852 fd
= _topen (wpath
, O_RDWR
| o_fmode
, PERM
);
855 fd
= GNAT_OPEN (path
, O_RDWR
| o_fmode
, PERM
);
858 return fd
< 0 ? -1 : fd
;
862 __gnat_open_create (char *path
, int fmode
)
865 int o_fmode
= O_BINARY
;
870 #if defined (__MINGW32__)
872 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
874 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
875 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
878 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| o_fmode
, PERM
);
881 return fd
< 0 ? -1 : fd
;
885 __gnat_create_output_file (char *path
)
888 #if defined (__MINGW32__)
890 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
892 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
893 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
896 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
, PERM
);
899 return fd
< 0 ? -1 : fd
;
903 __gnat_create_output_file_new (char *path
)
906 #if defined (__MINGW32__)
908 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
910 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
911 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
914 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_TRUNC
| O_TEXT
| O_EXCL
, PERM
);
917 return fd
< 0 ? -1 : fd
;
921 __gnat_open_append (char *path
, int fmode
)
924 int o_fmode
= O_BINARY
;
929 #if defined (__MINGW32__)
931 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
933 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
934 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
937 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_APPEND
| o_fmode
, PERM
);
940 return fd
< 0 ? -1 : fd
;
943 /* Open a new file. Return error (-1) if the file already exists. */
946 __gnat_open_new (char *path
, int fmode
)
949 int o_fmode
= O_BINARY
;
954 #if defined (__MINGW32__)
956 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
958 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
959 fd
= _topen (wpath
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
962 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
965 return fd
< 0 ? -1 : fd
;
968 /* Open a new temp file. Return error (-1) if the file already exists. */
971 __gnat_open_new_temp (char *path
, int fmode
)
974 int o_fmode
= O_BINARY
;
976 strcpy (path
, "GNAT-XXXXXX");
978 #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
979 || defined (linux) || defined(__GLIBC__)) && !defined (__vxworks)
980 return mkstemp (path
);
981 #elif defined (__Lynx__)
983 #elif defined (__nucleus__)
986 if (mktemp (path
) == NULL
)
993 fd
= GNAT_OPEN (path
, O_WRONLY
| O_CREAT
| O_EXCL
| o_fmode
, PERM
);
994 return fd
< 0 ? -1 : fd
;
998 __gnat_open (char *path
, int fmode
)
1002 #if defined (__MINGW32__)
1004 TCHAR wpath
[GNAT_MAX_PATH_LEN
];
1006 S2WSC (wpath
, path
, GNAT_MAX_PATH_LEN
);
1007 fd
= _topen (wpath
, fmode
, PERM
);
1010 fd
= GNAT_OPEN (path
, fmode
, PERM
);
1013 return fd
< 0 ? -1 : fd
;
1016 /****************************************************************
1017 ** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information
1018 ** as possible from it, storing the result in a cache for later reuse
1019 ****************************************************************/
1022 __gnat_stat_to_attr (int fd
, char* name
, struct file_attributes
* attr
)
1024 GNAT_STRUCT_STAT statbuf
;
1028 /* GNAT_FSTAT returns -1 and sets errno for failure */
1029 ret
= GNAT_FSTAT (fd
, &statbuf
);
1030 error
= ret
? errno
: 0;
1033 /* __gnat_stat returns errno value directly */
1034 error
= __gnat_stat (name
, &statbuf
);
1035 ret
= error
? -1 : 0;
1039 * A missing file is reported as an attr structure with error == 0 and
1043 if (error
== 0 || error
== ENOENT
)
1046 attr
->error
= error
;
1048 attr
->regular
= (!ret
&& S_ISREG (statbuf
.st_mode
));
1049 attr
->directory
= (!ret
&& S_ISDIR (statbuf
.st_mode
));
1052 attr
->file_length
= 0;
1054 /* st_size may be 32 bits, or 64 bits which is converted to long. We
1055 don't return a useful value for files larger than 2 gigabytes in
1057 attr
->file_length
= statbuf
.st_size
; /* all systems */
1059 attr
->exists
= !ret
;
1061 #if !defined (_WIN32) || defined (RTX)
1062 /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
1063 attr
->readable
= (!ret
&& (statbuf
.st_mode
& S_IRUSR
));
1064 attr
->writable
= (!ret
&& (statbuf
.st_mode
& S_IWUSR
));
1065 attr
->executable
= (!ret
&& (statbuf
.st_mode
& S_IXUSR
));
1069 attr
->timestamp
= (OS_Time
)-1;
1071 attr
->timestamp
= (OS_Time
)statbuf
.st_mtime
;
1075 /****************************************************************
1076 ** Return the number of bytes in the specified file
1077 ****************************************************************/
1080 __gnat_file_length_attr (int fd
, char* name
, struct file_attributes
* attr
)
1082 if (attr
->file_length
== -1) {
1083 __gnat_stat_to_attr (fd
, name
, attr
);
1086 return attr
->file_length
;
1090 __gnat_file_length (int fd
)
1092 struct file_attributes attr
;
1093 __gnat_reset_attributes (&attr
);
1094 return __gnat_file_length_attr (fd
, NULL
, &attr
);
1098 __gnat_file_length_long (int fd
)
1100 struct file_attributes attr
;
1101 __gnat_reset_attributes (&attr
);
1102 return (long)__gnat_file_length_attr (fd
, NULL
, &attr
);
1106 __gnat_named_file_length (char *name
)
1108 struct file_attributes attr
;
1109 __gnat_reset_attributes (&attr
);
1110 return __gnat_file_length_attr (-1, name
, &attr
);
1113 /* Create a temporary filename and put it in string pointed to by
1117 __gnat_tmp_name (char *tmp_filename
)
1120 /* Variable used to create a series of unique names */
1121 static int counter
= 0;
1123 /* RTX in RTSS mode does not support tempnam nor tmpnam so we emulate it */
1124 strcpy (tmp_filename
, "c:\\WINDOWS\\Temp\\gnat-");
1125 sprintf (&tmp_filename
[strlen (tmp_filename
)], "%d\0", counter
++);
1127 #elif defined (__MINGW32__)
1132 /* tempnam tries to create a temporary file in directory pointed to by
1133 TMP environment variable, in c:\temp if TMP is not set, and in
1134 directory specified by P_tmpdir in stdio.h if c:\temp does not
1135 exist. The filename will be created with the prefix "gnat-". */
1137 sprintf (prefix
, "gnat-%d-", (int)getpid());
1138 pname
= (char *) _tempnam ("c:\\temp", prefix
);
1140 /* if pname is NULL, the file was not created properly, the disk is full
1141 or there is no more free temporary files */
1144 *tmp_filename
= '\0';
1146 /* If pname start with a back slash and not path information it means that
1147 the filename is valid for the current working directory. */
1149 else if (pname
[0] == '\\')
1151 strcpy (tmp_filename
, ".\\");
1152 strcat (tmp_filename
, pname
+1);
1155 strcpy (tmp_filename
, pname
);
1160 #elif defined (linux) || defined (__FreeBSD__) || defined (__NetBSD__) \
1161 || defined (__OpenBSD__) || defined(__GLIBC__) || defined (__ANDROID__)
1162 #define MAX_SAFE_PATH 1000
1163 char *tmpdir
= getenv ("TMPDIR");
1165 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1166 a buffer overflow. */
1167 if (tmpdir
== NULL
|| strlen (tmpdir
) > MAX_SAFE_PATH
)
1169 strcpy (tmp_filename
, "/cache/gnat-XXXXXX");
1171 strcpy (tmp_filename
, "/tmp/gnat-XXXXXX");
1174 sprintf (tmp_filename
, "%s/gnat-XXXXXX", tmpdir
);
1176 close (mkstemp(tmp_filename
));
1177 #elif defined (__vxworks) && !(defined (__RTP__) || defined (VTHREADS))
1181 static ushort_t seed
= 0; /* used to generate unique name */
1183 /* generate unique name */
1184 strcpy (tmp_filename
, "tmp");
1186 /* fill up the name buffer from the last position */
1188 pos
= tmp_filename
+ strlen (tmp_filename
) + index
;
1192 for (t
= seed
; 0 <= --index
; t
>>= 3)
1193 *--pos
= '0' + (t
& 07);
1195 tmpnam (tmp_filename
);
1199 /* Open directory and returns a DIR pointer. */
1201 DIR* __gnat_opendir (char *name
)
1204 /* Not supported in RTX */
1208 #elif defined (__MINGW32__)
1209 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1211 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1212 return (DIR*)_topendir (wname
);
1215 return opendir (name
);
1219 /* Read the next entry in a directory. The returned string points somewhere
1223 __gnat_readdir (DIR *dirp
, char *buffer
, int *len
)
1226 /* Not supported in RTX */
1230 #elif defined (__MINGW32__)
1231 struct _tdirent
*dirent
= _treaddir ((_TDIR
*)dirp
);
1235 WS2SC (buffer
, dirent
->d_name
, GNAT_MAX_PATH_LEN
);
1236 *len
= strlen (buffer
);
1243 #elif defined (HAVE_READDIR_R)
1244 /* If possible, try to use the thread-safe version. */
1245 if (readdir_r (dirp
, buffer
) != NULL
)
1247 *len
= strlen (((struct dirent
*) buffer
)->d_name
);
1248 return ((struct dirent
*) buffer
)->d_name
;
1254 struct dirent
*dirent
= (struct dirent
*) readdir (dirp
);
1258 strcpy (buffer
, dirent
->d_name
);
1259 *len
= strlen (buffer
);
1268 /* Close a directory entry. */
1270 int __gnat_closedir (DIR *dirp
)
1273 /* Not supported in RTX */
1277 #elif defined (__MINGW32__)
1278 return _tclosedir ((_TDIR
*)dirp
);
1281 return closedir (dirp
);
1285 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1288 __gnat_readdir_is_thread_safe (void)
1290 #ifdef HAVE_READDIR_R
1297 #if defined (_WIN32) && !defined (RTX)
1298 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1299 static const unsigned long long w32_epoch_offset
= 11644473600ULL;
1301 /* Returns the file modification timestamp using Win32 routines which are
1302 immune against daylight saving time change. It is in fact not possible to
1303 use fstat for this purpose as the DST modify the st_mtime field of the
1307 win32_filetime (HANDLE h
)
1312 unsigned long long ull_time
;
1315 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1316 since <Jan 1st 1601>. This function must return the number of seconds
1317 since <Jan 1st 1970>. */
1319 if (GetFileTime (h
, NULL
, NULL
, &t_write
.ft_time
))
1320 return (time_t) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1324 /* As above but starting from a FILETIME. */
1326 f2t (const FILETIME
*ft
, __time64_t
*t
)
1331 unsigned long long ull_time
;
1334 t_write
.ft_time
= *ft
;
1335 *t
= (__time64_t
) (t_write
.ull_time
/ 10000000ULL - w32_epoch_offset
);
1339 /* Return a GNAT time stamp given a file name. */
1342 __gnat_file_time_name_attr (char* name
, struct file_attributes
* attr
)
1344 if (attr
->timestamp
== (OS_Time
)-2) {
1345 #if defined (_WIN32) && !defined (RTX)
1347 WIN32_FILE_ATTRIBUTE_DATA fad
;
1348 __time64_t ret
= -1;
1349 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1350 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1352 if ((res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
)))
1353 f2t (&fad
.ftLastWriteTime
, &ret
);
1354 attr
->timestamp
= (OS_Time
) ret
;
1356 __gnat_stat_to_attr (-1, name
, attr
);
1359 return attr
->timestamp
;
1363 __gnat_file_time_name (char *name
)
1365 struct file_attributes attr
;
1366 __gnat_reset_attributes (&attr
);
1367 return __gnat_file_time_name_attr (name
, &attr
);
1370 /* Return a GNAT time stamp given a file descriptor. */
1373 __gnat_file_time_fd_attr (int fd
, struct file_attributes
* attr
)
1375 if (attr
->timestamp
== (OS_Time
)-2) {
1376 #if defined (_WIN32) && !defined (RTX)
1377 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
1378 time_t ret
= win32_filetime (h
);
1379 attr
->timestamp
= (OS_Time
) ret
;
1382 __gnat_stat_to_attr (fd
, NULL
, attr
);
1386 return attr
->timestamp
;
1390 __gnat_file_time_fd (int fd
)
1392 struct file_attributes attr
;
1393 __gnat_reset_attributes (&attr
);
1394 return __gnat_file_time_fd_attr (fd
, &attr
);
1397 /* Set the file time stamp. */
1400 __gnat_set_file_time_name (char *name
, time_t time_stamp
)
1402 #if defined (__vxworks)
1404 /* Code to implement __gnat_set_file_time_name for these systems. */
1406 #elif defined (_WIN32) && !defined (RTX)
1410 unsigned long long ull_time
;
1412 TCHAR wname
[GNAT_MAX_PATH_LEN
];
1414 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
);
1416 HANDLE h
= CreateFile
1417 (wname
, GENERIC_WRITE
, FILE_SHARE_WRITE
, NULL
,
1418 OPEN_EXISTING
, FILE_FLAG_BACKUP_SEMANTICS
,
1420 if (h
== INVALID_HANDLE_VALUE
)
1422 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1423 t_write
.ull_time
= ((unsigned long long)time_stamp
+ w32_epoch_offset
);
1424 /* Convert to 100 nanosecond units */
1425 t_write
.ull_time
*= 10000000ULL;
1427 SetFileTime(h
, NULL
, NULL
, &t_write
.ft_time
);
1432 struct utimbuf utimbuf
;
1435 /* Set modification time to requested time. */
1436 utimbuf
.modtime
= time_stamp
;
1438 /* Set access time to now in local time. */
1439 t
= time ((time_t) 0);
1440 utimbuf
.actime
= mktime (localtime (&t
));
1442 utime (name
, &utimbuf
);
1446 /* Get the list of installed standard libraries from the
1447 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1451 __gnat_get_libraries_from_registry (void)
1453 char *result
= (char *) xmalloc (1);
1457 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS) \
1461 DWORD name_size
, value_size
;
1468 /* First open the key. */
1469 res
= RegOpenKeyExA (HKEY_LOCAL_MACHINE
, "SOFTWARE", 0, KEY_READ
, ®_key
);
1471 if (res
== ERROR_SUCCESS
)
1472 res
= RegOpenKeyExA (reg_key
, "Ada Core Technologies", 0,
1473 KEY_READ
, ®_key
);
1475 if (res
== ERROR_SUCCESS
)
1476 res
= RegOpenKeyExA (reg_key
, "GNAT", 0, KEY_READ
, ®_key
);
1478 if (res
== ERROR_SUCCESS
)
1479 res
= RegOpenKeyExA (reg_key
, "Standard Libraries", 0, KEY_READ
, ®_key
);
1481 /* If the key exists, read out all the values in it and concatenate them
1483 for (index
= 0; res
== ERROR_SUCCESS
; index
++)
1485 value_size
= name_size
= 256;
1486 res
= RegEnumValueA (reg_key
, index
, name
, &name_size
, 0,
1487 &type
, (LPBYTE
)value
, &value_size
);
1489 if (res
== ERROR_SUCCESS
&& type
== REG_SZ
)
1491 char *old_result
= result
;
1493 result
= (char *) xmalloc (strlen (old_result
) + value_size
+ 2);
1494 strcpy (result
, old_result
);
1495 strcat (result
, value
);
1496 strcat (result
, ";");
1501 /* Remove the trailing ";". */
1503 result
[strlen (result
) - 1] = 0;
1509 /* Query information for the given file NAME and return it in STATBUF.
1510 * Returns 0 for success, or errno value for failure.
1513 __gnat_stat (char *name
, GNAT_STRUCT_STAT
*statbuf
)
1516 WIN32_FILE_ATTRIBUTE_DATA fad
;
1517 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1522 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1523 name_len
= _tcslen (wname
);
1525 if (name_len
> GNAT_MAX_PATH_LEN
)
1528 ZeroMemory (statbuf
, sizeof(GNAT_STRUCT_STAT
));
1530 res
= GetFileAttributesEx (wname
, GetFileExInfoStandard
, &fad
);
1533 error
= GetLastError();
1535 /* Check file existence using GetFileAttributes() which does not fail on
1536 special Windows files like con:, aux:, nul: etc... */
1538 if (GetFileAttributes(wname
) != INVALID_FILE_ATTRIBUTES
) {
1539 /* Just pretend that it is a regular and readable file */
1540 statbuf
->st_mode
= S_IFREG
| S_IREAD
| S_IWRITE
;
1545 case ERROR_ACCESS_DENIED
:
1546 case ERROR_SHARING_VIOLATION
:
1547 case ERROR_LOCK_VIOLATION
:
1548 case ERROR_SHARING_BUFFER_EXCEEDED
:
1550 case ERROR_BUFFER_OVERFLOW
:
1551 return ENAMETOOLONG
;
1552 case ERROR_NOT_ENOUGH_MEMORY
:
1559 f2t (&fad
.ftCreationTime
, &statbuf
->st_ctime
);
1560 f2t (&fad
.ftLastWriteTime
, &statbuf
->st_mtime
);
1561 f2t (&fad
.ftLastAccessTime
, &statbuf
->st_atime
);
1564 (__int64
)fad
.nFileSizeLow
| (__int64
)fad
.nFileSizeHigh
<< 32;
1566 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1567 statbuf
->st_mode
= S_IREAD
;
1569 if (fad
.dwFileAttributes
& FILE_ATTRIBUTE_DIRECTORY
)
1570 statbuf
->st_mode
|= S_IFDIR
;
1572 statbuf
->st_mode
|= S_IFREG
;
1574 if (!(fad
.dwFileAttributes
& FILE_ATTRIBUTE_READONLY
))
1575 statbuf
->st_mode
|= S_IWRITE
;
1580 return GNAT_STAT (name
, statbuf
) == 0 ? 0 : errno
;
1584 /*************************************************************************
1585 ** Check whether a file exists
1586 *************************************************************************/
1589 __gnat_file_exists_attr (char* name
, struct file_attributes
* attr
)
1591 if (attr
->exists
== ATTR_UNSET
)
1592 __gnat_stat_to_attr (-1, name
, attr
);
1594 return attr
->exists
;
1598 __gnat_file_exists (char *name
)
1600 struct file_attributes attr
;
1601 __gnat_reset_attributes (&attr
);
1602 return __gnat_file_exists_attr (name
, &attr
);
1605 /**********************************************************************
1606 ** Whether name is an absolute path
1607 **********************************************************************/
1610 __gnat_is_absolute_path (char *name
, int length
)
1613 /* On VxWorks systems, an absolute path can be represented (depending on
1614 the host platform) as either /dir/file, or device:/dir/file, or
1615 device:drive_letter:/dir/file. */
1622 for (index
= 0; index
< length
; index
++)
1624 if (name
[index
] == ':' &&
1625 ((name
[index
+ 1] == '/') ||
1626 (isalpha (name
[index
+ 1]) && index
+ 2 <= length
&&
1627 name
[index
+ 2] == '/')))
1630 else if (name
[index
] == '/')
1635 return (length
!= 0) &&
1636 (*name
== '/' || *name
== DIR_SEPARATOR
1638 || (length
> 1 && ISALPHA (name
[0]) && name
[1] == ':')
1645 __gnat_is_regular_file_attr (char* name
, struct file_attributes
* attr
)
1647 if (attr
->regular
== ATTR_UNSET
)
1648 __gnat_stat_to_attr (-1, name
, attr
);
1650 return attr
->regular
;
1654 __gnat_is_regular_file (char *name
)
1656 struct file_attributes attr
;
1658 __gnat_reset_attributes (&attr
);
1659 return __gnat_is_regular_file_attr (name
, &attr
);
1663 __gnat_is_regular_file_fd (int fd
)
1666 GNAT_STRUCT_STAT statbuf
;
1668 ret
= GNAT_FSTAT (fd
, &statbuf
);
1669 return (!ret
&& S_ISREG (statbuf
.st_mode
));
1673 __gnat_is_directory_attr (char* name
, struct file_attributes
* attr
)
1675 if (attr
->directory
== ATTR_UNSET
)
1676 __gnat_stat_to_attr (-1, name
, attr
);
1678 return attr
->directory
;
1682 __gnat_is_directory (char *name
)
1684 struct file_attributes attr
;
1686 __gnat_reset_attributes (&attr
);
1687 return __gnat_is_directory_attr (name
, &attr
);
1690 #if defined (_WIN32) && !defined (RTX)
1692 /* Returns the same constant as GetDriveType but takes a pathname as
1696 GetDriveTypeFromPath (TCHAR
*wfullpath
)
1698 TCHAR wdrv
[MAX_PATH
];
1699 TCHAR wpath
[MAX_PATH
];
1700 TCHAR wfilename
[MAX_PATH
];
1701 TCHAR wext
[MAX_PATH
];
1703 _tsplitpath (wfullpath
, wdrv
, wpath
, wfilename
, wext
);
1705 if (_tcslen (wdrv
) != 0)
1707 /* we have a drive specified. */
1708 _tcscat (wdrv
, _T("\\"));
1709 return GetDriveType (wdrv
);
1713 /* No drive specified. */
1715 /* Is this a relative path, if so get current drive type. */
1716 if (wpath
[0] != _T('\\') ||
1717 (_tcslen (wpath
) > 2 && wpath
[0] == _T('\\')
1718 && wpath
[1] != _T('\\')))
1719 return GetDriveType (NULL
);
1721 UINT result
= GetDriveType (wpath
);
1723 /* Cannot guess the drive type, is this \\.\ ? */
1725 if (result
== DRIVE_NO_ROOT_DIR
&&
1726 _tcslen (wpath
) >= 4 && wpath
[0] == _T('\\') && wpath
[1] == _T('\\')
1727 && wpath
[2] == _T('.') && wpath
[3] == _T('\\'))
1729 if (_tcslen (wpath
) == 4)
1730 _tcscat (wpath
, wfilename
);
1732 LPTSTR p
= &wpath
[4];
1733 LPTSTR b
= _tcschr (p
, _T('\\'));
1737 /* logical drive \\.\c\dir\file */
1743 _tcscat (p
, _T(":\\"));
1745 return GetDriveType (p
);
1752 /* This MingW section contains code to work with ACL. */
1754 __gnat_check_OWNER_ACL (TCHAR
*wname
,
1755 DWORD CheckAccessDesired
,
1756 GENERIC_MAPPING CheckGenericMapping
)
1758 DWORD dwAccessDesired
, dwAccessAllowed
;
1759 PRIVILEGE_SET PrivilegeSet
;
1760 DWORD dwPrivSetSize
= sizeof (PRIVILEGE_SET
);
1761 BOOL fAccessGranted
= FALSE
;
1762 HANDLE hToken
= NULL
;
1764 PSECURITY_DESCRIPTOR pSD
= NULL
;
1767 (wname
, OWNER_SECURITY_INFORMATION
|
1768 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1771 if ((pSD
= (SECURITY_DESCRIPTOR
*) HeapAlloc
1772 (GetProcessHeap (), HEAP_ZERO_MEMORY
, nLength
)) == NULL
)
1775 /* Obtain the security descriptor. */
1777 if (!GetFileSecurity
1778 (wname
, OWNER_SECURITY_INFORMATION
|
1779 GROUP_SECURITY_INFORMATION
| DACL_SECURITY_INFORMATION
,
1780 pSD
, nLength
, &nLength
))
1783 if (!ImpersonateSelf (SecurityImpersonation
))
1786 if (!OpenThreadToken
1787 (GetCurrentThread(), TOKEN_DUPLICATE
| TOKEN_QUERY
, FALSE
, &hToken
))
1790 /* Undoes the effect of ImpersonateSelf. */
1794 /* We want to test for write permissions. */
1796 dwAccessDesired
= CheckAccessDesired
;
1798 MapGenericMask (&dwAccessDesired
, &CheckGenericMapping
);
1801 (pSD
, /* security descriptor to check */
1802 hToken
, /* impersonation token */
1803 dwAccessDesired
, /* requested access rights */
1804 &CheckGenericMapping
, /* pointer to GENERIC_MAPPING */
1805 &PrivilegeSet
, /* receives privileges used in check */
1806 &dwPrivSetSize
, /* size of PrivilegeSet buffer */
1807 &dwAccessAllowed
, /* receives mask of allowed access rights */
1811 CloseHandle (hToken
);
1812 HeapFree (GetProcessHeap (), 0, pSD
);
1813 return fAccessGranted
;
1817 CloseHandle (hToken
);
1818 HeapFree (GetProcessHeap (), 0, pSD
);
1823 __gnat_set_OWNER_ACL (TCHAR
*wname
,
1824 ACCESS_MODE AccessMode
,
1825 DWORD AccessPermissions
)
1827 PACL pOldDACL
= NULL
;
1828 PACL pNewDACL
= NULL
;
1829 PSECURITY_DESCRIPTOR pSD
= NULL
;
1831 TCHAR username
[100];
1834 /* Get current user, he will act as the owner */
1836 if (!GetUserName (username
, &unsize
))
1839 if (GetNamedSecurityInfo
1842 DACL_SECURITY_INFORMATION
,
1843 NULL
, NULL
, &pOldDACL
, NULL
, &pSD
) != ERROR_SUCCESS
)
1846 BuildExplicitAccessWithName
1847 (&ea
, username
, AccessPermissions
, (ACCESS_MODE
) AccessMode
, NO_INHERITANCE
);
1849 if (AccessMode
== SET_ACCESS
)
1851 /* SET_ACCESS, we want to set an explicte set of permissions, do not
1852 merge with current DACL. */
1853 if (SetEntriesInAcl (1, &ea
, NULL
, &pNewDACL
) != ERROR_SUCCESS
)
1857 if (SetEntriesInAcl (1, &ea
, pOldDACL
, &pNewDACL
) != ERROR_SUCCESS
)
1860 if (SetNamedSecurityInfo
1861 (wname
, SE_FILE_OBJECT
,
1862 DACL_SECURITY_INFORMATION
, NULL
, NULL
, pNewDACL
, NULL
) != ERROR_SUCCESS
)
1866 LocalFree (pNewDACL
);
1869 /* Check if it is possible to use ACL for wname, the file must not be on a
1873 __gnat_can_use_acl (TCHAR
*wname
)
1875 return __gnat_use_acl
&& GetDriveTypeFromPath (wname
) != DRIVE_REMOTE
;
1878 #endif /* defined (_WIN32) && !defined (RTX) */
1881 __gnat_is_readable_file_attr (char* name
, struct file_attributes
* attr
)
1883 if (attr
->readable
== ATTR_UNSET
)
1885 #if defined (_WIN32) && !defined (RTX)
1886 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1887 GENERIC_MAPPING GenericMapping
;
1889 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1891 if (__gnat_can_use_acl (wname
))
1893 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1894 GenericMapping
.GenericRead
= GENERIC_READ
;
1896 __gnat_check_OWNER_ACL (wname
, FILE_READ_DATA
, GenericMapping
);
1899 attr
->readable
= GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
;
1901 __gnat_stat_to_attr (-1, name
, attr
);
1905 return attr
->readable
;
1909 __gnat_is_readable_file (char *name
)
1911 struct file_attributes attr
;
1913 __gnat_reset_attributes (&attr
);
1914 return __gnat_is_readable_file_attr (name
, &attr
);
1918 __gnat_is_writable_file_attr (char* name
, struct file_attributes
* attr
)
1920 if (attr
->writable
== ATTR_UNSET
)
1922 #if defined (_WIN32) && !defined (RTX)
1923 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1924 GENERIC_MAPPING GenericMapping
;
1926 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1928 if (__gnat_can_use_acl (wname
))
1930 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1931 GenericMapping
.GenericWrite
= GENERIC_WRITE
;
1933 attr
->writable
= __gnat_check_OWNER_ACL
1934 (wname
, FILE_WRITE_DATA
| FILE_APPEND_DATA
, GenericMapping
)
1935 && !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
1939 !(GetFileAttributes (wname
) & FILE_ATTRIBUTE_READONLY
);
1942 __gnat_stat_to_attr (-1, name
, attr
);
1946 return attr
->writable
;
1950 __gnat_is_writable_file (char *name
)
1952 struct file_attributes attr
;
1954 __gnat_reset_attributes (&attr
);
1955 return __gnat_is_writable_file_attr (name
, &attr
);
1959 __gnat_is_executable_file_attr (char* name
, struct file_attributes
* attr
)
1961 if (attr
->executable
== ATTR_UNSET
)
1963 #if defined (_WIN32) && !defined (RTX)
1964 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
1965 GENERIC_MAPPING GenericMapping
;
1967 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
1969 if (__gnat_can_use_acl (wname
))
1971 ZeroMemory (&GenericMapping
, sizeof (GENERIC_MAPPING
));
1972 GenericMapping
.GenericExecute
= GENERIC_EXECUTE
;
1975 __gnat_check_OWNER_ACL (wname
, FILE_EXECUTE
, GenericMapping
);
1979 TCHAR
*l
, *last
= _tcsstr(wname
, _T(".exe"));
1981 /* look for last .exe */
1983 while ((l
= _tcsstr(last
+1, _T(".exe"))))
1987 GetFileAttributes (wname
) != INVALID_FILE_ATTRIBUTES
1988 && (last
- wname
) == (int) (_tcslen (wname
) - 4);
1991 __gnat_stat_to_attr (-1, name
, attr
);
1995 return attr
->regular
&& attr
->executable
;
1999 __gnat_is_executable_file (char *name
)
2001 struct file_attributes attr
;
2003 __gnat_reset_attributes (&attr
);
2004 return __gnat_is_executable_file_attr (name
, &attr
);
2008 __gnat_set_writable (char *name
)
2010 #if defined (_WIN32) && !defined (RTX)
2011 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2013 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2015 if (__gnat_can_use_acl (wname
))
2016 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_WRITE
);
2019 (wname
, GetFileAttributes (wname
) & ~FILE_ATTRIBUTE_READONLY
);
2020 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2021 ! defined(__nucleus__)
2022 GNAT_STRUCT_STAT statbuf
;
2024 if (GNAT_STAT (name
, &statbuf
) == 0)
2026 statbuf
.st_mode
= statbuf
.st_mode
| S_IWUSR
;
2027 chmod (name
, statbuf
.st_mode
);
2032 /* must match definition in s-os_lib.ads */
2038 __gnat_set_executable (char *name
, int mode ATTRIBUTE_UNUSED
)
2040 #if defined (_WIN32) && !defined (RTX)
2041 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2043 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2045 if (__gnat_can_use_acl (wname
))
2046 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_EXECUTE
);
2048 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2049 ! defined(__nucleus__)
2050 GNAT_STRUCT_STAT statbuf
;
2052 if (GNAT_STAT (name
, &statbuf
) == 0)
2055 statbuf
.st_mode
= statbuf
.st_mode
| S_IXUSR
;
2057 statbuf
.st_mode
= statbuf
.st_mode
| S_IXGRP
;
2058 if (mode
& S_OTHERS
)
2059 statbuf
.st_mode
= statbuf
.st_mode
| S_IXOTH
;
2060 chmod (name
, statbuf
.st_mode
);
2066 __gnat_set_non_writable (char *name
)
2068 #if defined (_WIN32) && !defined (RTX)
2069 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2071 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2073 if (__gnat_can_use_acl (wname
))
2074 __gnat_set_OWNER_ACL
2075 (wname
, DENY_ACCESS
,
2076 FILE_WRITE_DATA
| FILE_APPEND_DATA
|
2077 FILE_WRITE_EA
| FILE_WRITE_ATTRIBUTES
);
2080 (wname
, GetFileAttributes (wname
) | FILE_ATTRIBUTE_READONLY
);
2081 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2082 ! defined(__nucleus__)
2083 GNAT_STRUCT_STAT statbuf
;
2085 if (GNAT_STAT (name
, &statbuf
) == 0)
2087 statbuf
.st_mode
= statbuf
.st_mode
& 07577;
2088 chmod (name
, statbuf
.st_mode
);
2094 __gnat_set_readable (char *name
)
2096 #if defined (_WIN32) && !defined (RTX)
2097 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2099 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2101 if (__gnat_can_use_acl (wname
))
2102 __gnat_set_OWNER_ACL (wname
, GRANT_ACCESS
, FILE_GENERIC_READ
);
2104 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2105 ! defined(__nucleus__)
2106 GNAT_STRUCT_STAT statbuf
;
2108 if (GNAT_STAT (name
, &statbuf
) == 0)
2110 chmod (name
, statbuf
.st_mode
| S_IREAD
);
2116 __gnat_set_non_readable (char *name
)
2118 #if defined (_WIN32) && !defined (RTX)
2119 TCHAR wname
[GNAT_MAX_PATH_LEN
+ 2];
2121 S2WSC (wname
, name
, GNAT_MAX_PATH_LEN
+ 2);
2123 if (__gnat_can_use_acl (wname
))
2124 __gnat_set_OWNER_ACL (wname
, DENY_ACCESS
, FILE_GENERIC_READ
);
2126 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2127 ! defined(__nucleus__)
2128 GNAT_STRUCT_STAT statbuf
;
2130 if (GNAT_STAT (name
, &statbuf
) == 0)
2132 chmod (name
, statbuf
.st_mode
& (~S_IREAD
));
2138 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED
,
2139 struct file_attributes
* attr
)
2141 if (attr
->symbolic_link
== ATTR_UNSET
)
2143 #if defined (__vxworks) || defined (__nucleus__)
2144 attr
->symbolic_link
= 0;
2146 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2148 GNAT_STRUCT_STAT statbuf
;
2149 ret
= GNAT_LSTAT (name
, &statbuf
);
2150 attr
->symbolic_link
= (!ret
&& S_ISLNK (statbuf
.st_mode
));
2152 attr
->symbolic_link
= 0;
2155 return attr
->symbolic_link
;
2159 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED
)
2161 struct file_attributes attr
;
2163 __gnat_reset_attributes (&attr
);
2164 return __gnat_is_symbolic_link_attr (name
, &attr
);
2167 #if defined (sun) && defined (__SVR4)
2168 /* Using fork on Solaris will duplicate all the threads. fork1, which
2169 duplicates only the active thread, must be used instead, or spawning
2170 subprocess from a program with tasking will lead into numerous problems. */
2175 __gnat_portable_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2177 int status ATTRIBUTE_UNUSED
= 0;
2178 int finished ATTRIBUTE_UNUSED
;
2179 int pid ATTRIBUTE_UNUSED
;
2181 #if defined (__vxworks) || defined(__nucleus__) || defined(RTX) \
2182 || defined(__PikeOS__)
2185 #elif defined (_WIN32)
2186 /* args[0] must be quotes as it could contain a full pathname with spaces */
2187 char *args_0
= args
[0];
2188 args
[0] = (char *)xmalloc (strlen (args_0
) + 3);
2189 strcpy (args
[0], "\"");
2190 strcat (args
[0], args_0
);
2191 strcat (args
[0], "\"");
2193 status
= spawnvp (P_WAIT
, args_0
, (char ** const)args
);
2195 /* restore previous value */
2197 args
[0] = (char *)args_0
;
2213 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2218 finished
= waitpid (pid
, &status
, 0);
2220 if (finished
!= pid
|| WIFEXITED (status
) == 0)
2223 return WEXITSTATUS (status
);
2229 /* Create a copy of the given file descriptor.
2230 Return -1 if an error occurred. */
2233 __gnat_dup (int oldfd
)
2235 #if defined (__vxworks) && !defined (__RTP__)
2236 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2244 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2245 Return -1 if an error occurred. */
2248 __gnat_dup2 (int oldfd ATTRIBUTE_UNUSED
, int newfd ATTRIBUTE_UNUSED
)
2250 #if defined (__vxworks) && !defined (__RTP__)
2251 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2254 #elif defined (__PikeOS__)
2255 /* Not supported. */
2257 #elif defined (_WIN32)
2258 /* Special case when oldfd and newfd are identical and are the standard
2259 input, output or error as this makes Windows XP hangs. Note that we
2260 do that only for standard file descriptors that are known to be valid. */
2261 if (oldfd
== newfd
&& newfd
>= 0 && newfd
<= 2)
2264 return dup2 (oldfd
, newfd
);
2266 return dup2 (oldfd
, newfd
);
2271 __gnat_number_of_cpus (void)
2275 #if defined (linux) || defined (sun) || defined (AIX) || defined (__APPLE__)
2276 cores
= (int) sysconf (_SC_NPROCESSORS_ONLN
);
2278 #elif defined (__hpux__)
2279 struct pst_dynamic psd
;
2280 if (pstat_getdynamic (&psd
, sizeof (psd
), 1, 0) != -1)
2281 cores
= (int) psd
.psd_proc_cnt
;
2283 #elif defined (_WIN32)
2284 SYSTEM_INFO sysinfo
;
2285 GetSystemInfo (&sysinfo
);
2286 cores
= (int) sysinfo
.dwNumberOfProcessors
;
2288 #elif defined (_WRS_CONFIG_SMP)
2289 unsigned int vxCpuConfiguredGet (void);
2291 cores
= vxCpuConfiguredGet ();
2298 /* WIN32 code to implement a wait call that wait for any child process. */
2300 #if defined (_WIN32) && !defined (RTX)
2302 /* Synchronization code, to be thread safe. */
2306 /* For the Cert run times on native Windows we use dummy functions
2307 for locking and unlocking tasks since we do not support multiple
2308 threads on this configuration (Cert run time on native Windows). */
2310 static void dummy (void)
2314 void (*Lock_Task
) () = &dummy
;
2315 void (*Unlock_Task
) () = &dummy
;
2319 #define Lock_Task system__soft_links__lock_task
2320 extern void (*Lock_Task
) (void);
2322 #define Unlock_Task system__soft_links__unlock_task
2323 extern void (*Unlock_Task
) (void);
2327 static HANDLE
*HANDLES_LIST
= NULL
;
2328 static int *PID_LIST
= NULL
, plist_length
= 0, plist_max_length
= 0;
2331 add_handle (HANDLE h
, int pid
)
2334 /* -------------------- critical section -------------------- */
2337 if (plist_length
== plist_max_length
)
2339 plist_max_length
+= 1000;
2341 (HANDLE
*) xrealloc (HANDLES_LIST
, sizeof (HANDLE
) * plist_max_length
);
2343 (int *) xrealloc (PID_LIST
, sizeof (int) * plist_max_length
);
2346 HANDLES_LIST
[plist_length
] = h
;
2347 PID_LIST
[plist_length
] = pid
;
2351 /* -------------------- critical section -------------------- */
2355 __gnat_win32_remove_handle (HANDLE h
, int pid
)
2359 /* -------------------- critical section -------------------- */
2362 for (j
= 0; j
< plist_length
; j
++)
2364 if ((HANDLES_LIST
[j
] == h
) || (PID_LIST
[j
] == pid
))
2368 HANDLES_LIST
[j
] = HANDLES_LIST
[plist_length
];
2369 PID_LIST
[j
] = PID_LIST
[plist_length
];
2375 /* -------------------- critical section -------------------- */
2379 win32_no_block_spawn (char *command
, char *args
[], HANDLE
*h
, int *pid
)
2383 PROCESS_INFORMATION PI
;
2384 SECURITY_ATTRIBUTES SA
;
2389 /* compute the total command line length */
2393 csize
+= strlen (args
[k
]) + 1;
2397 full_command
= (char *) xmalloc (csize
);
2400 SI
.cb
= sizeof (STARTUPINFO
);
2401 SI
.lpReserved
= NULL
;
2402 SI
.lpReserved2
= NULL
;
2403 SI
.lpDesktop
= NULL
;
2407 SI
.wShowWindow
= SW_HIDE
;
2409 /* Security attributes. */
2410 SA
.nLength
= sizeof (SECURITY_ATTRIBUTES
);
2411 SA
.bInheritHandle
= TRUE
;
2412 SA
.lpSecurityDescriptor
= NULL
;
2414 /* Prepare the command string. */
2415 strcpy (full_command
, command
);
2416 strcat (full_command
, " ");
2421 strcat (full_command
, args
[k
]);
2422 strcat (full_command
, " ");
2427 int wsize
= csize
* 2;
2428 TCHAR
*wcommand
= (TCHAR
*) xmalloc (wsize
);
2430 S2WSC (wcommand
, full_command
, wsize
);
2432 free (full_command
);
2434 result
= CreateProcess
2435 (NULL
, wcommand
, &SA
, NULL
, TRUE
,
2436 GetPriorityClass (GetCurrentProcess()), NULL
, NULL
, &SI
, &PI
);
2443 CloseHandle (PI
.hThread
);
2445 *pid
= PI
.dwProcessId
;
2455 win32_wait (int *status
)
2457 DWORD exitcode
, pid
;
2463 if (plist_length
== 0)
2469 /* -------------------- critical section -------------------- */
2472 hl_len
= plist_length
;
2474 hl
= (HANDLE
*) xmalloc (sizeof (HANDLE
) * hl_len
);
2476 memmove (hl
, HANDLES_LIST
, sizeof (HANDLE
) * hl_len
);
2479 /* -------------------- critical section -------------------- */
2481 res
= WaitForMultipleObjects (hl_len
, hl
, FALSE
, INFINITE
);
2482 h
= hl
[res
- WAIT_OBJECT_0
];
2484 GetExitCodeProcess (h
, &exitcode
);
2485 pid
= PID_LIST
[res
- WAIT_OBJECT_0
];
2486 __gnat_win32_remove_handle (h
, -1);
2490 *status
= (int) exitcode
;
2497 __gnat_portable_no_block_spawn (char *args
[] ATTRIBUTE_UNUSED
)
2500 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX) \
2501 || defined (__PikeOS__)
2502 /* Not supported. */
2505 #elif defined (_WIN32)
2510 win32_no_block_spawn (args
[0], args
, &h
, &pid
);
2513 add_handle (h
, pid
);
2526 if (execv (args
[0], MAYBE_TO_PTR32 (args
)) != 0)
2536 __gnat_portable_wait (int *process_status
)
2541 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX) \
2542 || defined (__PikeOS__)
2543 /* Not sure what to do here, so do nothing but return zero. */
2545 #elif defined (_WIN32)
2547 pid
= win32_wait (&status
);
2551 pid
= waitpid (-1, &status
, 0);
2552 status
= status
& 0xffff;
2555 *process_status
= status
;
2560 __gnat_os_exit (int status
)
2565 /* Locate file on path, that matches a predicate */
2568 __gnat_locate_file_with_predicate (char *file_name
, char *path_val
,
2569 int (*predicate
)(char *))
2572 char *file_path
= (char *) alloca (strlen (file_name
) + 1);
2575 /* Return immediately if file_name is empty */
2577 if (*file_name
== '\0')
2580 /* Remove quotes around file_name if present */
2586 strcpy (file_path
, ptr
);
2588 ptr
= file_path
+ strlen (file_path
) - 1;
2593 /* Handle absolute pathnames. */
2595 absolute
= __gnat_is_absolute_path (file_path
, strlen (file_name
));
2599 if (predicate (file_path
))
2600 return xstrdup (file_path
);
2605 /* If file_name include directory separator(s), try it first as
2606 a path name relative to the current directory */
2607 for (ptr
= file_name
; *ptr
&& *ptr
!= '/' && *ptr
!= DIR_SEPARATOR
; ptr
++)
2612 if (predicate (file_name
))
2613 return xstrdup (file_name
);
2620 /* The result has to be smaller than path_val + file_name. */
2622 (char *) alloca (strlen (path_val
) + strlen (file_name
) + 2);
2626 /* Skip the starting quote */
2628 if (*path_val
== '"')
2631 for (ptr
= file_path
; *path_val
&& *path_val
!= PATH_SEPARATOR
; )
2632 *ptr
++ = *path_val
++;
2634 /* If directory is empty, it is the current directory*/
2636 if (ptr
== file_path
)
2643 /* Skip the ending quote */
2648 if (*ptr
!= '/' && *ptr
!= DIR_SEPARATOR
)
2649 *++ptr
= DIR_SEPARATOR
;
2651 strcpy (++ptr
, file_name
);
2653 if (predicate (file_path
))
2654 return xstrdup (file_path
);
2659 /* Skip path separator */
2668 /* Locate an executable file, give a Path value. */
2671 __gnat_locate_executable_file (char *file_name
, char *path_val
)
2673 return __gnat_locate_file_with_predicate
2674 (file_name
, path_val
, &__gnat_is_executable_file
);
2677 /* Locate a regular file, give a Path value. */
2680 __gnat_locate_regular_file (char *file_name
, char *path_val
)
2682 return __gnat_locate_file_with_predicate
2683 (file_name
, path_val
, &__gnat_is_regular_file
);
2686 /* Locate an executable given a Path argument. This routine is only used by
2687 gnatbl and should not be used otherwise. Use locate_exec_on_path
2691 __gnat_locate_exec (char *exec_name
, char *path_val
)
2694 if (!strstr (exec_name
, HOST_EXECUTABLE_SUFFIX
))
2696 char *full_exec_name
=
2698 (strlen (exec_name
) + strlen (HOST_EXECUTABLE_SUFFIX
) + 1);
2700 strcpy (full_exec_name
, exec_name
);
2701 strcat (full_exec_name
, HOST_EXECUTABLE_SUFFIX
);
2702 ptr
= __gnat_locate_executable_file (full_exec_name
, path_val
);
2705 return __gnat_locate_executable_file (exec_name
, path_val
);
2709 return __gnat_locate_executable_file (exec_name
, path_val
);
2712 /* Locate an executable using the Systems default PATH. */
2715 __gnat_locate_exec_on_path (char *exec_name
)
2719 #if defined (_WIN32) && !defined (RTX)
2720 TCHAR
*wpath_val
= _tgetenv (_T("PATH"));
2722 /* In Win32 systems we expand the PATH as for XP environment
2723 variables are not automatically expanded. We also prepend the
2724 ".;" to the path to match normal NT path search semantics */
2726 #define EXPAND_BUFFER_SIZE 32767
2728 wapath_val
= (TCHAR
*) alloca (EXPAND_BUFFER_SIZE
);
2730 wapath_val
[0] = '.';
2731 wapath_val
[1] = ';';
2733 DWORD res
= ExpandEnvironmentStrings
2734 (wpath_val
, &wapath_val
[2], EXPAND_BUFFER_SIZE
- 2);
2736 if (!res
) wapath_val
[0] = _T('\0');
2738 apath_val
= (char *) alloca (EXPAND_BUFFER_SIZE
);
2740 WS2SC (apath_val
, wapath_val
, EXPAND_BUFFER_SIZE
);
2741 return __gnat_locate_exec (exec_name
, apath_val
);
2744 char *path_val
= getenv ("PATH");
2746 if (path_val
== NULL
) return NULL
;
2747 apath_val
= (char *) alloca (strlen (path_val
) + 1);
2748 strcpy (apath_val
, path_val
);
2749 return __gnat_locate_exec (exec_name
, apath_val
);
2753 /* Dummy functions for Osint import for non-VMS systems.
2754 ??? To be removed. */
2757 __gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED
,
2758 int onlydirs ATTRIBUTE_UNUSED
)
2764 __gnat_to_canonical_file_list_next (void)
2766 static char empty
[] = "";
2771 __gnat_to_canonical_file_list_free (void)
2776 __gnat_to_canonical_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2782 __gnat_to_canonical_file_spec (char *filespec
)
2788 __gnat_to_canonical_path_spec (char *pathspec
)
2794 __gnat_to_host_dir_spec (char *dirspec
, int prefixflag ATTRIBUTE_UNUSED
)
2800 __gnat_to_host_file_spec (char *filespec
)
2806 __gnat_adjust_os_resource_limits (void)
2810 #if defined (__mips_vxworks)
2814 CACHE_USER_FLUSH (0, ENTIRE_CACHE
);
2818 #if defined (_WIN32)
2819 int __gnat_argument_needs_quote
= 1;
2821 int __gnat_argument_needs_quote
= 0;
2824 /* This option is used to enable/disable object files handling from the
2825 binder file by the GNAT Project module. For example, this is disabled on
2826 Windows (prior to GCC 3.4) as it is already done by the mdll module.
2827 Stating with GCC 3.4 the shared libraries are not based on mdll
2828 anymore as it uses the GCC's -shared option */
2829 #if defined (_WIN32) \
2830 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
2831 int __gnat_prj_add_obj_files
= 0;
2833 int __gnat_prj_add_obj_files
= 1;
2836 /* char used as prefix/suffix for environment variables */
2837 #if defined (_WIN32)
2838 char __gnat_environment_char
= '%';
2840 char __gnat_environment_char
= '$';
2843 /* This functions copy the file attributes from a source file to a
2846 mode = 0 : In this mode copy only the file time stamps (last access and
2847 last modification time stamps).
2849 mode = 1 : In this mode, time stamps and read/write/execute attributes are
2852 Returns 0 if operation was successful and -1 in case of error. */
2855 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED
, char *to ATTRIBUTE_UNUSED
,
2856 int mode ATTRIBUTE_UNUSED
)
2858 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) || \
2859 defined (__nucleus__)
2862 #elif defined (_WIN32) && !defined (RTX)
2863 TCHAR wfrom
[GNAT_MAX_PATH_LEN
+ 2];
2864 TCHAR wto
[GNAT_MAX_PATH_LEN
+ 2];
2866 FILETIME fct
, flat
, flwt
;
2869 S2WSC (wfrom
, from
, GNAT_MAX_PATH_LEN
+ 2);
2870 S2WSC (wto
, to
, GNAT_MAX_PATH_LEN
+ 2);
2872 /* retrieve from times */
2875 (wfrom
, GENERIC_READ
, 0, NULL
, OPEN_EXISTING
, FILE_ATTRIBUTE_NORMAL
, NULL
);
2877 if (hfrom
== INVALID_HANDLE_VALUE
)
2880 res
= GetFileTime (hfrom
, &fct
, &flat
, &flwt
);
2882 CloseHandle (hfrom
);
2887 /* retrieve from times */
2890 (wto
, GENERIC_WRITE
, 0, NULL
, OPEN_EXISTING
, FILE_ATTRIBUTE_NORMAL
, NULL
);
2892 if (hto
== INVALID_HANDLE_VALUE
)
2895 res
= SetFileTime (hto
, NULL
, &flat
, &flwt
);
2902 /* Set file attributes in full mode. */
2906 DWORD attribs
= GetFileAttributes (wfrom
);
2908 if (attribs
== INVALID_FILE_ATTRIBUTES
)
2911 res
= SetFileAttributes (wto
, attribs
);
2919 GNAT_STRUCT_STAT fbuf
;
2920 struct utimbuf tbuf
;
2922 if (GNAT_STAT (from
, &fbuf
) == -1)
2927 tbuf
.actime
= fbuf
.st_atime
;
2928 tbuf
.modtime
= fbuf
.st_mtime
;
2930 if (utime (to
, &tbuf
) == -1)
2937 if (chmod (to
, fbuf
.st_mode
) == -1)
2948 __gnat_lseek (int fd
, long offset
, int whence
)
2950 return (int) lseek (fd
, offset
, whence
);
2953 /* This function returns the major version number of GCC being used. */
2955 get_gcc_version (void)
2960 return (int) (version_string
[0] - '0');
2965 * Set Close_On_Exec as indicated.
2966 * Note: this is used for both GNAT.OS_Lib and GNAT.Sockets.
2970 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED
,
2971 int close_on_exec_p ATTRIBUTE_UNUSED
)
2973 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
2974 int flags
= fcntl (fd
, F_GETFD
, 0);
2977 if (close_on_exec_p
)
2978 flags
|= FD_CLOEXEC
;
2980 flags
&= ~FD_CLOEXEC
;
2981 return fcntl (fd
, F_SETFD
, flags
);
2982 #elif defined(_WIN32)
2983 HANDLE h
= (HANDLE
) _get_osfhandle (fd
);
2984 if (h
== (HANDLE
) -1)
2986 if (close_on_exec_p
)
2987 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
, 0);
2988 return ! SetHandleInformation (h
, HANDLE_FLAG_INHERIT
,
2989 HANDLE_FLAG_INHERIT
);
2991 /* TODO: Unimplemented. */
2996 /* Indicates if platforms supports automatic initialization through the
2997 constructor mechanism */
2999 __gnat_binder_supports_auto_init (void)
3004 /* Indicates that Stand-Alone Libraries are automatically initialized through
3005 the constructor mechanism */
3007 __gnat_sals_init_using_constructors (void)
3009 #if defined (__vxworks) || defined (__Lynx__)
3018 /* In RTX mode, the procedure to get the time (as file time) is different
3019 in RTSS mode and Win32 mode. In order to avoid duplicating an Ada file,
3020 we introduce an intermediate procedure to link against the corresponding
3021 one in each situation. */
3023 extern void GetTimeAsFileTime (LPFILETIME pTime
);
3025 void GetTimeAsFileTime (LPFILETIME pTime
)
3028 RtGetRtssTimeAsFileTime (pTime
); /* RTSS interface */
3030 GetSystemTimeAsFileTime (pTime
); /* w32 interface */
3035 /* Add symbol that is required to link. It would otherwise be taken from
3036 libgcc.a and it would try to use the gcc constructors that are not
3037 supported by Microsoft linker. */
3039 extern void __main (void);
3047 #if defined (__ANDROID__)
3049 #include <pthread.h>
3052 __gnat_lwp_self (void)
3054 return (void *) pthread_self ();
3057 #elif defined (linux)
3058 /* There is no function in the glibc to retrieve the LWP of the current
3059 thread. We need to do a system call in order to retrieve this
3061 #include <sys/syscall.h>
3063 __gnat_lwp_self (void)
3065 return (void *) syscall (__NR_gettid
);
3070 /* glibc versions earlier than 2.7 do not define the routines to handle
3071 dynamically allocated CPU sets. For these targets, we use the static
3076 /* Dynamic cpu sets */
3079 __gnat_cpu_alloc (size_t count
)
3081 return CPU_ALLOC (count
);
3085 __gnat_cpu_alloc_size (size_t count
)
3087 return CPU_ALLOC_SIZE (count
);
3091 __gnat_cpu_free (cpu_set_t
*set
)
3097 __gnat_cpu_zero (size_t count
, cpu_set_t
*set
)
3099 CPU_ZERO_S (count
, set
);
3103 __gnat_cpu_set (int cpu
, size_t count
, cpu_set_t
*set
)
3105 /* Ada handles CPU numbers starting from 1, while C identifies the first
3106 CPU by a 0, so we need to adjust. */
3107 CPU_SET_S (cpu
- 1, count
, set
);
3110 #else /* !CPU_ALLOC */
3112 /* Static cpu sets */
3115 __gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED
)
3117 return (cpu_set_t
*) xmalloc (sizeof (cpu_set_t
));
3121 __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED
)
3123 return sizeof (cpu_set_t
);
3127 __gnat_cpu_free (cpu_set_t
*set
)
3133 __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3139 __gnat_cpu_set (int cpu
, size_t count ATTRIBUTE_UNUSED
, cpu_set_t
*set
)
3141 /* Ada handles CPU numbers starting from 1, while C identifies the first
3142 CPU by a 0, so we need to adjust. */
3143 CPU_SET (cpu
- 1, set
);
3145 #endif /* !CPU_ALLOC */
3148 /* Return the load address of the executable, or 0 if not known. In the
3149 specific case of error, (void *)-1 can be returned. Beware: this unit may
3150 be in a shared library. As low-level units are needed, we allow #include
3153 #if defined (__APPLE__)
3154 #include <mach-o/dyld.h>
3155 #elif 0 && defined (__linux__)
3160 __gnat_get_executable_load_address (void)
3162 #if defined (__APPLE__)
3163 return _dyld_get_image_header (0);
3165 #elif 0 && defined (__linux__)
3166 /* Currently disabled as it needs at least -ldl. */
3167 struct link_map
*map
= _r_debug
.r_map
;
3169 return (const void *)map
->l_addr
;