]> git.ipfire.org Git - thirdparty/gcc.git/blob - gcc/ada/adaint.c
cd3f11a3469d4a24dcc1a0d88e7b1ba6345b8eb7
[thirdparty/gcc.git] / gcc / ada / adaint.c
1 /****************************************************************************
2 * *
3 * GNAT COMPILER COMPONENTS *
4 * *
5 * A D A I N T *
6 * *
7 * C Implementation File *
8 * *
9 * Copyright (C) 1992-2014, Free Software Foundation, Inc. *
10 * *
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. *
17 * *
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. *
21 * *
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/>. *
26 * *
27 * GNAT was originally developed by the GNAT team at New York University. *
28 * Extensive contributions were provided by Ada Core Technologies Inc. *
29 * *
30 ****************************************************************************/
31
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. */
36
37 /* Ensure access to errno is thread safe. */
38 #define _REENTRANT
39 #define _THREAD_SAFE
40
41 #ifdef __vxworks
42
43 /* No need to redefine exit here. */
44 #undef exit
45
46 /* We want to use the POSIX variants of include files. */
47 #define POSIX
48 #include "vxWorks.h"
49
50 #if defined (__mips_vxworks)
51 #include "cacheLib.h"
52 #endif /* __mips_vxworks */
53
54 /* If SMP, access vxCpuConfiguredGet */
55 #ifdef _WRS_CONFIG_SMP
56 #include <vxCpuLib.h>
57 #endif /* _WRS_CONFIG_SMP */
58
59 /* We need to know the VxWorks version because some file operations
60 (such as chmod) are only available on VxWorks 6. */
61 #include "version.h"
62
63 #endif /* VxWorks */
64
65 #if defined (__APPLE__)
66 #include <unistd.h>
67 #endif
68
69 #if defined (__hpux__)
70 #include <sys/param.h>
71 #include <sys/pstat.h>
72 #endif
73
74 #ifdef __PikeOS__
75 #define __BSD_VISIBLE 1
76 #endif
77
78 #ifdef IN_RTS
79 #include "tconfig.h"
80 #include "tsystem.h"
81 #include <sys/stat.h>
82 #include <fcntl.h>
83 #include <time.h>
84
85 #if defined (__vxworks) || defined (__ANDROID__)
86 /* S_IREAD and S_IWRITE are not defined in VxWorks or Android */
87 #ifndef S_IREAD
88 #define S_IREAD (S_IRUSR | S_IRGRP | S_IROTH)
89 #endif
90
91 #ifndef S_IWRITE
92 #define S_IWRITE (S_IWUSR)
93 #endif
94 #endif
95
96 /* We don't have libiberty, so use malloc. */
97 #define xmalloc(S) malloc (S)
98 #define xrealloc(V,S) realloc (V,S)
99 #else
100 #include "config.h"
101 #include "system.h"
102 #include "version.h"
103 #endif
104
105 #ifdef __cplusplus
106 extern "C" {
107 #endif
108
109 #if defined (__MINGW32__)
110
111 #if defined (RTX)
112 #include <windows.h>
113 #include <Rtapi.h>
114 #else
115 #include "mingw32.h"
116
117 /* Current code page and CCS encoding to use, set in initialize.c. */
118 UINT CurrentCodePage;
119 UINT CurrentCCSEncoding;
120 #endif
121
122 #include <sys/utime.h>
123
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. */
127
128 #ifdef IN_RTS
129 #include <ctype.h>
130 #define ISALPHA isalpha
131 #endif
132
133 #elif defined (__Lynx__)
134
135 /* Lynx utime.h only defines the entities of interest to us if
136 defined (VMOS_DEV), so ... */
137 #define VMOS_DEV
138 #include <utime.h>
139 #undef VMOS_DEV
140
141 #else
142 #include <utime.h>
143 #endif
144
145 /* wait.h processing */
146 #ifdef __MINGW32__
147 # if OLD_MINGW
148 # include <sys/wait.h>
149 # endif
150 #elif defined (__vxworks) && defined (__RTP__)
151 # include <wait.h>
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. */
162 #else
163 /* Default case. */
164 #include <sys/wait.h>
165 #endif
166
167 #if defined (_WIN32)
168
169 #include <process.h>
170 #include <dir.h>
171 #include <windows.h>
172 #include <accctrl.h>
173 #include <aclapi.h>
174 #undef DIR_SEPARATOR
175 #define DIR_SEPARATOR '\\'
176
177 #else
178 #include <utime.h>
179 #endif
180
181 #include "adaint.h"
182
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. */
188
189 #ifndef O_BINARY
190 #define O_BINARY 0
191 #endif
192
193 #ifndef O_TEXT
194 #define O_TEXT 0
195 #endif
196
197 #ifndef HOST_EXECUTABLE_SUFFIX
198 #define HOST_EXECUTABLE_SUFFIX ""
199 #endif
200
201 #ifndef HOST_OBJECT_SUFFIX
202 #define HOST_OBJECT_SUFFIX ".o"
203 #endif
204
205 #ifndef PATH_SEPARATOR
206 #define PATH_SEPARATOR ':'
207 #endif
208
209 #ifndef DIR_SEPARATOR
210 #define DIR_SEPARATOR '/'
211 #endif
212
213 /* Check for cross-compilation. */
214 #if defined (CROSS_COMPILE) || defined (CROSS_DIRECTORY_STRUCTURE)
215 #define IS_CROSS 1
216 int __gnat_is_cross_compiler = 1;
217 #else
218 #undef IS_CROSS
219 int __gnat_is_cross_compiler = 0;
220 #endif
221
222 char __gnat_dir_separator = DIR_SEPARATOR;
223
224 char __gnat_path_separator = PATH_SEPARATOR;
225
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
230
231 library_template ::= { pattern ; } pattern NUL
232 pattern ::= [ prefix ] * [ postfix ]
233
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
237 to be up-to-date:
238
239 * if they are needed but not present, the link
240 will fail,
241
242 * otherwise they are libraries in the system paths and so
243 they are considered part of the system and not checked
244 for that reason.
245
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. */
249
250 #ifndef GNAT_LIBRARY_TEMPLATE
251 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
252 #endif
253
254 const char *__gnat_library_template = GNAT_LIBRARY_TEMPLATE;
255
256 #if defined (__vxworks) || defined (__OPENNT) || defined(__nucleus__)
257 #define GNAT_MAX_PATH_LEN PATH_MAX
258
259 #else
260
261 #if defined (__MINGW32__)
262 #include "mingw32.h"
263
264 #if OLD_MINGW
265 #include <sys/param.h>
266 #endif
267
268 #else
269 #include <sys/param.h>
270 #endif
271
272 #ifdef MAXPATHLEN
273 #define GNAT_MAX_PATH_LEN MAXPATHLEN
274 #else
275 #define GNAT_MAX_PATH_LEN 256
276 #endif
277
278 #endif
279
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
282 initialization). */
283 int __gnat_size_of_file_attributes = sizeof (struct file_attributes);
284
285 void __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr);
286
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
290 it. */
291
292 int __gnat_max_path_len = GNAT_MAX_PATH_LEN;
293 int max_path_len = GNAT_MAX_PATH_LEN;
294
295 /* Control whether we can use ACL on Windows. */
296
297 int __gnat_use_acl = 1;
298
299 /* The following macro HAVE_READDIR_R should be defined if the
300 system provides the routine readdir_r. */
301 #undef HAVE_READDIR_R
302 \f
303 #define MAYBE_TO_PTR32(argv) argv
304
305 static const char ATTR_UNSET = 127;
306
307 /* Reset the file attributes as if no system call had been performed */
308
309 void
310 __gnat_reset_attributes (struct file_attributes* attr)
311 {
312 attr->exists = ATTR_UNSET;
313 attr->error = EINVAL;
314
315 attr->writable = ATTR_UNSET;
316 attr->readable = ATTR_UNSET;
317 attr->executable = ATTR_UNSET;
318
319 attr->regular = ATTR_UNSET;
320 attr->symbolic_link = ATTR_UNSET;
321 attr->directory = ATTR_UNSET;
322
323 attr->timestamp = (OS_Time)-2;
324 attr->file_length = -1;
325 }
326
327 int
328 __gnat_error_attributes (struct file_attributes *attr) {
329 return attr->error;
330 }
331
332 OS_Time
333 __gnat_current_time (void)
334 {
335 time_t res = time (NULL);
336 return (OS_Time) res;
337 }
338
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
341 long. */
342
343 void
344 __gnat_current_time_string (char *result)
345 {
346 const char *format = "%Y-%m-%d %H:%M:%S";
347 /* Format string necessary to describe the ISO 8601 format */
348
349 const time_t t_val = time (NULL);
350
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. */
354
355 result [19] = '.';
356 result [20] = '0';
357 result [21] = '0';
358 /* The sub-seconds are manually set to zero since type time_t lacks the
359 precision necessary for nanoseconds. */
360 }
361
362 void
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)
365 {
366 struct tm *res;
367 time_t time = (time_t) *p_time;
368
369 #ifdef _WIN32
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. */
372 if (time & 1)
373 time++;
374 #endif
375
376 res = gmtime (&time);
377 if (res)
378 {
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;
385 }
386 else
387 *p_year = *p_month = *p_day = *p_hours = *p_mins = *p_secs = 0;
388 }
389
390 void
391 __gnat_to_os_time (OS_Time *p_time, int year, int month, int day,
392 int hours, int mins, int secs)
393 {
394 struct tm v;
395
396 v.tm_year = year;
397 v.tm_mon = month;
398 v.tm_mday = day;
399 v.tm_hour = hours;
400 v.tm_min = mins;
401 v.tm_sec = secs;
402 v.tm_isdst = -1;
403
404 /* returns -1 of failing, this is s-os_lib Invalid_Time */
405
406 *p_time = (OS_Time) mktime (&v);
407 }
408
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. */
413
414 int
415 __gnat_readlink (char *path ATTRIBUTE_UNUSED,
416 char *buf ATTRIBUTE_UNUSED,
417 size_t bufsiz ATTRIBUTE_UNUSED)
418 {
419 #if defined (_WIN32) \
420 || defined(__vxworks) || defined (__nucleus__) || defined (__PikeOS__)
421 return -1;
422 #else
423 return readlink (path, buf, bufsiz);
424 #endif
425 }
426
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. */
430
431 int
432 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED,
433 char *newpath ATTRIBUTE_UNUSED)
434 {
435 #if defined (_WIN32) \
436 || defined(__vxworks) || defined (__nucleus__) || defined (__PikeOS__)
437 return -1;
438 #else
439 return symlink (oldpath, newpath);
440 #endif
441 }
442
443 /* Try to lock a file, return 1 if success. */
444
445 #if defined (__vxworks) || defined (__nucleus__) \
446 || defined (_WIN32) || defined (__PikeOS__)
447
448 /* Version that does not use link. */
449
450 int
451 __gnat_try_lock (char *dir, char *file)
452 {
453 int fd;
454 #ifdef __MINGW32__
455 TCHAR wfull_path[GNAT_MAX_PATH_LEN];
456 TCHAR wfile[GNAT_MAX_PATH_LEN];
457 TCHAR wdir[GNAT_MAX_PATH_LEN];
458
459 S2WSC (wdir, dir, GNAT_MAX_PATH_LEN);
460 S2WSC (wfile, file, GNAT_MAX_PATH_LEN);
461
462 /* ??? the code below crash on MingW64 for obscure reasons, a ticket
463 has been opened here:
464
465 https://sourceforge.net/p/mingw-w64/bugs/414/
466
467 As a workaround an equivalent set of code has been put in place below.
468
469 _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
470 */
471
472 _tcscpy (wfull_path, wdir);
473 _tcscat (wfull_path, L"\\");
474 _tcscat (wfull_path, wfile);
475
476 fd = _topen (wfull_path, O_CREAT | O_EXCL, 0600);
477 #else
478 char full_path[256];
479
480 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
481 fd = open (full_path, O_CREAT | O_EXCL, 0600);
482 #endif
483
484 if (fd < 0)
485 return 0;
486
487 close (fd);
488 return 1;
489 }
490
491 #else
492
493 /* Version using link(), more secure over NFS. */
494 /* See TN 6913-016 for discussion ??? */
495
496 int
497 __gnat_try_lock (char *dir, char *file)
498 {
499 char full_path[256];
500 char temp_file[256];
501 GNAT_STRUCT_STAT stat_result;
502 int fd;
503
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 ());
507
508 /* Create the temporary file and write the process number. */
509 fd = open (temp_file, O_CREAT | O_WRONLY, 0600);
510 if (fd < 0)
511 return 0;
512
513 close (fd);
514
515 /* Link it with the new file. */
516 link (temp_file, full_path);
517
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);
521 unlink (temp_file);
522 return stat_result.st_nlink == 2;
523 }
524 #endif
525
526 /* Return the maximum file name length. */
527
528 int
529 __gnat_get_maximum_file_name_length (void)
530 {
531 return -1;
532 }
533
534 /* Return nonzero if file names are case sensitive. */
535
536 static int file_names_case_sensitive_cache = -1;
537
538 int
539 __gnat_get_file_names_case_sensitive (void)
540 {
541 if (file_names_case_sensitive_cache == -1)
542 {
543 const char *sensitive = getenv ("GNAT_FILE_NAME_CASE_SENSITIVE");
544
545 if (sensitive != NULL
546 && (sensitive[0] == '0' || sensitive[0] == '1')
547 && sensitive[1] == '\0')
548 file_names_case_sensitive_cache = sensitive[0] - '0';
549 else
550 {
551 /* By default, we suppose filesystems aren't case sensitive on
552 Windows and Darwin (but they are on arm-darwin). */
553 #if defined (WINNT) || (defined (__APPLE__) && !defined (__arm__))
554 file_names_case_sensitive_cache = 0;
555 #else
556 file_names_case_sensitive_cache = 1;
557 #endif
558 }
559 }
560 return file_names_case_sensitive_cache;
561 }
562
563 /* Return nonzero if environment variables are case sensitive. */
564
565 int
566 __gnat_get_env_vars_case_sensitive (void)
567 {
568 #if defined (WINNT)
569 return 0;
570 #else
571 return 1;
572 #endif
573 }
574
575 char
576 __gnat_get_default_identifier_character_set (void)
577 {
578 return '1';
579 }
580
581 /* Return the current working directory. */
582
583 void
584 __gnat_get_current_dir (char *dir, int *length)
585 {
586 #if defined (__MINGW32__)
587 TCHAR wdir[GNAT_MAX_PATH_LEN];
588
589 _tgetcwd (wdir, *length);
590
591 WS2SC (dir, wdir, GNAT_MAX_PATH_LEN);
592
593 #else
594 getcwd (dir, *length);
595 #endif
596
597 *length = strlen (dir);
598
599 if (dir [*length - 1] != DIR_SEPARATOR)
600 {
601 dir [*length] = DIR_SEPARATOR;
602 ++(*length);
603 }
604 dir[*length] = '\0';
605 }
606
607 /* Return the suffix for object files. */
608
609 void
610 __gnat_get_object_suffix_ptr (int *len, const char **value)
611 {
612 *value = HOST_OBJECT_SUFFIX;
613
614 if (*value == 0)
615 *len = 0;
616 else
617 *len = strlen (*value);
618
619 return;
620 }
621
622 /* Return the suffix for executable files. */
623
624 void
625 __gnat_get_executable_suffix_ptr (int *len, const char **value)
626 {
627 *value = HOST_EXECUTABLE_SUFFIX;
628 if (!*value)
629 *len = 0;
630 else
631 *len = strlen (*value);
632
633 return;
634 }
635
636 /* Return the suffix for debuggable files. Usually this is the same as the
637 executable extension. */
638
639 void
640 __gnat_get_debuggable_suffix_ptr (int *len, const char **value)
641 {
642 *value = HOST_EXECUTABLE_SUFFIX;
643
644 if (*value == 0)
645 *len = 0;
646 else
647 *len = strlen (*value);
648
649 return;
650 }
651
652 /* Returns the OS filename and corresponding encoding. */
653
654 void
655 __gnat_os_filename (char *filename ATTRIBUTE_UNUSED,
656 char *w_filename ATTRIBUTE_UNUSED,
657 char *os_name, int *o_length,
658 char *encoding ATTRIBUTE_UNUSED, int *e_length)
659 {
660 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
661 WS2SC (os_name, (TCHAR *)w_filename, (DWORD)*o_length);
662 *o_length = strlen (os_name);
663 strcpy (encoding, "encoding=utf8");
664 *e_length = strlen (encoding);
665 #else
666 strcpy (os_name, filename);
667 *o_length = strlen (filename);
668 *e_length = 0;
669 #endif
670 }
671
672 /* Delete a file. */
673
674 int
675 __gnat_unlink (char *path)
676 {
677 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
678 {
679 TCHAR wpath[GNAT_MAX_PATH_LEN];
680
681 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
682 return _tunlink (wpath);
683 }
684 #else
685 return unlink (path);
686 #endif
687 }
688
689 /* Rename a file. */
690
691 int
692 __gnat_rename (char *from, char *to)
693 {
694 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
695 {
696 TCHAR wfrom[GNAT_MAX_PATH_LEN], wto[GNAT_MAX_PATH_LEN];
697
698 S2WSC (wfrom, from, GNAT_MAX_PATH_LEN);
699 S2WSC (wto, to, GNAT_MAX_PATH_LEN);
700 return _trename (wfrom, wto);
701 }
702 #else
703 return rename (from, to);
704 #endif
705 }
706
707 /* Changing directory. */
708
709 int
710 __gnat_chdir (char *path)
711 {
712 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
713 {
714 TCHAR wpath[GNAT_MAX_PATH_LEN];
715
716 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
717 return _tchdir (wpath);
718 }
719 #else
720 return chdir (path);
721 #endif
722 }
723
724 /* Removing a directory. */
725
726 int
727 __gnat_rmdir (char *path)
728 {
729 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
730 {
731 TCHAR wpath[GNAT_MAX_PATH_LEN];
732
733 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
734 return _trmdir (wpath);
735 }
736 #elif defined (VTHREADS)
737 /* rmdir not available */
738 return -1;
739 #else
740 return rmdir (path);
741 #endif
742 }
743
744 #if defined (_WIN32) || defined (linux) || defined (sun) \
745 || defined (__FreeBSD__)
746 #define HAS_TARGET_WCHAR_T
747 #endif
748
749 #ifdef HAS_TARGET_WCHAR_T
750 #include <wchar.h>
751 #endif
752
753 int
754 __gnat_fputwc(int c, FILE *stream)
755 {
756 #ifdef HAS_TARGET_WCHAR_T
757 return fputwc ((wchar_t)c, stream);
758 #else
759 return fputc (c, stream);
760 #endif
761 }
762
763 FILE *
764 __gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED)
765 {
766 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
767 TCHAR wpath[GNAT_MAX_PATH_LEN];
768 TCHAR wmode[10];
769
770 S2WS (wmode, mode, 10);
771
772 if (encoding == Encoding_Unspecified)
773 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
774 else if (encoding == Encoding_UTF8)
775 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
776 else
777 S2WS (wpath, path, GNAT_MAX_PATH_LEN);
778
779 return _tfopen (wpath, wmode);
780
781 #else
782 return GNAT_FOPEN (path, mode);
783 #endif
784 }
785
786 FILE *
787 __gnat_freopen (char *path,
788 char *mode,
789 FILE *stream,
790 int encoding ATTRIBUTE_UNUSED)
791 {
792 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
793 TCHAR wpath[GNAT_MAX_PATH_LEN];
794 TCHAR wmode[10];
795
796 S2WS (wmode, mode, 10);
797
798 if (encoding == Encoding_Unspecified)
799 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
800 else if (encoding == Encoding_UTF8)
801 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
802 else
803 S2WS (wpath, path, GNAT_MAX_PATH_LEN);
804
805 return _tfreopen (wpath, wmode, stream);
806 #else
807 return freopen (path, mode, stream);
808 #endif
809 }
810
811 int
812 __gnat_open_read (char *path, int fmode)
813 {
814 int fd;
815 int o_fmode = O_BINARY;
816
817 if (fmode)
818 o_fmode = O_TEXT;
819
820 #if defined (__vxworks)
821 fd = open (path, O_RDONLY | o_fmode, 0444);
822 #elif defined (__MINGW32__)
823 {
824 TCHAR wpath[GNAT_MAX_PATH_LEN];
825
826 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
827 fd = _topen (wpath, O_RDONLY | o_fmode, 0444);
828 }
829 #else
830 fd = GNAT_OPEN (path, O_RDONLY | o_fmode);
831 #endif
832
833 return fd < 0 ? -1 : fd;
834 }
835
836 #if defined (__MINGW32__)
837 #define PERM (S_IREAD | S_IWRITE)
838 #else
839 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
840 #endif
841
842 int
843 __gnat_open_rw (char *path, int fmode)
844 {
845 int fd;
846 int o_fmode = O_BINARY;
847
848 if (fmode)
849 o_fmode = O_TEXT;
850
851 #if defined (__MINGW32__)
852 {
853 TCHAR wpath[GNAT_MAX_PATH_LEN];
854
855 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
856 fd = _topen (wpath, O_RDWR | o_fmode, PERM);
857 }
858 #else
859 fd = GNAT_OPEN (path, O_RDWR | o_fmode, PERM);
860 #endif
861
862 return fd < 0 ? -1 : fd;
863 }
864
865 int
866 __gnat_open_create (char *path, int fmode)
867 {
868 int fd;
869 int o_fmode = O_BINARY;
870
871 if (fmode)
872 o_fmode = O_TEXT;
873
874 #if defined (__MINGW32__)
875 {
876 TCHAR wpath[GNAT_MAX_PATH_LEN];
877
878 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
879 fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
880 }
881 #else
882 fd = GNAT_OPEN (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
883 #endif
884
885 return fd < 0 ? -1 : fd;
886 }
887
888 int
889 __gnat_create_output_file (char *path)
890 {
891 int fd;
892 #if defined (__MINGW32__)
893 {
894 TCHAR wpath[GNAT_MAX_PATH_LEN];
895
896 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
897 fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
898 }
899 #else
900 fd = GNAT_OPEN (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
901 #endif
902
903 return fd < 0 ? -1 : fd;
904 }
905
906 int
907 __gnat_create_output_file_new (char *path)
908 {
909 int fd;
910 #if defined (__MINGW32__)
911 {
912 TCHAR wpath[GNAT_MAX_PATH_LEN];
913
914 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
915 fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM);
916 }
917 #else
918 fd = GNAT_OPEN (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM);
919 #endif
920
921 return fd < 0 ? -1 : fd;
922 }
923
924 int
925 __gnat_open_append (char *path, int fmode)
926 {
927 int fd;
928 int o_fmode = O_BINARY;
929
930 if (fmode)
931 o_fmode = O_TEXT;
932
933 #if defined (__MINGW32__)
934 {
935 TCHAR wpath[GNAT_MAX_PATH_LEN];
936
937 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
938 fd = _topen (wpath, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
939 }
940 #else
941 fd = GNAT_OPEN (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
942 #endif
943
944 return fd < 0 ? -1 : fd;
945 }
946
947 /* Open a new file. Return error (-1) if the file already exists. */
948
949 int
950 __gnat_open_new (char *path, int fmode)
951 {
952 int fd;
953 int o_fmode = O_BINARY;
954
955 if (fmode)
956 o_fmode = O_TEXT;
957
958 #if defined (__MINGW32__)
959 {
960 TCHAR wpath[GNAT_MAX_PATH_LEN];
961
962 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
963 fd = _topen (wpath, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
964 }
965 #else
966 fd = GNAT_OPEN (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
967 #endif
968
969 return fd < 0 ? -1 : fd;
970 }
971
972 /* Open a new temp file. Return error (-1) if the file already exists. */
973
974 int
975 __gnat_open_new_temp (char *path, int fmode)
976 {
977 int fd;
978 int o_fmode = O_BINARY;
979
980 strcpy (path, "GNAT-XXXXXX");
981
982 #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
983 || defined (linux) || defined(__GLIBC__)) && !defined (__vxworks)
984 return mkstemp (path);
985 #elif defined (__Lynx__)
986 mktemp (path);
987 #elif defined (__nucleus__)
988 return -1;
989 #else
990 if (mktemp (path) == NULL)
991 return -1;
992 #endif
993
994 if (fmode)
995 o_fmode = O_TEXT;
996
997 fd = GNAT_OPEN (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
998 return fd < 0 ? -1 : fd;
999 }
1000
1001 int
1002 __gnat_open (char *path, int fmode)
1003 {
1004 int fd;
1005
1006 #if defined (__MINGW32__)
1007 {
1008 TCHAR wpath[GNAT_MAX_PATH_LEN];
1009
1010 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
1011 fd = _topen (wpath, fmode, PERM);
1012 }
1013 #else
1014 fd = GNAT_OPEN (path, fmode, PERM);
1015 #endif
1016
1017 return fd < 0 ? -1 : fd;
1018 }
1019
1020 /****************************************************************
1021 ** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information
1022 ** as possible from it, storing the result in a cache for later reuse
1023 ****************************************************************/
1024
1025 void
1026 __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr)
1027 {
1028 GNAT_STRUCT_STAT statbuf;
1029 int ret, error;
1030
1031 if (fd != -1) {
1032 /* GNAT_FSTAT returns -1 and sets errno for failure */
1033 ret = GNAT_FSTAT (fd, &statbuf);
1034 error = ret ? errno : 0;
1035
1036 } else {
1037 /* __gnat_stat returns errno value directly */
1038 error = __gnat_stat (name, &statbuf);
1039 ret = error ? -1 : 0;
1040 }
1041
1042 /*
1043 * A missing file is reported as an attr structure with error == 0 and
1044 * exists == 0.
1045 */
1046
1047 if (error == 0 || error == ENOENT)
1048 attr->error = 0;
1049 else
1050 attr->error = error;
1051
1052 attr->regular = (!ret && S_ISREG (statbuf.st_mode));
1053 attr->directory = (!ret && S_ISDIR (statbuf.st_mode));
1054
1055 if (!attr->regular)
1056 attr->file_length = 0;
1057 else
1058 /* st_size may be 32 bits, or 64 bits which is converted to long. We
1059 don't return a useful value for files larger than 2 gigabytes in
1060 either case. */
1061 attr->file_length = statbuf.st_size; /* all systems */
1062
1063 attr->exists = !ret;
1064
1065 #if !defined (_WIN32) || defined (RTX)
1066 /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
1067 attr->readable = (!ret && (statbuf.st_mode & S_IRUSR));
1068 attr->writable = (!ret && (statbuf.st_mode & S_IWUSR));
1069 attr->executable = (!ret && (statbuf.st_mode & S_IXUSR));
1070 #endif
1071
1072 if (ret != 0) {
1073 attr->timestamp = (OS_Time)-1;
1074 } else {
1075 attr->timestamp = (OS_Time)statbuf.st_mtime;
1076 }
1077 }
1078
1079 /****************************************************************
1080 ** Return the number of bytes in the specified file
1081 ****************************************************************/
1082
1083 __int64
1084 __gnat_file_length_attr (int fd, char* name, struct file_attributes* attr)
1085 {
1086 if (attr->file_length == -1) {
1087 __gnat_stat_to_attr (fd, name, attr);
1088 }
1089
1090 return attr->file_length;
1091 }
1092
1093 __int64
1094 __gnat_file_length (int fd)
1095 {
1096 struct file_attributes attr;
1097 __gnat_reset_attributes (&attr);
1098 return __gnat_file_length_attr (fd, NULL, &attr);
1099 }
1100
1101 long
1102 __gnat_file_length_long (int fd)
1103 {
1104 struct file_attributes attr;
1105 __gnat_reset_attributes (&attr);
1106 return (long)__gnat_file_length_attr (fd, NULL, &attr);
1107 }
1108
1109 __int64
1110 __gnat_named_file_length (char *name)
1111 {
1112 struct file_attributes attr;
1113 __gnat_reset_attributes (&attr);
1114 return __gnat_file_length_attr (-1, name, &attr);
1115 }
1116
1117 /* Create a temporary filename and put it in string pointed to by
1118 TMP_FILENAME. */
1119
1120 void
1121 __gnat_tmp_name (char *tmp_filename)
1122 {
1123 #ifdef RTX
1124 /* Variable used to create a series of unique names */
1125 static int counter = 0;
1126
1127 /* RTX in RTSS mode does not support tempnam nor tmpnam so we emulate it */
1128 strcpy (tmp_filename, "c:\\WINDOWS\\Temp\\gnat-");
1129 sprintf (&tmp_filename[strlen (tmp_filename)], "%d\0", counter++);
1130
1131 #elif defined (__MINGW32__)
1132 {
1133 char *pname;
1134 char prefix[25];
1135
1136 /* tempnam tries to create a temporary file in directory pointed to by
1137 TMP environment variable, in c:\temp if TMP is not set, and in
1138 directory specified by P_tmpdir in stdio.h if c:\temp does not
1139 exist. The filename will be created with the prefix "gnat-". */
1140
1141 sprintf (prefix, "gnat-%d-", (int)getpid());
1142 pname = (char *) _tempnam ("c:\\temp", prefix);
1143
1144 /* if pname is NULL, the file was not created properly, the disk is full
1145 or there is no more free temporary files */
1146
1147 if (pname == NULL)
1148 *tmp_filename = '\0';
1149
1150 /* If pname start with a back slash and not path information it means that
1151 the filename is valid for the current working directory. */
1152
1153 else if (pname[0] == '\\')
1154 {
1155 strcpy (tmp_filename, ".\\");
1156 strcat (tmp_filename, pname+1);
1157 }
1158 else
1159 strcpy (tmp_filename, pname);
1160
1161 free (pname);
1162 }
1163
1164 #elif defined (linux) || defined (__FreeBSD__) || defined (__NetBSD__) \
1165 || defined (__OpenBSD__) || defined(__GLIBC__) || defined (__ANDROID__)
1166 #define MAX_SAFE_PATH 1000
1167 char *tmpdir = getenv ("TMPDIR");
1168
1169 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1170 a buffer overflow. */
1171 if (tmpdir == NULL || strlen (tmpdir) > MAX_SAFE_PATH)
1172 #ifdef __ANDROID__
1173 strcpy (tmp_filename, "/cache/gnat-XXXXXX");
1174 #else
1175 strcpy (tmp_filename, "/tmp/gnat-XXXXXX");
1176 #endif
1177 else
1178 sprintf (tmp_filename, "%s/gnat-XXXXXX", tmpdir);
1179
1180 close (mkstemp(tmp_filename));
1181 #elif defined (__vxworks) && !(defined (__RTP__) || defined (VTHREADS))
1182 int index;
1183 char * pos;
1184 ushort_t t;
1185 static ushort_t seed = 0; /* used to generate unique name */
1186
1187 /* generate unique name */
1188 strcpy (tmp_filename, "tmp");
1189
1190 /* fill up the name buffer from the last position */
1191 index = 5;
1192 pos = tmp_filename + strlen (tmp_filename) + index;
1193 *pos = '\0';
1194
1195 seed++;
1196 for (t = seed; 0 <= --index; t >>= 3)
1197 *--pos = '0' + (t & 07);
1198 #else
1199 tmpnam (tmp_filename);
1200 #endif
1201 }
1202
1203 /* Open directory and returns a DIR pointer. */
1204
1205 DIR* __gnat_opendir (char *name)
1206 {
1207 #if defined (RTX)
1208 /* Not supported in RTX */
1209
1210 return NULL;
1211
1212 #elif defined (__MINGW32__)
1213 TCHAR wname[GNAT_MAX_PATH_LEN];
1214
1215 S2WSC (wname, name, GNAT_MAX_PATH_LEN);
1216 return (DIR*)_topendir (wname);
1217
1218 #else
1219 return opendir (name);
1220 #endif
1221 }
1222
1223 /* Read the next entry in a directory. The returned string points somewhere
1224 in the buffer. */
1225
1226 char *
1227 __gnat_readdir (DIR *dirp, char *buffer, int *len)
1228 {
1229 #if defined (RTX)
1230 /* Not supported in RTX */
1231
1232 return NULL;
1233
1234 #elif defined (__MINGW32__)
1235 struct _tdirent *dirent = _treaddir ((_TDIR*)dirp);
1236
1237 if (dirent != NULL)
1238 {
1239 WS2SC (buffer, dirent->d_name, GNAT_MAX_PATH_LEN);
1240 *len = strlen (buffer);
1241
1242 return buffer;
1243 }
1244 else
1245 return NULL;
1246
1247 #elif defined (HAVE_READDIR_R)
1248 /* If possible, try to use the thread-safe version. */
1249 if (readdir_r (dirp, buffer) != NULL)
1250 {
1251 *len = strlen (((struct dirent*) buffer)->d_name);
1252 return ((struct dirent*) buffer)->d_name;
1253 }
1254 else
1255 return NULL;
1256
1257 #else
1258 struct dirent *dirent = (struct dirent *) readdir (dirp);
1259
1260 if (dirent != NULL)
1261 {
1262 strcpy (buffer, dirent->d_name);
1263 *len = strlen (buffer);
1264 return buffer;
1265 }
1266 else
1267 return NULL;
1268
1269 #endif
1270 }
1271
1272 /* Close a directory entry. */
1273
1274 int __gnat_closedir (DIR *dirp)
1275 {
1276 #if defined (RTX)
1277 /* Not supported in RTX */
1278
1279 return 0;
1280
1281 #elif defined (__MINGW32__)
1282 return _tclosedir ((_TDIR*)dirp);
1283
1284 #else
1285 return closedir (dirp);
1286 #endif
1287 }
1288
1289 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1290
1291 int
1292 __gnat_readdir_is_thread_safe (void)
1293 {
1294 #ifdef HAVE_READDIR_R
1295 return 1;
1296 #else
1297 return 0;
1298 #endif
1299 }
1300
1301 #if defined (_WIN32) && !defined (RTX)
1302 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1303 static const unsigned long long w32_epoch_offset = 11644473600ULL;
1304
1305 /* Returns the file modification timestamp using Win32 routines which are
1306 immune against daylight saving time change. It is in fact not possible to
1307 use fstat for this purpose as the DST modify the st_mtime field of the
1308 stat structure. */
1309
1310 static time_t
1311 win32_filetime (HANDLE h)
1312 {
1313 union
1314 {
1315 FILETIME ft_time;
1316 unsigned long long ull_time;
1317 } t_write;
1318
1319 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1320 since <Jan 1st 1601>. This function must return the number of seconds
1321 since <Jan 1st 1970>. */
1322
1323 if (GetFileTime (h, NULL, NULL, &t_write.ft_time))
1324 return (time_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
1325 return (time_t) 0;
1326 }
1327
1328 /* As above but starting from a FILETIME. */
1329 static void
1330 f2t (const FILETIME *ft, __time64_t *t)
1331 {
1332 union
1333 {
1334 FILETIME ft_time;
1335 unsigned long long ull_time;
1336 } t_write;
1337
1338 t_write.ft_time = *ft;
1339 *t = (__time64_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
1340 }
1341 #endif
1342
1343 /* Return a GNAT time stamp given a file name. */
1344
1345 OS_Time
1346 __gnat_file_time_name_attr (char* name, struct file_attributes* attr)
1347 {
1348 if (attr->timestamp == (OS_Time)-2) {
1349 #if defined (_WIN32) && !defined (RTX)
1350 BOOL res;
1351 WIN32_FILE_ATTRIBUTE_DATA fad;
1352 __time64_t ret = -1;
1353 TCHAR wname[GNAT_MAX_PATH_LEN];
1354 S2WSC (wname, name, GNAT_MAX_PATH_LEN);
1355
1356 if ((res = GetFileAttributesEx (wname, GetFileExInfoStandard, &fad)))
1357 f2t (&fad.ftLastWriteTime, &ret);
1358 attr->timestamp = (OS_Time) ret;
1359 #else
1360 __gnat_stat_to_attr (-1, name, attr);
1361 #endif
1362 }
1363 return attr->timestamp;
1364 }
1365
1366 OS_Time
1367 __gnat_file_time_name (char *name)
1368 {
1369 struct file_attributes attr;
1370 __gnat_reset_attributes (&attr);
1371 return __gnat_file_time_name_attr (name, &attr);
1372 }
1373
1374 /* Return a GNAT time stamp given a file descriptor. */
1375
1376 OS_Time
1377 __gnat_file_time_fd_attr (int fd, struct file_attributes* attr)
1378 {
1379 if (attr->timestamp == (OS_Time)-2) {
1380 #if defined (_WIN32) && !defined (RTX)
1381 HANDLE h = (HANDLE) _get_osfhandle (fd);
1382 time_t ret = win32_filetime (h);
1383 attr->timestamp = (OS_Time) ret;
1384
1385 #else
1386 __gnat_stat_to_attr (fd, NULL, attr);
1387 #endif
1388 }
1389
1390 return attr->timestamp;
1391 }
1392
1393 OS_Time
1394 __gnat_file_time_fd (int fd)
1395 {
1396 struct file_attributes attr;
1397 __gnat_reset_attributes (&attr);
1398 return __gnat_file_time_fd_attr (fd, &attr);
1399 }
1400
1401 /* Set the file time stamp. */
1402
1403 void
1404 __gnat_set_file_time_name (char *name, time_t time_stamp)
1405 {
1406 #if defined (__vxworks)
1407
1408 /* Code to implement __gnat_set_file_time_name for these systems. */
1409
1410 #elif defined (_WIN32) && !defined (RTX)
1411 union
1412 {
1413 FILETIME ft_time;
1414 unsigned long long ull_time;
1415 } t_write;
1416 TCHAR wname[GNAT_MAX_PATH_LEN];
1417
1418 S2WSC (wname, name, GNAT_MAX_PATH_LEN);
1419
1420 HANDLE h = CreateFile
1421 (wname, GENERIC_WRITE, FILE_SHARE_WRITE, NULL,
1422 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS,
1423 NULL);
1424 if (h == INVALID_HANDLE_VALUE)
1425 return;
1426 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1427 t_write.ull_time = ((unsigned long long)time_stamp + w32_epoch_offset);
1428 /* Convert to 100 nanosecond units */
1429 t_write.ull_time *= 10000000ULL;
1430
1431 SetFileTime(h, NULL, NULL, &t_write.ft_time);
1432 CloseHandle (h);
1433 return;
1434
1435 #else
1436 struct utimbuf utimbuf;
1437 time_t t;
1438
1439 /* Set modification time to requested time. */
1440 utimbuf.modtime = time_stamp;
1441
1442 /* Set access time to now in local time. */
1443 t = time ((time_t) 0);
1444 utimbuf.actime = mktime (localtime (&t));
1445
1446 utime (name, &utimbuf);
1447 #endif
1448 }
1449
1450 /* Get the list of installed standard libraries from the
1451 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1452 key. */
1453
1454 char *
1455 __gnat_get_libraries_from_registry (void)
1456 {
1457 char *result = (char *) xmalloc (1);
1458
1459 result[0] = '\0';
1460
1461 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS) \
1462 && ! defined (RTX)
1463
1464 HKEY reg_key;
1465 DWORD name_size, value_size;
1466 char name[256];
1467 char value[256];
1468 DWORD type;
1469 DWORD index;
1470 LONG res;
1471
1472 /* First open the key. */
1473 res = RegOpenKeyExA (HKEY_LOCAL_MACHINE, "SOFTWARE", 0, KEY_READ, &reg_key);
1474
1475 if (res == ERROR_SUCCESS)
1476 res = RegOpenKeyExA (reg_key, "Ada Core Technologies", 0,
1477 KEY_READ, &reg_key);
1478
1479 if (res == ERROR_SUCCESS)
1480 res = RegOpenKeyExA (reg_key, "GNAT", 0, KEY_READ, &reg_key);
1481
1482 if (res == ERROR_SUCCESS)
1483 res = RegOpenKeyExA (reg_key, "Standard Libraries", 0, KEY_READ, &reg_key);
1484
1485 /* If the key exists, read out all the values in it and concatenate them
1486 into a path. */
1487 for (index = 0; res == ERROR_SUCCESS; index++)
1488 {
1489 value_size = name_size = 256;
1490 res = RegEnumValueA (reg_key, index, name, &name_size, 0,
1491 &type, (LPBYTE)value, &value_size);
1492
1493 if (res == ERROR_SUCCESS && type == REG_SZ)
1494 {
1495 char *old_result = result;
1496
1497 result = (char *) xmalloc (strlen (old_result) + value_size + 2);
1498 strcpy (result, old_result);
1499 strcat (result, value);
1500 strcat (result, ";");
1501 free (old_result);
1502 }
1503 }
1504
1505 /* Remove the trailing ";". */
1506 if (result[0] != 0)
1507 result[strlen (result) - 1] = 0;
1508
1509 #endif
1510 return result;
1511 }
1512
1513 /* Query information for the given file NAME and return it in STATBUF.
1514 * Returns 0 for success, or errno value for failure.
1515 */
1516 int
1517 __gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf)
1518 {
1519 #ifdef __MINGW32__
1520 WIN32_FILE_ATTRIBUTE_DATA fad;
1521 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
1522 int name_len;
1523 BOOL res;
1524 DWORD error;
1525
1526 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
1527 name_len = _tcslen (wname);
1528
1529 if (name_len > GNAT_MAX_PATH_LEN)
1530 return EINVAL;
1531
1532 ZeroMemory (statbuf, sizeof(GNAT_STRUCT_STAT));
1533
1534 res = GetFileAttributesEx (wname, GetFileExInfoStandard, &fad);
1535
1536 if (res == FALSE) {
1537 error = GetLastError();
1538
1539 /* Check file existence using GetFileAttributes() which does not fail on
1540 special Windows files like con:, aux:, nul: etc... */
1541
1542 if (GetFileAttributes(wname) != INVALID_FILE_ATTRIBUTES) {
1543 /* Just pretend that it is a regular and readable file */
1544 statbuf->st_mode = S_IFREG | S_IREAD | S_IWRITE;
1545 return 0;
1546 }
1547
1548 switch (error) {
1549 case ERROR_ACCESS_DENIED:
1550 case ERROR_SHARING_VIOLATION:
1551 case ERROR_LOCK_VIOLATION:
1552 case ERROR_SHARING_BUFFER_EXCEEDED:
1553 return EACCES;
1554 case ERROR_BUFFER_OVERFLOW:
1555 return ENAMETOOLONG;
1556 case ERROR_NOT_ENOUGH_MEMORY:
1557 return ENOMEM;
1558 default:
1559 return ENOENT;
1560 }
1561 }
1562
1563 f2t (&fad.ftCreationTime, &statbuf->st_ctime);
1564 f2t (&fad.ftLastWriteTime, &statbuf->st_mtime);
1565 f2t (&fad.ftLastAccessTime, &statbuf->st_atime);
1566
1567 statbuf->st_size =
1568 (__int64)fad.nFileSizeLow | (__int64)fad.nFileSizeHigh << 32;
1569
1570 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1571 statbuf->st_mode = S_IREAD;
1572
1573 if (fad.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY)
1574 statbuf->st_mode |= S_IFDIR;
1575 else
1576 statbuf->st_mode |= S_IFREG;
1577
1578 if (!(fad.dwFileAttributes & FILE_ATTRIBUTE_READONLY))
1579 statbuf->st_mode |= S_IWRITE;
1580
1581 return 0;
1582
1583 #else
1584 return GNAT_STAT (name, statbuf) == 0 ? 0 : errno;
1585 #endif
1586 }
1587
1588 /*************************************************************************
1589 ** Check whether a file exists
1590 *************************************************************************/
1591
1592 int
1593 __gnat_file_exists_attr (char* name, struct file_attributes* attr)
1594 {
1595 if (attr->exists == ATTR_UNSET)
1596 __gnat_stat_to_attr (-1, name, attr);
1597
1598 return attr->exists;
1599 }
1600
1601 int
1602 __gnat_file_exists (char *name)
1603 {
1604 struct file_attributes attr;
1605 __gnat_reset_attributes (&attr);
1606 return __gnat_file_exists_attr (name, &attr);
1607 }
1608
1609 /**********************************************************************
1610 ** Whether name is an absolute path
1611 **********************************************************************/
1612
1613 int
1614 __gnat_is_absolute_path (char *name, int length)
1615 {
1616 #ifdef __vxworks
1617 /* On VxWorks systems, an absolute path can be represented (depending on
1618 the host platform) as either /dir/file, or device:/dir/file, or
1619 device:drive_letter:/dir/file. */
1620
1621 int index;
1622
1623 if (name[0] == '/')
1624 return 1;
1625
1626 for (index = 0; index < length; index++)
1627 {
1628 if (name[index] == ':' &&
1629 ((name[index + 1] == '/') ||
1630 (isalpha (name[index + 1]) && index + 2 <= length &&
1631 name[index + 2] == '/')))
1632 return 1;
1633
1634 else if (name[index] == '/')
1635 return 0;
1636 }
1637 return 0;
1638 #else
1639 return (length != 0) &&
1640 (*name == '/' || *name == DIR_SEPARATOR
1641 #if defined (WINNT)
1642 || (length > 1 && ISALPHA (name[0]) && name[1] == ':')
1643 #endif
1644 );
1645 #endif
1646 }
1647
1648 int
1649 __gnat_is_regular_file_attr (char* name, struct file_attributes* attr)
1650 {
1651 if (attr->regular == ATTR_UNSET)
1652 __gnat_stat_to_attr (-1, name, attr);
1653
1654 return attr->regular;
1655 }
1656
1657 int
1658 __gnat_is_regular_file (char *name)
1659 {
1660 struct file_attributes attr;
1661
1662 __gnat_reset_attributes (&attr);
1663 return __gnat_is_regular_file_attr (name, &attr);
1664 }
1665
1666 int
1667 __gnat_is_regular_file_fd (int fd)
1668 {
1669 int ret;
1670 GNAT_STRUCT_STAT statbuf;
1671
1672 ret = GNAT_FSTAT (fd, &statbuf);
1673 return (!ret && S_ISREG (statbuf.st_mode));
1674 }
1675
1676 int
1677 __gnat_is_directory_attr (char* name, struct file_attributes* attr)
1678 {
1679 if (attr->directory == ATTR_UNSET)
1680 __gnat_stat_to_attr (-1, name, attr);
1681
1682 return attr->directory;
1683 }
1684
1685 int
1686 __gnat_is_directory (char *name)
1687 {
1688 struct file_attributes attr;
1689
1690 __gnat_reset_attributes (&attr);
1691 return __gnat_is_directory_attr (name, &attr);
1692 }
1693
1694 #if defined (_WIN32) && !defined (RTX)
1695
1696 /* Returns the same constant as GetDriveType but takes a pathname as
1697 argument. */
1698
1699 static UINT
1700 GetDriveTypeFromPath (TCHAR *wfullpath)
1701 {
1702 TCHAR wdrv[MAX_PATH];
1703 TCHAR wpath[MAX_PATH];
1704 TCHAR wfilename[MAX_PATH];
1705 TCHAR wext[MAX_PATH];
1706
1707 _tsplitpath (wfullpath, wdrv, wpath, wfilename, wext);
1708
1709 if (_tcslen (wdrv) != 0)
1710 {
1711 /* we have a drive specified. */
1712 _tcscat (wdrv, _T("\\"));
1713 return GetDriveType (wdrv);
1714 }
1715 else
1716 {
1717 /* No drive specified. */
1718
1719 /* Is this a relative path, if so get current drive type. */
1720 if (wpath[0] != _T('\\') ||
1721 (_tcslen (wpath) > 2 && wpath[0] == _T('\\')
1722 && wpath[1] != _T('\\')))
1723 return GetDriveType (NULL);
1724
1725 UINT result = GetDriveType (wpath);
1726
1727 /* Cannot guess the drive type, is this \\.\ ? */
1728
1729 if (result == DRIVE_NO_ROOT_DIR &&
1730 _tcslen (wpath) >= 4 && wpath[0] == _T('\\') && wpath[1] == _T('\\')
1731 && wpath[2] == _T('.') && wpath[3] == _T('\\'))
1732 {
1733 if (_tcslen (wpath) == 4)
1734 _tcscat (wpath, wfilename);
1735
1736 LPTSTR p = &wpath[4];
1737 LPTSTR b = _tcschr (p, _T('\\'));
1738
1739 if (b != NULL)
1740 {
1741 /* logical drive \\.\c\dir\file */
1742 *b++ = _T(':');
1743 *b++ = _T('\\');
1744 *b = _T('\0');
1745 }
1746 else
1747 _tcscat (p, _T(":\\"));
1748
1749 return GetDriveType (p);
1750 }
1751
1752 return result;
1753 }
1754 }
1755
1756 /* This MingW section contains code to work with ACL. */
1757 static int
1758 __gnat_check_OWNER_ACL (TCHAR *wname,
1759 DWORD CheckAccessDesired,
1760 GENERIC_MAPPING CheckGenericMapping)
1761 {
1762 DWORD dwAccessDesired, dwAccessAllowed;
1763 PRIVILEGE_SET PrivilegeSet;
1764 DWORD dwPrivSetSize = sizeof (PRIVILEGE_SET);
1765 BOOL fAccessGranted = FALSE;
1766 HANDLE hToken = NULL;
1767 DWORD nLength = 0;
1768 PSECURITY_DESCRIPTOR pSD = NULL;
1769
1770 GetFileSecurity
1771 (wname, OWNER_SECURITY_INFORMATION |
1772 GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION,
1773 NULL, 0, &nLength);
1774
1775 if ((pSD = (SECURITY_DESCRIPTOR *) HeapAlloc
1776 (GetProcessHeap (), HEAP_ZERO_MEMORY, nLength)) == NULL)
1777 return 0;
1778
1779 /* Obtain the security descriptor. */
1780
1781 if (!GetFileSecurity
1782 (wname, OWNER_SECURITY_INFORMATION |
1783 GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION,
1784 pSD, nLength, &nLength))
1785 goto error;
1786
1787 if (!ImpersonateSelf (SecurityImpersonation))
1788 goto error;
1789
1790 if (!OpenThreadToken
1791 (GetCurrentThread(), TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken))
1792 goto error;
1793
1794 /* Undoes the effect of ImpersonateSelf. */
1795
1796 RevertToSelf ();
1797
1798 /* We want to test for write permissions. */
1799
1800 dwAccessDesired = CheckAccessDesired;
1801
1802 MapGenericMask (&dwAccessDesired, &CheckGenericMapping);
1803
1804 if (!AccessCheck
1805 (pSD , /* security descriptor to check */
1806 hToken, /* impersonation token */
1807 dwAccessDesired, /* requested access rights */
1808 &CheckGenericMapping, /* pointer to GENERIC_MAPPING */
1809 &PrivilegeSet, /* receives privileges used in check */
1810 &dwPrivSetSize, /* size of PrivilegeSet buffer */
1811 &dwAccessAllowed, /* receives mask of allowed access rights */
1812 &fAccessGranted))
1813 goto error;
1814
1815 CloseHandle (hToken);
1816 HeapFree (GetProcessHeap (), 0, pSD);
1817 return fAccessGranted;
1818
1819 error:
1820 if (hToken)
1821 CloseHandle (hToken);
1822 HeapFree (GetProcessHeap (), 0, pSD);
1823 return 0;
1824 }
1825
1826 static void
1827 __gnat_set_OWNER_ACL (TCHAR *wname,
1828 ACCESS_MODE AccessMode,
1829 DWORD AccessPermissions)
1830 {
1831 PACL pOldDACL = NULL;
1832 PACL pNewDACL = NULL;
1833 PSECURITY_DESCRIPTOR pSD = NULL;
1834 EXPLICIT_ACCESS ea;
1835 TCHAR username [100];
1836 DWORD unsize = 100;
1837
1838 /* Get current user, he will act as the owner */
1839
1840 if (!GetUserName (username, &unsize))
1841 return;
1842
1843 if (GetNamedSecurityInfo
1844 (wname,
1845 SE_FILE_OBJECT,
1846 DACL_SECURITY_INFORMATION,
1847 NULL, NULL, &pOldDACL, NULL, &pSD) != ERROR_SUCCESS)
1848 return;
1849
1850 BuildExplicitAccessWithName
1851 (&ea, username, AccessPermissions, (ACCESS_MODE) AccessMode, NO_INHERITANCE);
1852
1853 if (AccessMode == SET_ACCESS)
1854 {
1855 /* SET_ACCESS, we want to set an explicte set of permissions, do not
1856 merge with current DACL. */
1857 if (SetEntriesInAcl (1, &ea, NULL, &pNewDACL) != ERROR_SUCCESS)
1858 return;
1859 }
1860 else
1861 if (SetEntriesInAcl (1, &ea, pOldDACL, &pNewDACL) != ERROR_SUCCESS)
1862 return;
1863
1864 if (SetNamedSecurityInfo
1865 (wname, SE_FILE_OBJECT,
1866 DACL_SECURITY_INFORMATION, NULL, NULL, pNewDACL, NULL) != ERROR_SUCCESS)
1867 return;
1868
1869 LocalFree (pSD);
1870 LocalFree (pNewDACL);
1871 }
1872
1873 /* Check if it is possible to use ACL for wname, the file must not be on a
1874 network drive. */
1875
1876 static int
1877 __gnat_can_use_acl (TCHAR *wname)
1878 {
1879 return __gnat_use_acl && GetDriveTypeFromPath (wname) != DRIVE_REMOTE;
1880 }
1881
1882 #endif /* defined (_WIN32) && !defined (RTX) */
1883
1884 int
1885 __gnat_is_readable_file_attr (char* name, struct file_attributes* attr)
1886 {
1887 if (attr->readable == ATTR_UNSET)
1888 {
1889 #if defined (_WIN32) && !defined (RTX)
1890 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
1891 GENERIC_MAPPING GenericMapping;
1892
1893 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
1894
1895 if (__gnat_can_use_acl (wname))
1896 {
1897 ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
1898 GenericMapping.GenericRead = GENERIC_READ;
1899 attr->readable =
1900 __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping);
1901 }
1902 else
1903 attr->readable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
1904 #else
1905 __gnat_stat_to_attr (-1, name, attr);
1906 #endif
1907 }
1908
1909 return attr->readable;
1910 }
1911
1912 int
1913 __gnat_is_readable_file (char *name)
1914 {
1915 struct file_attributes attr;
1916
1917 __gnat_reset_attributes (&attr);
1918 return __gnat_is_readable_file_attr (name, &attr);
1919 }
1920
1921 int
1922 __gnat_is_writable_file_attr (char* name, struct file_attributes* attr)
1923 {
1924 if (attr->writable == ATTR_UNSET)
1925 {
1926 #if defined (_WIN32) && !defined (RTX)
1927 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
1928 GENERIC_MAPPING GenericMapping;
1929
1930 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
1931
1932 if (__gnat_can_use_acl (wname))
1933 {
1934 ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
1935 GenericMapping.GenericWrite = GENERIC_WRITE;
1936
1937 attr->writable = __gnat_check_OWNER_ACL
1938 (wname, FILE_WRITE_DATA | FILE_APPEND_DATA, GenericMapping)
1939 && !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
1940 }
1941 else
1942 attr->writable =
1943 !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
1944
1945 #else
1946 __gnat_stat_to_attr (-1, name, attr);
1947 #endif
1948 }
1949
1950 return attr->writable;
1951 }
1952
1953 int
1954 __gnat_is_writable_file (char *name)
1955 {
1956 struct file_attributes attr;
1957
1958 __gnat_reset_attributes (&attr);
1959 return __gnat_is_writable_file_attr (name, &attr);
1960 }
1961
1962 int
1963 __gnat_is_executable_file_attr (char* name, struct file_attributes* attr)
1964 {
1965 if (attr->executable == ATTR_UNSET)
1966 {
1967 #if defined (_WIN32) && !defined (RTX)
1968 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
1969 GENERIC_MAPPING GenericMapping;
1970
1971 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
1972
1973 if (__gnat_can_use_acl (wname))
1974 {
1975 ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
1976 GenericMapping.GenericExecute = GENERIC_EXECUTE;
1977
1978 attr->executable =
1979 __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
1980 }
1981 else
1982 {
1983 TCHAR *l, *last = _tcsstr(wname, _T(".exe"));
1984
1985 /* look for last .exe */
1986 if (last)
1987 while ((l = _tcsstr(last+1, _T(".exe"))))
1988 last = l;
1989
1990 attr->executable =
1991 GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
1992 && (last - wname) == (int) (_tcslen (wname) - 4);
1993 }
1994 #else
1995 __gnat_stat_to_attr (-1, name, attr);
1996 #endif
1997 }
1998
1999 return attr->regular && attr->executable;
2000 }
2001
2002 int
2003 __gnat_is_executable_file (char *name)
2004 {
2005 struct file_attributes attr;
2006
2007 __gnat_reset_attributes (&attr);
2008 return __gnat_is_executable_file_attr (name, &attr);
2009 }
2010
2011 void
2012 __gnat_set_writable (char *name)
2013 {
2014 #if defined (_WIN32) && !defined (RTX)
2015 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2016
2017 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2018
2019 if (__gnat_can_use_acl (wname))
2020 __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_WRITE);
2021
2022 SetFileAttributes
2023 (wname, GetFileAttributes (wname) & ~FILE_ATTRIBUTE_READONLY);
2024 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2025 ! defined(__nucleus__)
2026 GNAT_STRUCT_STAT statbuf;
2027
2028 if (GNAT_STAT (name, &statbuf) == 0)
2029 {
2030 statbuf.st_mode = statbuf.st_mode | S_IWUSR;
2031 chmod (name, statbuf.st_mode);
2032 }
2033 #endif
2034 }
2035
2036 /* must match definition in s-os_lib.ads */
2037 #define S_OWNER 1
2038 #define S_GROUP 2
2039 #define S_OTHERS 4
2040
2041 void
2042 __gnat_set_executable (char *name, int mode ATTRIBUTE_UNUSED)
2043 {
2044 #if defined (_WIN32) && !defined (RTX)
2045 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2046
2047 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2048
2049 if (__gnat_can_use_acl (wname))
2050 __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_EXECUTE);
2051
2052 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2053 ! defined(__nucleus__)
2054 GNAT_STRUCT_STAT statbuf;
2055
2056 if (GNAT_STAT (name, &statbuf) == 0)
2057 {
2058 if (mode & S_OWNER)
2059 statbuf.st_mode = statbuf.st_mode | S_IXUSR;
2060 if (mode & S_GROUP)
2061 statbuf.st_mode = statbuf.st_mode | S_IXGRP;
2062 if (mode & S_OTHERS)
2063 statbuf.st_mode = statbuf.st_mode | S_IXOTH;
2064 chmod (name, statbuf.st_mode);
2065 }
2066 #endif
2067 }
2068
2069 void
2070 __gnat_set_non_writable (char *name)
2071 {
2072 #if defined (_WIN32) && !defined (RTX)
2073 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2074
2075 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2076
2077 if (__gnat_can_use_acl (wname))
2078 __gnat_set_OWNER_ACL
2079 (wname, DENY_ACCESS,
2080 FILE_WRITE_DATA | FILE_APPEND_DATA |
2081 FILE_WRITE_EA | FILE_WRITE_ATTRIBUTES);
2082
2083 SetFileAttributes
2084 (wname, GetFileAttributes (wname) | FILE_ATTRIBUTE_READONLY);
2085 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2086 ! defined(__nucleus__)
2087 GNAT_STRUCT_STAT statbuf;
2088
2089 if (GNAT_STAT (name, &statbuf) == 0)
2090 {
2091 statbuf.st_mode = statbuf.st_mode & 07577;
2092 chmod (name, statbuf.st_mode);
2093 }
2094 #endif
2095 }
2096
2097 void
2098 __gnat_set_readable (char *name)
2099 {
2100 #if defined (_WIN32) && !defined (RTX)
2101 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2102
2103 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2104
2105 if (__gnat_can_use_acl (wname))
2106 __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_READ);
2107
2108 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2109 ! defined(__nucleus__)
2110 GNAT_STRUCT_STAT statbuf;
2111
2112 if (GNAT_STAT (name, &statbuf) == 0)
2113 {
2114 chmod (name, statbuf.st_mode | S_IREAD);
2115 }
2116 #endif
2117 }
2118
2119 void
2120 __gnat_set_non_readable (char *name)
2121 {
2122 #if defined (_WIN32) && !defined (RTX)
2123 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2124
2125 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2126
2127 if (__gnat_can_use_acl (wname))
2128 __gnat_set_OWNER_ACL (wname, DENY_ACCESS, FILE_GENERIC_READ);
2129
2130 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2131 ! defined(__nucleus__)
2132 GNAT_STRUCT_STAT statbuf;
2133
2134 if (GNAT_STAT (name, &statbuf) == 0)
2135 {
2136 chmod (name, statbuf.st_mode & (~S_IREAD));
2137 }
2138 #endif
2139 }
2140
2141 int
2142 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED,
2143 struct file_attributes* attr)
2144 {
2145 if (attr->symbolic_link == ATTR_UNSET)
2146 {
2147 #if defined (__vxworks) || defined (__nucleus__)
2148 attr->symbolic_link = 0;
2149
2150 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2151 int ret;
2152 GNAT_STRUCT_STAT statbuf;
2153 ret = GNAT_LSTAT (name, &statbuf);
2154 attr->symbolic_link = (!ret && S_ISLNK (statbuf.st_mode));
2155 #else
2156 attr->symbolic_link = 0;
2157 #endif
2158 }
2159 return attr->symbolic_link;
2160 }
2161
2162 int
2163 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
2164 {
2165 struct file_attributes attr;
2166
2167 __gnat_reset_attributes (&attr);
2168 return __gnat_is_symbolic_link_attr (name, &attr);
2169 }
2170
2171 #if defined (sun) && defined (__SVR4)
2172 /* Using fork on Solaris will duplicate all the threads. fork1, which
2173 duplicates only the active thread, must be used instead, or spawning
2174 subprocess from a program with tasking will lead into numerous problems. */
2175 #define fork fork1
2176 #endif
2177
2178 int
2179 __gnat_portable_spawn (char *args[] ATTRIBUTE_UNUSED)
2180 {
2181 int status ATTRIBUTE_UNUSED = 0;
2182 int finished ATTRIBUTE_UNUSED;
2183 int pid ATTRIBUTE_UNUSED;
2184
2185 #if defined (__vxworks) || defined(__nucleus__) || defined(RTX) \
2186 || defined(__PikeOS__)
2187 return -1;
2188
2189 #elif defined (_WIN32)
2190 /* args[0] must be quotes as it could contain a full pathname with spaces */
2191 char *args_0 = args[0];
2192 args[0] = (char *)xmalloc (strlen (args_0) + 3);
2193 strcpy (args[0], "\"");
2194 strcat (args[0], args_0);
2195 strcat (args[0], "\"");
2196
2197 status = spawnvp (P_WAIT, args_0, (char ** const)args);
2198
2199 /* restore previous value */
2200 free (args[0]);
2201 args[0] = (char *)args_0;
2202
2203 if (status < 0)
2204 return -1;
2205 else
2206 return status;
2207
2208 #else
2209
2210 pid = fork ();
2211 if (pid < 0)
2212 return -1;
2213
2214 if (pid == 0)
2215 {
2216 /* The child. */
2217 if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
2218 _exit (1);
2219 }
2220
2221 /* The parent. */
2222 finished = waitpid (pid, &status, 0);
2223
2224 if (finished != pid || WIFEXITED (status) == 0)
2225 return -1;
2226
2227 return WEXITSTATUS (status);
2228 #endif
2229
2230 return 0;
2231 }
2232
2233 /* Create a copy of the given file descriptor.
2234 Return -1 if an error occurred. */
2235
2236 int
2237 __gnat_dup (int oldfd)
2238 {
2239 #if defined (__vxworks) && !defined (__RTP__)
2240 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2241 RTPs. */
2242 return -1;
2243 #else
2244 return dup (oldfd);
2245 #endif
2246 }
2247
2248 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2249 Return -1 if an error occurred. */
2250
2251 int
2252 __gnat_dup2 (int oldfd ATTRIBUTE_UNUSED, int newfd ATTRIBUTE_UNUSED)
2253 {
2254 #if defined (__vxworks) && !defined (__RTP__)
2255 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2256 RTPs. */
2257 return -1;
2258 #elif defined (__PikeOS__)
2259 /* Not supported. */
2260 return -1;
2261 #elif defined (_WIN32)
2262 /* Special case when oldfd and newfd are identical and are the standard
2263 input, output or error as this makes Windows XP hangs. Note that we
2264 do that only for standard file descriptors that are known to be valid. */
2265 if (oldfd == newfd && newfd >= 0 && newfd <= 2)
2266 return newfd;
2267 else
2268 return dup2 (oldfd, newfd);
2269 #else
2270 return dup2 (oldfd, newfd);
2271 #endif
2272 }
2273
2274 int
2275 __gnat_number_of_cpus (void)
2276 {
2277 int cores = 1;
2278
2279 #if defined (linux) || defined (sun) || defined (AIX) || defined (__APPLE__)
2280 cores = (int) sysconf (_SC_NPROCESSORS_ONLN);
2281
2282 #elif defined (__hpux__)
2283 struct pst_dynamic psd;
2284 if (pstat_getdynamic (&psd, sizeof (psd), 1, 0) != -1)
2285 cores = (int) psd.psd_proc_cnt;
2286
2287 #elif defined (_WIN32)
2288 SYSTEM_INFO sysinfo;
2289 GetSystemInfo (&sysinfo);
2290 cores = (int) sysinfo.dwNumberOfProcessors;
2291
2292 #elif defined (_WRS_CONFIG_SMP)
2293 unsigned int vxCpuConfiguredGet (void);
2294
2295 cores = vxCpuConfiguredGet ();
2296
2297 #endif
2298
2299 return cores;
2300 }
2301
2302 /* WIN32 code to implement a wait call that wait for any child process. */
2303
2304 #if defined (_WIN32) && !defined (RTX)
2305
2306 /* Synchronization code, to be thread safe. */
2307
2308 #ifdef CERT
2309
2310 /* For the Cert run times on native Windows we use dummy functions
2311 for locking and unlocking tasks since we do not support multiple
2312 threads on this configuration (Cert run time on native Windows). */
2313
2314 static void dummy (void)
2315 {
2316 }
2317
2318 void (*Lock_Task) () = &dummy;
2319 void (*Unlock_Task) () = &dummy;
2320
2321 #else
2322
2323 #define Lock_Task system__soft_links__lock_task
2324 extern void (*Lock_Task) (void);
2325
2326 #define Unlock_Task system__soft_links__unlock_task
2327 extern void (*Unlock_Task) (void);
2328
2329 #endif
2330
2331 static HANDLE *HANDLES_LIST = NULL;
2332 static int *PID_LIST = NULL, plist_length = 0, plist_max_length = 0;
2333
2334 static void
2335 add_handle (HANDLE h, int pid)
2336 {
2337 /* -------------------- critical section -------------------- */
2338 (*Lock_Task) ();
2339
2340 if (plist_length == plist_max_length)
2341 {
2342 plist_max_length += 100;
2343 HANDLES_LIST =
2344 (HANDLE *) xrealloc (HANDLES_LIST, sizeof (HANDLE) * plist_max_length);
2345 PID_LIST =
2346 (int *) xrealloc (PID_LIST, sizeof (int) * plist_max_length);
2347 }
2348
2349 HANDLES_LIST[plist_length] = h;
2350 PID_LIST[plist_length] = pid;
2351 ++plist_length;
2352
2353 (*Unlock_Task) ();
2354 /* -------------------- critical section -------------------- */
2355 }
2356
2357 static void
2358 remove_handle (HANDLE h, int pid)
2359 {
2360 int j;
2361
2362 for (j = 0; j < plist_length; j++)
2363 {
2364 if ((HANDLES_LIST[j] == h) || (PID_LIST[j] == pid))
2365 {
2366 CloseHandle (h);
2367 --plist_length;
2368 HANDLES_LIST[j] = HANDLES_LIST[plist_length];
2369 PID_LIST[j] = PID_LIST[plist_length];
2370 break;
2371 }
2372 }
2373 }
2374
2375 void
2376 __gnat_win32_remove_handle (HANDLE h, int pid)
2377 {
2378 /* -------------------- critical section -------------------- */
2379 (*Lock_Task) ();
2380
2381 remove_handle(h, pid);
2382
2383 (*Unlock_Task) ();
2384 /* -------------------- critical section -------------------- */
2385 }
2386
2387 static void
2388 win32_no_block_spawn (char *command, char *args[], HANDLE *h, int *pid)
2389 {
2390 BOOL result;
2391 STARTUPINFO SI;
2392 PROCESS_INFORMATION PI;
2393 SECURITY_ATTRIBUTES SA;
2394 int csize = 1;
2395 char *full_command;
2396 int k;
2397
2398 /* compute the total command line length */
2399 k = 0;
2400 while (args[k])
2401 {
2402 csize += strlen (args[k]) + 1;
2403 k++;
2404 }
2405
2406 full_command = (char *) xmalloc (csize);
2407
2408 /* Startup info. */
2409 SI.cb = sizeof (STARTUPINFO);
2410 SI.lpReserved = NULL;
2411 SI.lpReserved2 = NULL;
2412 SI.lpDesktop = NULL;
2413 SI.cbReserved2 = 0;
2414 SI.lpTitle = NULL;
2415 SI.dwFlags = 0;
2416 SI.wShowWindow = SW_HIDE;
2417
2418 /* Security attributes. */
2419 SA.nLength = sizeof (SECURITY_ATTRIBUTES);
2420 SA.bInheritHandle = TRUE;
2421 SA.lpSecurityDescriptor = NULL;
2422
2423 /* Prepare the command string. */
2424 strcpy (full_command, command);
2425 strcat (full_command, " ");
2426
2427 k = 1;
2428 while (args[k])
2429 {
2430 strcat (full_command, args[k]);
2431 strcat (full_command, " ");
2432 k++;
2433 }
2434
2435 {
2436 int wsize = csize * 2;
2437 TCHAR *wcommand = (TCHAR *) xmalloc (wsize);
2438
2439 S2WSC (wcommand, full_command, wsize);
2440
2441 free (full_command);
2442
2443 result = CreateProcess
2444 (NULL, wcommand, &SA, NULL, TRUE,
2445 GetPriorityClass (GetCurrentProcess()), NULL, NULL, &SI, &PI);
2446
2447 free (wcommand);
2448 }
2449
2450 if (result == TRUE)
2451 {
2452 CloseHandle (PI.hThread);
2453 *h = PI.hProcess;
2454 *pid = PI.dwProcessId;
2455 }
2456 else
2457 {
2458 *h = NULL;
2459 *pid = 0;
2460 }
2461 }
2462
2463 static int
2464 win32_wait (int *status)
2465 {
2466 DWORD exitcode, pid;
2467 HANDLE *hl;
2468 HANDLE h;
2469 DWORD res;
2470 int hl_len;
2471
2472 /* -------------------- critical section -------------------- */
2473 (*Lock_Task) ();
2474
2475 if (plist_length == 0)
2476 {
2477 errno = ECHILD;
2478 (*Unlock_Task) ();
2479 return -1;
2480 }
2481
2482 hl_len = plist_length;
2483
2484 hl = (HANDLE *) xmalloc (sizeof (HANDLE) * hl_len);
2485
2486 memmove (hl, HANDLES_LIST, sizeof (HANDLE) * hl_len);
2487
2488 res = WaitForMultipleObjects (hl_len, hl, FALSE, INFINITE);
2489 h = hl[res - WAIT_OBJECT_0];
2490
2491 GetExitCodeProcess (h, &exitcode);
2492 pid = PID_LIST [res - WAIT_OBJECT_0];
2493 remove_handle (h, -1);
2494
2495 (*Unlock_Task) ();
2496 /* -------------------- critical section -------------------- */
2497 free (hl);
2498
2499 *status = (int) exitcode;
2500 return (int) pid;
2501 }
2502
2503 #endif
2504
2505 int
2506 __gnat_portable_no_block_spawn (char *args[] ATTRIBUTE_UNUSED)
2507 {
2508
2509 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX) \
2510 || defined (__PikeOS__)
2511 /* Not supported. */
2512 return -1;
2513
2514 #elif defined (_WIN32)
2515
2516 HANDLE h = NULL;
2517 int pid;
2518
2519 win32_no_block_spawn (args[0], args, &h, &pid);
2520 if (h != NULL)
2521 {
2522 add_handle (h, pid);
2523 return pid;
2524 }
2525 else
2526 return -1;
2527
2528 #else
2529
2530 int pid = fork ();
2531
2532 if (pid == 0)
2533 {
2534 /* The child. */
2535 if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
2536 _exit (1);
2537 }
2538
2539 return pid;
2540
2541 #endif
2542 }
2543
2544 int
2545 __gnat_portable_wait (int *process_status)
2546 {
2547 int status = 0;
2548 int pid = 0;
2549
2550 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX) \
2551 || defined (__PikeOS__)
2552 /* Not sure what to do here, so do nothing but return zero. */
2553
2554 #elif defined (_WIN32)
2555
2556 pid = win32_wait (&status);
2557
2558 #else
2559
2560 pid = waitpid (-1, &status, 0);
2561 status = status & 0xffff;
2562 #endif
2563
2564 *process_status = status;
2565 return pid;
2566 }
2567
2568 void
2569 __gnat_os_exit (int status)
2570 {
2571 exit (status);
2572 }
2573
2574 /* Locate file on path, that matches a predicate */
2575
2576 char *
2577 __gnat_locate_file_with_predicate (char *file_name, char *path_val,
2578 int (*predicate)(char *))
2579 {
2580 char *ptr;
2581 char *file_path = (char *) alloca (strlen (file_name) + 1);
2582 int absolute;
2583
2584 /* Return immediately if file_name is empty */
2585
2586 if (*file_name == '\0')
2587 return 0;
2588
2589 /* Remove quotes around file_name if present */
2590
2591 ptr = file_name;
2592 if (*ptr == '"')
2593 ptr++;
2594
2595 strcpy (file_path, ptr);
2596
2597 ptr = file_path + strlen (file_path) - 1;
2598
2599 if (*ptr == '"')
2600 *ptr = '\0';
2601
2602 /* Handle absolute pathnames. */
2603
2604 absolute = __gnat_is_absolute_path (file_path, strlen (file_name));
2605
2606 if (absolute)
2607 {
2608 if (predicate (file_path))
2609 return xstrdup (file_path);
2610
2611 return 0;
2612 }
2613
2614 /* If file_name include directory separator(s), try it first as
2615 a path name relative to the current directory */
2616 for (ptr = file_name; *ptr && *ptr != '/' && *ptr != DIR_SEPARATOR; ptr++)
2617 ;
2618
2619 if (*ptr != 0)
2620 {
2621 if (predicate (file_name))
2622 return xstrdup (file_name);
2623 }
2624
2625 if (path_val == 0)
2626 return 0;
2627
2628 {
2629 /* The result has to be smaller than path_val + file_name. */
2630 char *file_path =
2631 (char *) alloca (strlen (path_val) + strlen (file_name) + 2);
2632
2633 for (;;)
2634 {
2635 /* Skip the starting quote */
2636
2637 if (*path_val == '"')
2638 path_val++;
2639
2640 for (ptr = file_path; *path_val && *path_val != PATH_SEPARATOR; )
2641 *ptr++ = *path_val++;
2642
2643 /* If directory is empty, it is the current directory*/
2644
2645 if (ptr == file_path)
2646 {
2647 *ptr = '.';
2648 }
2649 else
2650 ptr--;
2651
2652 /* Skip the ending quote */
2653
2654 if (*ptr == '"')
2655 ptr--;
2656
2657 if (*ptr != '/' && *ptr != DIR_SEPARATOR)
2658 *++ptr = DIR_SEPARATOR;
2659
2660 strcpy (++ptr, file_name);
2661
2662 if (predicate (file_path))
2663 return xstrdup (file_path);
2664
2665 if (*path_val == 0)
2666 return 0;
2667
2668 /* Skip path separator */
2669
2670 path_val++;
2671 }
2672 }
2673
2674 return 0;
2675 }
2676
2677 /* Locate an executable file, give a Path value. */
2678
2679 char *
2680 __gnat_locate_executable_file (char *file_name, char *path_val)
2681 {
2682 return __gnat_locate_file_with_predicate
2683 (file_name, path_val, &__gnat_is_executable_file);
2684 }
2685
2686 /* Locate a regular file, give a Path value. */
2687
2688 char *
2689 __gnat_locate_regular_file (char *file_name, char *path_val)
2690 {
2691 return __gnat_locate_file_with_predicate
2692 (file_name, path_val, &__gnat_is_regular_file);
2693 }
2694
2695 /* Locate an executable given a Path argument. This routine is only used by
2696 gnatbl and should not be used otherwise. Use locate_exec_on_path
2697 instead. */
2698
2699 char *
2700 __gnat_locate_exec (char *exec_name, char *path_val)
2701 {
2702 char *ptr;
2703 if (!strstr (exec_name, HOST_EXECUTABLE_SUFFIX))
2704 {
2705 char *full_exec_name =
2706 (char *) alloca
2707 (strlen (exec_name) + strlen (HOST_EXECUTABLE_SUFFIX) + 1);
2708
2709 strcpy (full_exec_name, exec_name);
2710 strcat (full_exec_name, HOST_EXECUTABLE_SUFFIX);
2711 ptr = __gnat_locate_executable_file (full_exec_name, path_val);
2712
2713 if (ptr == 0)
2714 return __gnat_locate_executable_file (exec_name, path_val);
2715 return ptr;
2716 }
2717 else
2718 return __gnat_locate_executable_file (exec_name, path_val);
2719 }
2720
2721 /* Locate an executable using the Systems default PATH. */
2722
2723 char *
2724 __gnat_locate_exec_on_path (char *exec_name)
2725 {
2726 char *apath_val;
2727
2728 #if defined (_WIN32) && !defined (RTX)
2729 TCHAR *wpath_val = _tgetenv (_T("PATH"));
2730 TCHAR *wapath_val;
2731 /* In Win32 systems we expand the PATH as for XP environment
2732 variables are not automatically expanded. We also prepend the
2733 ".;" to the path to match normal NT path search semantics */
2734
2735 #define EXPAND_BUFFER_SIZE 32767
2736
2737 wapath_val = (TCHAR *) alloca (EXPAND_BUFFER_SIZE);
2738
2739 wapath_val [0] = '.';
2740 wapath_val [1] = ';';
2741
2742 DWORD res = ExpandEnvironmentStrings
2743 (wpath_val, &wapath_val[2], EXPAND_BUFFER_SIZE - 2);
2744
2745 if (!res) wapath_val [0] = _T('\0');
2746
2747 apath_val = (char *) alloca (EXPAND_BUFFER_SIZE);
2748
2749 WS2SC (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
2750 return __gnat_locate_exec (exec_name, apath_val);
2751
2752 #else
2753 char *path_val = getenv ("PATH");
2754
2755 if (path_val == NULL) return NULL;
2756 apath_val = (char *) alloca (strlen (path_val) + 1);
2757 strcpy (apath_val, path_val);
2758 return __gnat_locate_exec (exec_name, apath_val);
2759 #endif
2760 }
2761
2762 /* Dummy functions for Osint import for non-VMS systems.
2763 ??? To be removed. */
2764
2765 int
2766 __gnat_to_canonical_file_list_init (char *dirspec ATTRIBUTE_UNUSED,
2767 int onlydirs ATTRIBUTE_UNUSED)
2768 {
2769 return 0;
2770 }
2771
2772 char *
2773 __gnat_to_canonical_file_list_next (void)
2774 {
2775 static char empty[] = "";
2776 return empty;
2777 }
2778
2779 void
2780 __gnat_to_canonical_file_list_free (void)
2781 {
2782 }
2783
2784 char *
2785 __gnat_to_canonical_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
2786 {
2787 return dirspec;
2788 }
2789
2790 char *
2791 __gnat_to_canonical_file_spec (char *filespec)
2792 {
2793 return filespec;
2794 }
2795
2796 char *
2797 __gnat_to_canonical_path_spec (char *pathspec)
2798 {
2799 return pathspec;
2800 }
2801
2802 char *
2803 __gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
2804 {
2805 return dirspec;
2806 }
2807
2808 char *
2809 __gnat_to_host_file_spec (char *filespec)
2810 {
2811 return filespec;
2812 }
2813
2814 void
2815 __gnat_adjust_os_resource_limits (void)
2816 {
2817 }
2818
2819 #if defined (__mips_vxworks)
2820 int
2821 _flush_cache (void)
2822 {
2823 CACHE_USER_FLUSH (0, ENTIRE_CACHE);
2824 }
2825 #endif
2826
2827 #if defined (_WIN32)
2828 int __gnat_argument_needs_quote = 1;
2829 #else
2830 int __gnat_argument_needs_quote = 0;
2831 #endif
2832
2833 /* This option is used to enable/disable object files handling from the
2834 binder file by the GNAT Project module. For example, this is disabled on
2835 Windows (prior to GCC 3.4) as it is already done by the mdll module.
2836 Stating with GCC 3.4 the shared libraries are not based on mdll
2837 anymore as it uses the GCC's -shared option */
2838 #if defined (_WIN32) \
2839 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
2840 int __gnat_prj_add_obj_files = 0;
2841 #else
2842 int __gnat_prj_add_obj_files = 1;
2843 #endif
2844
2845 /* char used as prefix/suffix for environment variables */
2846 #if defined (_WIN32)
2847 char __gnat_environment_char = '%';
2848 #else
2849 char __gnat_environment_char = '$';
2850 #endif
2851
2852 /* This functions copy the file attributes from a source file to a
2853 destination file.
2854
2855 mode = 0 : In this mode copy only the file time stamps (last access and
2856 last modification time stamps).
2857
2858 mode = 1 : In this mode, time stamps and read/write/execute attributes are
2859 copied.
2860
2861 Returns 0 if operation was successful and -1 in case of error. */
2862
2863 int
2864 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED, char *to ATTRIBUTE_UNUSED,
2865 int mode ATTRIBUTE_UNUSED)
2866 {
2867 #if (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) || \
2868 defined (__nucleus__)
2869 return -1;
2870
2871 #elif defined (_WIN32) && !defined (RTX)
2872 TCHAR wfrom [GNAT_MAX_PATH_LEN + 2];
2873 TCHAR wto [GNAT_MAX_PATH_LEN + 2];
2874 BOOL res;
2875 FILETIME fct, flat, flwt;
2876 HANDLE hfrom, hto;
2877
2878 S2WSC (wfrom, from, GNAT_MAX_PATH_LEN + 2);
2879 S2WSC (wto, to, GNAT_MAX_PATH_LEN + 2);
2880
2881 /* retrieve from times */
2882
2883 hfrom = CreateFile
2884 (wfrom, GENERIC_READ, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
2885
2886 if (hfrom == INVALID_HANDLE_VALUE)
2887 return -1;
2888
2889 res = GetFileTime (hfrom, &fct, &flat, &flwt);
2890
2891 CloseHandle (hfrom);
2892
2893 if (res == 0)
2894 return -1;
2895
2896 /* retrieve from times */
2897
2898 hto = CreateFile
2899 (wto, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
2900
2901 if (hto == INVALID_HANDLE_VALUE)
2902 return -1;
2903
2904 res = SetFileTime (hto, NULL, &flat, &flwt);
2905
2906 CloseHandle (hto);
2907
2908 if (res == 0)
2909 return -1;
2910
2911 /* Set file attributes in full mode. */
2912
2913 if (mode == 1)
2914 {
2915 DWORD attribs = GetFileAttributes (wfrom);
2916
2917 if (attribs == INVALID_FILE_ATTRIBUTES)
2918 return -1;
2919
2920 res = SetFileAttributes (wto, attribs);
2921 if (res == 0)
2922 return -1;
2923 }
2924
2925 return 0;
2926
2927 #else
2928 GNAT_STRUCT_STAT fbuf;
2929 struct utimbuf tbuf;
2930
2931 if (GNAT_STAT (from, &fbuf) == -1)
2932 {
2933 return -1;
2934 }
2935
2936 tbuf.actime = fbuf.st_atime;
2937 tbuf.modtime = fbuf.st_mtime;
2938
2939 if (utime (to, &tbuf) == -1)
2940 {
2941 return -1;
2942 }
2943
2944 if (mode == 1)
2945 {
2946 if (chmod (to, fbuf.st_mode) == -1)
2947 {
2948 return -1;
2949 }
2950 }
2951
2952 return 0;
2953 #endif
2954 }
2955
2956 int
2957 __gnat_lseek (int fd, long offset, int whence)
2958 {
2959 return (int) lseek (fd, offset, whence);
2960 }
2961
2962 /* This function returns the major version number of GCC being used. */
2963 int
2964 get_gcc_version (void)
2965 {
2966 #ifdef IN_RTS
2967 return __GNUC__;
2968 #else
2969 return (int) (version_string[0] - '0');
2970 #endif
2971 }
2972
2973 /*
2974 * Set Close_On_Exec as indicated.
2975 * Note: this is used for both GNAT.OS_Lib and GNAT.Sockets.
2976 */
2977
2978 int
2979 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED,
2980 int close_on_exec_p ATTRIBUTE_UNUSED)
2981 {
2982 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
2983 int flags = fcntl (fd, F_GETFD, 0);
2984 if (flags < 0)
2985 return flags;
2986 if (close_on_exec_p)
2987 flags |= FD_CLOEXEC;
2988 else
2989 flags &= ~FD_CLOEXEC;
2990 return fcntl (fd, F_SETFD, flags);
2991 #elif defined(_WIN32)
2992 HANDLE h = (HANDLE) _get_osfhandle (fd);
2993 if (h == (HANDLE) -1)
2994 return -1;
2995 if (close_on_exec_p)
2996 return ! SetHandleInformation (h, HANDLE_FLAG_INHERIT, 0);
2997 return ! SetHandleInformation (h, HANDLE_FLAG_INHERIT,
2998 HANDLE_FLAG_INHERIT);
2999 #else
3000 /* TODO: Unimplemented. */
3001 return -1;
3002 #endif
3003 }
3004
3005 /* Indicates if platforms supports automatic initialization through the
3006 constructor mechanism */
3007 int
3008 __gnat_binder_supports_auto_init (void)
3009 {
3010 return 1;
3011 }
3012
3013 /* Indicates that Stand-Alone Libraries are automatically initialized through
3014 the constructor mechanism */
3015 int
3016 __gnat_sals_init_using_constructors (void)
3017 {
3018 #if defined (__vxworks) || defined (__Lynx__)
3019 return 0;
3020 #else
3021 return 1;
3022 #endif
3023 }
3024
3025 #ifdef RTX
3026
3027 /* In RTX mode, the procedure to get the time (as file time) is different
3028 in RTSS mode and Win32 mode. In order to avoid duplicating an Ada file,
3029 we introduce an intermediate procedure to link against the corresponding
3030 one in each situation. */
3031
3032 extern void GetTimeAsFileTime (LPFILETIME pTime);
3033
3034 void GetTimeAsFileTime (LPFILETIME pTime)
3035 {
3036 #ifdef RTSS
3037 RtGetRtssTimeAsFileTime (pTime); /* RTSS interface */
3038 #else
3039 GetSystemTimeAsFileTime (pTime); /* w32 interface */
3040 #endif
3041 }
3042
3043 #ifdef RTSS
3044 /* Add symbol that is required to link. It would otherwise be taken from
3045 libgcc.a and it would try to use the gcc constructors that are not
3046 supported by Microsoft linker. */
3047
3048 extern void __main (void);
3049
3050 void __main (void)
3051 {
3052 }
3053 #endif /* RTSS */
3054 #endif /* RTX */
3055
3056 #if defined (__ANDROID__)
3057
3058 #include <pthread.h>
3059
3060 void *
3061 __gnat_lwp_self (void)
3062 {
3063 return (void *) pthread_self ();
3064 }
3065
3066 #elif defined (linux)
3067 /* There is no function in the glibc to retrieve the LWP of the current
3068 thread. We need to do a system call in order to retrieve this
3069 information. */
3070 #include <sys/syscall.h>
3071 void *
3072 __gnat_lwp_self (void)
3073 {
3074 return (void *) syscall (__NR_gettid);
3075 }
3076
3077 #include <sched.h>
3078
3079 /* glibc versions earlier than 2.7 do not define the routines to handle
3080 dynamically allocated CPU sets. For these targets, we use the static
3081 versions. */
3082
3083 #ifdef CPU_ALLOC
3084
3085 /* Dynamic cpu sets */
3086
3087 cpu_set_t *
3088 __gnat_cpu_alloc (size_t count)
3089 {
3090 return CPU_ALLOC (count);
3091 }
3092
3093 size_t
3094 __gnat_cpu_alloc_size (size_t count)
3095 {
3096 return CPU_ALLOC_SIZE (count);
3097 }
3098
3099 void
3100 __gnat_cpu_free (cpu_set_t *set)
3101 {
3102 CPU_FREE (set);
3103 }
3104
3105 void
3106 __gnat_cpu_zero (size_t count, cpu_set_t *set)
3107 {
3108 CPU_ZERO_S (count, set);
3109 }
3110
3111 void
3112 __gnat_cpu_set (int cpu, size_t count, cpu_set_t *set)
3113 {
3114 /* Ada handles CPU numbers starting from 1, while C identifies the first
3115 CPU by a 0, so we need to adjust. */
3116 CPU_SET_S (cpu - 1, count, set);
3117 }
3118
3119 #else /* !CPU_ALLOC */
3120
3121 /* Static cpu sets */
3122
3123 cpu_set_t *
3124 __gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED)
3125 {
3126 return (cpu_set_t *) xmalloc (sizeof (cpu_set_t));
3127 }
3128
3129 size_t
3130 __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED)
3131 {
3132 return sizeof (cpu_set_t);
3133 }
3134
3135 void
3136 __gnat_cpu_free (cpu_set_t *set)
3137 {
3138 free (set);
3139 }
3140
3141 void
3142 __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
3143 {
3144 CPU_ZERO (set);
3145 }
3146
3147 void
3148 __gnat_cpu_set (int cpu, size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
3149 {
3150 /* Ada handles CPU numbers starting from 1, while C identifies the first
3151 CPU by a 0, so we need to adjust. */
3152 CPU_SET (cpu - 1, set);
3153 }
3154 #endif /* !CPU_ALLOC */
3155 #endif /* linux */
3156
3157 /* Return the load address of the executable, or 0 if not known. In the
3158 specific case of error, (void *)-1 can be returned. Beware: this unit may
3159 be in a shared library. As low-level units are needed, we allow #include
3160 here. */
3161
3162 #if defined (__APPLE__)
3163 #include <mach-o/dyld.h>
3164 #elif 0 && defined (__linux__)
3165 #include <link.h>
3166 #endif
3167
3168 const void *
3169 __gnat_get_executable_load_address (void)
3170 {
3171 #if defined (__APPLE__)
3172 return _dyld_get_image_header (0);
3173
3174 #elif 0 && defined (__linux__)
3175 /* Currently disabled as it needs at least -ldl. */
3176 struct link_map *map = _r_debug.r_map;
3177
3178 return (const void *)map->l_addr;
3179
3180 #else
3181 return NULL;
3182 #endif
3183 }
3184
3185 #ifdef __cplusplus
3186 }
3187 #endif