1 /****************************************************************************
2 * *
3 * GNAT COMPILER COMPONENTS *
4 * *
5 * A D A I N T *
6 * *
7 * C Implementation File *
8 * *
9 * Copyright (C) 1992-2012, 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 #ifdef __vxworks
38
39 /* No need to redefine exit here. */
40 #undef exit
41
42 /* We want to use the POSIX variants of include files. */
43 #define POSIX
44 #include "vxWorks.h"
45
46 #if defined (__mips_vxworks)
47 #include "cacheLib.h"
48 #endif /* __mips_vxworks */
49
50 /* If SMP, access vxCpuConfiguredGet */
51 #ifdef _WRS_CONFIG_SMP
52 #include <vxCpuLib.h>
53 #endif /* _WRS_CONFIG_SMP */
54
55 /* We need to know the VxWorks version because some file operations
56 (such as chmod) are only available on VxWorks 6. */
57 #include "version.h"
58
59 #endif /* VxWorks */
60
61 #if defined (__APPLE__)
62 #include <unistd.h>
63 #endif
64
65 #if defined (__hpux__)
66 #include <sys/param.h>
67 #include <sys/pstat.h>
68 #endif
69
70 #ifdef VMS
71 #define _POSIX_EXIT 1
72 #define HOST_EXECUTABLE_SUFFIX ".exe"
73 #define HOST_OBJECT_SUFFIX ".obj"
74 #endif
75
76 #ifdef IN_RTS
77 #include "tconfig.h"
78 #include "tsystem.h"
79 #include <sys/stat.h>
80 #include <fcntl.h>
81 #include <time.h>
82 #ifdef VMS
83 #include <unixio.h>
84 #endif
85
86 #if defined (__vxworks) || defined (__ANDROID__)
87 /* S_IREAD and S_IWRITE are not defined in VxWorks or Android */
88 #ifndef S_IREAD
89 #define S_IREAD (S_IRUSR | S_IRGRP | S_IROTH)
90 #endif
91
92 #ifndef S_IWRITE
93 #define S_IWRITE (S_IWUSR)
94 #endif
95 #endif
96
97 /* We don't have libiberty, so use malloc. */
98 #define xmalloc(S) malloc (S)
99 #define xrealloc(V,S) realloc (V,S)
100 #else
101 #include "config.h"
102 #include "system.h"
103 #include "version.h"
104 #endif
105
106 #ifdef __cplusplus
107 extern "C" {
108 #endif
109
110 #if defined (__MINGW32__)
111
112 #if defined (RTX)
113 #include <windows.h>
114 #include <Rtapi.h>
115 #else
116 #include "mingw32.h"
117
118 /* Current code page to use, set in initialize.c. */
119 UINT CurrentCodePage;
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 #elif !defined (VMS)
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__)
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 #elif defined (VMS)
169
170 /* Header files and definitions for __gnat_set_file_time_name. */
171
172 #define __NEW_STARLET 1
173 #include <vms/rms.h>
174 #include <vms/atrdef.h>
175 #include <vms/fibdef.h>
176 #include <vms/stsdef.h>
177 #include <vms/iodef.h>
178 #include <errno.h>
179 #include <vms/descrip.h>
180 #include <string.h>
181 #include <unixlib.h>
182
183 /* Use native 64-bit arithmetic. */
184 #define unix_time_to_vms(X,Y) \
185 { unsigned long long reftime, tmptime = (X); \
186 $DESCRIPTOR (unixtime,"1-JAN-1970 0:00:00.00"); \
187 SYS$BINTIM (&unixtime, &reftime); \
188 Y = tmptime * 10000000 + reftime; }
189
190 /* descrip.h doesn't have everything ... */
191 typedef struct fibdef* __fibdef_ptr32 __attribute__ (( mode (SI) ));
192 struct dsc$descriptor_fib
193 {
194 unsigned int fib$l_len;
195 __fibdef_ptr32 fib$l_addr;
196 };
197
198 /* I/O Status Block. */
199 struct IOSB
200 {
201 unsigned short status, count;
202 unsigned int devdep;
203 };
204
205 static char *tryfile;
206
207 /* Variable length string. */
208 struct vstring
209 {
210 short length;
211 char string[NAM$C_MAXRSS+1];
212 };
213
214 #define SYI$_ACTIVECPU_CNT 0x111e
215 extern int LIB$GETSYI (int *, unsigned int *);
216
217 #else
218 #include <utime.h>
219 #endif
220
221 #if defined (_WIN32)
222 #include <process.h>
223 #endif
224
225 #if defined (_WIN32)
226
227 #include <dir.h>
228 #include <windows.h>
229 #include <accctrl.h>
230 #include <aclapi.h>
231 #undef DIR_SEPARATOR
232 #define DIR_SEPARATOR '\\'
233 #endif
234
235 #include "adaint.h"
236
237 /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
238 defined in the current system. On DOS-like systems these flags control
239 whether the file is opened/created in text-translation mode (CR/LF in
240 external file mapped to LF in internal file), but in Unix-like systems,
241 no text translation is required, so these flags have no effect. */
242
243 #ifndef O_BINARY
244 #define O_BINARY 0
245 #endif
246
247 #ifndef O_TEXT
248 #define O_TEXT 0
249 #endif
250
251 #ifndef HOST_EXECUTABLE_SUFFIX
252 #define HOST_EXECUTABLE_SUFFIX ""
253 #endif
254
255 #ifndef HOST_OBJECT_SUFFIX
256 #define HOST_OBJECT_SUFFIX ".o"
257 #endif
258
259 #ifndef PATH_SEPARATOR
260 #define PATH_SEPARATOR ':'
261 #endif
262
263 #ifndef DIR_SEPARATOR
264 #define DIR_SEPARATOR '/'
265 #endif
266
267 /* Check for cross-compilation */
268 #if defined (CROSS_COMPILE) || defined (CROSS_DIRECTORY_STRUCTURE)
269 #define IS_CROSS 1
270 int __gnat_is_cross_compiler = 1;
271 #else
272 #undef IS_CROSS
273 int __gnat_is_cross_compiler = 0;
274 #endif
275
276 char __gnat_dir_separator = DIR_SEPARATOR;
277
278 char __gnat_path_separator = PATH_SEPARATOR;
279
280 /* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
281 the base filenames that libraries specified with -lsomelib options
282 may have. This is used by GNATMAKE to check whether an executable
283 is up-to-date or not. The syntax is
284
285 library_template ::= { pattern ; } pattern NUL
286 pattern ::= [ prefix ] * [ postfix ]
287
288 These should only specify names of static libraries as it makes
289 no sense to determine at link time if dynamic-link libraries are
290 up to date or not. Any libraries that are not found are supposed
291 to be up-to-date:
292
293 * if they are needed but not present, the link
294 will fail,
295
296 * otherwise they are libraries in the system paths and so
297 they are considered part of the system and not checked
298 for that reason.
299
300 ??? This should be part of a GNAT host-specific compiler
301 file instead of being included in all user applications
302 as well. This is only a temporary work-around for 3.11b. */
303
304 #ifndef GNAT_LIBRARY_TEMPLATE
305 #if defined (VMS)
306 #define GNAT_LIBRARY_TEMPLATE "*.olb"
307 #else
308 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
309 #endif
310 #endif
311
312 const char *__gnat_library_template = GNAT_LIBRARY_TEMPLATE;
313
314 /* This variable is used in hostparm.ads to say whether the host is a VMS
315 system. */
316 #ifdef VMS
317 int __gnat_vmsp = 1;
318 #else
319 int __gnat_vmsp = 0;
320 #endif
321
322 #if defined (VMS)
323 #define GNAT_MAX_PATH_LEN 256 /* PATH_MAX */
324
325 #elif defined (__vxworks) || defined (__OPENNT) || defined(__nucleus__)
326 #define GNAT_MAX_PATH_LEN PATH_MAX
327
328 #else
329
330 #if defined (__MINGW32__)
331 #include "mingw32.h"
332
333 #if OLD_MINGW
334 #include <sys/param.h>
335 #endif
336
337 #else
338 #include <sys/param.h>
339 #endif
340
341 #ifdef MAXPATHLEN
342 #define GNAT_MAX_PATH_LEN MAXPATHLEN
343 #else
344 #define GNAT_MAX_PATH_LEN 256
345 #endif
346
347 #endif
348
349 /* Used for Ada bindings */
350 int __gnat_size_of_file_attributes = sizeof (struct file_attributes);
351
352 void __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr);
353
354 /* The __gnat_max_path_len variable is used to export the maximum
355 length of a path name to Ada code. max_path_len is also provided
356 for compatibility with older GNAT versions, please do not use
357 it. */
358
359 int __gnat_max_path_len = GNAT_MAX_PATH_LEN;
360 int max_path_len = GNAT_MAX_PATH_LEN;
361
362 /* Control whether we can use ACL on Windows. */
363
364 int __gnat_use_acl = 1;
365
366 /* The following macro HAVE_READDIR_R should be defined if the
367 system provides the routine readdir_r. */
368 #undef HAVE_READDIR_R
369
370 #if defined(VMS) && defined (__LONG_POINTERS)
371
372 /* Return a 32 bit pointer to an array of 32 bit pointers
373 given a 64 bit pointer to an array of 64 bit pointers */
374
375 typedef __char_ptr32 *__char_ptr_char_ptr32 __attribute__ ((mode (SI)));
376
377 static __char_ptr_char_ptr32
to_ptr32(char ** ptr64)378 to_ptr32 (char **ptr64)
379 {
380 int argc;
381 __char_ptr_char_ptr32 short_argv;
382
383 for (argc=0; ptr64[argc]; argc++);
384
385 /* Reallocate argv with 32 bit pointers. */
386 short_argv = (__char_ptr_char_ptr32) decc$malloc
387 (sizeof (__char_ptr32) * (argc + 1));
388
389 for (argc=0; ptr64[argc]; argc++)
390 short_argv[argc] = (__char_ptr32) decc$strdup (ptr64[argc]);
391
392 short_argv[argc] = (__char_ptr32) 0;
393 return short_argv;
394
395 }
396 #define MAYBE_TO_PTR32(argv) to_ptr32 (argv)
397 #else
398 #define MAYBE_TO_PTR32(argv) argv
399 #endif
400
401 static const char ATTR_UNSET = 127;
402
403 /* Reset the file attributes as if no system call had been performed */
404
405 void
__gnat_reset_attributes(struct file_attributes * attr)406 __gnat_reset_attributes
407 (struct file_attributes* attr)
408 {
409 attr->exists = ATTR_UNSET;
410
411 attr->writable = ATTR_UNSET;
412 attr->readable = ATTR_UNSET;
413 attr->executable = ATTR_UNSET;
414
415 attr->regular = ATTR_UNSET;
416 attr->symbolic_link = ATTR_UNSET;
417 attr->directory = ATTR_UNSET;
418
419 attr->timestamp = (OS_Time)-2;
420 attr->file_length = -1;
421 }
422
423 OS_Time
__gnat_current_time(void)424 __gnat_current_time
425 (void)
426 {
427 time_t res = time (NULL);
428 return (OS_Time) res;
429 }
430
431 /* Return the current local time as a string in the ISO 8601 format of
432 "YYYY-MM-DD HH:MM:SS.SS". The returned string is 22 + 1 (NULL) characters
433 long. */
434
435 void
__gnat_current_time_string(char * result)436 __gnat_current_time_string
437 (char *result)
438 {
439 const char *format = "%Y-%m-%d %H:%M:%S";
440 /* Format string necessary to describe the ISO 8601 format */
441
442 const time_t t_val = time (NULL);
443
444 strftime (result, 22, format, localtime (&t_val));
445 /* Convert the local time into a string following the ISO format, copying
446 at most 22 characters into the result string. */
447
448 result [19] = '.';
449 result [20] = '0';
450 result [21] = '0';
451 /* The sub-seconds are manually set to zero since type time_t lacks the
452 precision necessary for nanoseconds. */
453 }
454
455 void
__gnat_to_gm_time(OS_Time * p_time,int * p_year,int * p_month,int * p_day,int * p_hours,int * p_mins,int * p_secs)456 __gnat_to_gm_time
457 (OS_Time *p_time,
458 int *p_year,
459 int *p_month,
460 int *p_day,
461 int *p_hours,
462 int *p_mins,
463 int *p_secs)
464 {
465 struct tm *res;
466 time_t time = (time_t) *p_time;
467
468 #ifdef _WIN32
469 /* On Windows systems, the time is sometimes rounded up to the nearest
470 even second, so if the number of seconds is odd, increment it. */
471 if (time & 1)
472 time++;
473 #endif
474
475 #ifdef VMS
476 res = localtime (&time);
477 #else
478 res = gmtime (&time);
479 #endif
480
481 if (res)
482 {
483 *p_year = res->tm_year;
484 *p_month = res->tm_mon;
485 *p_day = res->tm_mday;
486 *p_hours = res->tm_hour;
487 *p_mins = res->tm_min;
488 *p_secs = res->tm_sec;
489 }
490 else
491 *p_year = *p_month = *p_day = *p_hours = *p_mins = *p_secs = 0;
492 }
493
494 /* Place the contents of the symbolic link named PATH in the buffer BUF,
495 which has size BUFSIZ. If PATH is a symbolic link, then return the number
496 of characters of its content in BUF. Otherwise, return -1.
497 For systems not supporting symbolic links, always return -1. */
498
499 int
__gnat_readlink(char * path ATTRIBUTE_UNUSED,char * buf ATTRIBUTE_UNUSED,size_t bufsiz ATTRIBUTE_UNUSED)500 __gnat_readlink (char *path ATTRIBUTE_UNUSED,
501 char *buf ATTRIBUTE_UNUSED,
502 size_t bufsiz ATTRIBUTE_UNUSED)
503 {
504 #if defined (_WIN32) || defined (VMS) \
505 || defined(__vxworks) || defined (__nucleus__)
506 return -1;
507 #else
508 return readlink (path, buf, bufsiz);
509 #endif
510 }
511
512 /* Creates a symbolic link named NEWPATH which contains the string OLDPATH.
513 If NEWPATH exists it will NOT be overwritten.
514 For systems not supporting symbolic links, always return -1. */
515
516 int
__gnat_symlink(char * oldpath ATTRIBUTE_UNUSED,char * newpath ATTRIBUTE_UNUSED)517 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED,
518 char *newpath ATTRIBUTE_UNUSED)
519 {
520 #if defined (_WIN32) || defined (VMS) \
521 || defined(__vxworks) || defined (__nucleus__)
522 return -1;
523 #else
524 return symlink (oldpath, newpath);
525 #endif
526 }
527
528 /* Try to lock a file, return 1 if success. */
529
530 #if defined (__vxworks) || defined (__nucleus__) \
531 || defined (_WIN32) || defined (VMS)
532
533 /* Version that does not use link. */
534
535 int
__gnat_try_lock(char * dir,char * file)536 __gnat_try_lock (char *dir, char *file)
537 {
538 int fd;
539 #ifdef __MINGW32__
540 TCHAR wfull_path[GNAT_MAX_PATH_LEN];
541 TCHAR wfile[GNAT_MAX_PATH_LEN];
542 TCHAR wdir[GNAT_MAX_PATH_LEN];
543
544 S2WSC (wdir, dir, GNAT_MAX_PATH_LEN);
545 S2WSC (wfile, file, GNAT_MAX_PATH_LEN);
546
547 _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
548 fd = _topen (wfull_path, O_CREAT | O_EXCL, 0600);
549 #else
550 char full_path[256];
551
552 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
553 fd = open (full_path, O_CREAT | O_EXCL, 0600);
554 #endif
555
556 if (fd < 0)
557 return 0;
558
559 close (fd);
560 return 1;
561 }
562
563 #else
564
565 /* Version using link(), more secure over NFS. */
566 /* See TN 6913-016 for discussion ??? */
567
568 int
__gnat_try_lock(char * dir,char * file)569 __gnat_try_lock (char *dir, char *file)
570 {
571 char full_path[256];
572 char temp_file[256];
573 GNAT_STRUCT_STAT stat_result;
574 int fd;
575
576 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
577 sprintf (temp_file, "%s%cTMP-%ld-%ld",
578 dir, DIR_SEPARATOR, (long)getpid(), (long)getppid ());
579
580 /* Create the temporary file and write the process number. */
581 fd = open (temp_file, O_CREAT | O_WRONLY, 0600);
582 if (fd < 0)
583 return 0;
584
585 close (fd);
586
587 /* Link it with the new file. */
588 link (temp_file, full_path);
589
590 /* Count the references on the old one. If we have a count of two, then
591 the link did succeed. Remove the temporary file before returning. */
592 __gnat_stat (temp_file, &stat_result);
593 unlink (temp_file);
594 return stat_result.st_nlink == 2;
595 }
596 #endif
597
598 /* Return the maximum file name length. */
599
600 int
__gnat_get_maximum_file_name_length(void)601 __gnat_get_maximum_file_name_length (void)
602 {
603 #if defined (VMS)
604 if (getenv ("GNAT$EXTENDED_FILE_SPECIFICATIONS"))
605 return -1;
606 else
607 return 39;
608 #else
609 return -1;
610 #endif
611 }
612
613 /* Return nonzero if file names are case sensitive. */
614
615 static int file_names_case_sensitive_cache = -1;
616
617 int
__gnat_get_file_names_case_sensitive(void)618 __gnat_get_file_names_case_sensitive (void)
619 {
620 if (file_names_case_sensitive_cache == -1)
621 {
622 const char *sensitive = getenv ("GNAT_FILE_NAME_CASE_SENSITIVE");
623
624 if (sensitive != NULL
625 && (sensitive[0] == '0' || sensitive[0] == '1')
626 && sensitive[1] == '\0')
627 file_names_case_sensitive_cache = sensitive[0] - '0';
628 else
629 #if defined (VMS) || defined (WINNT) || defined (__APPLE__)
630 file_names_case_sensitive_cache = 0;
631 #else
632 file_names_case_sensitive_cache = 1;
633 #endif
634 }
635 return file_names_case_sensitive_cache;
636 }
637
638 /* Return nonzero if environment variables are case sensitive. */
639
640 int
__gnat_get_env_vars_case_sensitive(void)641 __gnat_get_env_vars_case_sensitive (void)
642 {
643 #if defined (VMS) || defined (WINNT)
644 return 0;
645 #else
646 return 1;
647 #endif
648 }
649
650 char
__gnat_get_default_identifier_character_set(void)651 __gnat_get_default_identifier_character_set (void)
652 {
653 return '1';
654 }
655
656 /* Return the current working directory. */
657
658 void
__gnat_get_current_dir(char * dir,int * length)659 __gnat_get_current_dir (char *dir, int *length)
660 {
661 #if defined (__MINGW32__)
662 TCHAR wdir[GNAT_MAX_PATH_LEN];
663
664 _tgetcwd (wdir, *length);
665
666 WS2SC (dir, wdir, GNAT_MAX_PATH_LEN);
667
668 #elif defined (VMS)
669 /* Force Unix style, which is what GNAT uses internally. */
670 getcwd (dir, *length, 0);
671 #else
672 getcwd (dir, *length);
673 #endif
674
675 *length = strlen (dir);
676
677 if (dir [*length - 1] != DIR_SEPARATOR)
678 {
679 dir [*length] = DIR_SEPARATOR;
680 ++(*length);
681 }
682 dir[*length] = '\0';
683 }
684
685 /* Return the suffix for object files. */
686
687 void
__gnat_get_object_suffix_ptr(int * len,const char ** value)688 __gnat_get_object_suffix_ptr (int *len, const char **value)
689 {
690 *value = HOST_OBJECT_SUFFIX;
691
692 if (*value == 0)
693 *len = 0;
694 else
695 *len = strlen (*value);
696
697 return;
698 }
699
700 /* Return the suffix for executable files. */
701
702 void
__gnat_get_executable_suffix_ptr(int * len,const char ** value)703 __gnat_get_executable_suffix_ptr (int *len, const char **value)
704 {
705 *value = HOST_EXECUTABLE_SUFFIX;
706 if (!*value)
707 *len = 0;
708 else
709 *len = strlen (*value);
710
711 return;
712 }
713
714 /* Return the suffix for debuggable files. Usually this is the same as the
715 executable extension. */
716
717 void
__gnat_get_debuggable_suffix_ptr(int * len,const char ** value)718 __gnat_get_debuggable_suffix_ptr (int *len, const char **value)
719 {
720 *value = HOST_EXECUTABLE_SUFFIX;
721
722 if (*value == 0)
723 *len = 0;
724 else
725 *len = strlen (*value);
726
727 return;
728 }
729
730 /* Returns the OS filename and corresponding encoding. */
731
732 void
__gnat_os_filename(char * filename ATTRIBUTE_UNUSED,char * w_filename ATTRIBUTE_UNUSED,char * os_name,int * o_length,char * encoding ATTRIBUTE_UNUSED,int * e_length)733 __gnat_os_filename (char *filename ATTRIBUTE_UNUSED,
734 char *w_filename ATTRIBUTE_UNUSED,
735 char *os_name, int *o_length,
736 char *encoding ATTRIBUTE_UNUSED, int *e_length)
737 {
738 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
739 WS2SC (os_name, (TCHAR *)w_filename, (DWORD)*o_length);
740 *o_length = strlen (os_name);
741 strcpy (encoding, "encoding=utf8");
742 *e_length = strlen (encoding);
743 #else
744 strcpy (os_name, filename);
745 *o_length = strlen (filename);
746 *e_length = 0;
747 #endif
748 }
749
750 /* Delete a file. */
751
752 int
__gnat_unlink(char * path)753 __gnat_unlink (char *path)
754 {
755 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
756 {
757 TCHAR wpath[GNAT_MAX_PATH_LEN];
758
759 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
760 return _tunlink (wpath);
761 }
762 #else
763 return unlink (path);
764 #endif
765 }
766
767 /* Rename a file. */
768
769 int
__gnat_rename(char * from,char * to)770 __gnat_rename (char *from, char *to)
771 {
772 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
773 {
774 TCHAR wfrom[GNAT_MAX_PATH_LEN], wto[GNAT_MAX_PATH_LEN];
775
776 S2WSC (wfrom, from, GNAT_MAX_PATH_LEN);
777 S2WSC (wto, to, GNAT_MAX_PATH_LEN);
778 return _trename (wfrom, wto);
779 }
780 #else
781 return rename (from, to);
782 #endif
783 }
784
785 /* Changing directory. */
786
787 int
__gnat_chdir(char * path)788 __gnat_chdir (char *path)
789 {
790 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
791 {
792 TCHAR wpath[GNAT_MAX_PATH_LEN];
793
794 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
795 return _tchdir (wpath);
796 }
797 #else
798 return chdir (path);
799 #endif
800 }
801
802 /* Removing a directory. */
803
804 int
__gnat_rmdir(char * path)805 __gnat_rmdir (char *path)
806 {
807 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
808 {
809 TCHAR wpath[GNAT_MAX_PATH_LEN];
810
811 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
812 return _trmdir (wpath);
813 }
814 #elif defined (VTHREADS)
815 /* rmdir not available */
816 return -1;
817 #else
818 return rmdir (path);
819 #endif
820 }
821
822 FILE *
__gnat_fopen(char * path,char * mode,int encoding ATTRIBUTE_UNUSED)823 __gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED)
824 {
825 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
826 TCHAR wpath[GNAT_MAX_PATH_LEN];
827 TCHAR wmode[10];
828
829 S2WS (wmode, mode, 10);
830
831 if (encoding == Encoding_Unspecified)
832 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
833 else if (encoding == Encoding_UTF8)
834 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
835 else
836 S2WS (wpath, path, GNAT_MAX_PATH_LEN);
837
838 return _tfopen (wpath, wmode);
839 #elif defined (VMS)
840 return decc$fopen (path, mode);
841 #else
842 return GNAT_FOPEN (path, mode);
843 #endif
844 }
845
846 FILE *
__gnat_freopen(char * path,char * mode,FILE * stream,int encoding ATTRIBUTE_UNUSED)847 __gnat_freopen (char *path,
848 char *mode,
849 FILE *stream,
850 int encoding ATTRIBUTE_UNUSED)
851 {
852 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
853 TCHAR wpath[GNAT_MAX_PATH_LEN];
854 TCHAR wmode[10];
855
856 S2WS (wmode, mode, 10);
857
858 if (encoding == Encoding_Unspecified)
859 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
860 else if (encoding == Encoding_UTF8)
861 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
862 else
863 S2WS (wpath, path, GNAT_MAX_PATH_LEN);
864
865 return _tfreopen (wpath, wmode, stream);
866 #elif defined (VMS)
867 return decc$freopen (path, mode, stream);
868 #else
869 return freopen (path, mode, stream);
870 #endif
871 }
872
873 int
__gnat_open_read(char * path,int fmode)874 __gnat_open_read (char *path, int fmode)
875 {
876 int fd;
877 int o_fmode = O_BINARY;
878
879 if (fmode)
880 o_fmode = O_TEXT;
881
882 #if defined (VMS)
883 /* Optional arguments mbc,deq,fop increase read performance. */
884 fd = open (path, O_RDONLY | o_fmode, 0444,
885 "mbc=16", "deq=64", "fop=tef");
886 #elif defined (__vxworks)
887 fd = open (path, O_RDONLY | o_fmode, 0444);
888 #elif defined (__MINGW32__)
889 {
890 TCHAR wpath[GNAT_MAX_PATH_LEN];
891
892 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
893 fd = _topen (wpath, O_RDONLY | o_fmode, 0444);
894 }
895 #else
896 fd = open (path, O_RDONLY | o_fmode);
897 #endif
898
899 return fd < 0 ? -1 : fd;
900 }
901
902 #if defined (__MINGW32__)
903 #define PERM (S_IREAD | S_IWRITE)
904 #elif defined (VMS)
905 /* Excerpt from DECC C RTL Reference Manual:
906 To create files with OpenVMS RMS default protections using the UNIX
907 system-call functions umask, mkdir, creat, and open, call mkdir, creat,
908 and open with a file-protection mode argument of 0777 in a program
909 that never specifically calls umask. These default protections include
910 correctly establishing protections based on ACLs, previous versions of
911 files, and so on. */
912 #define PERM 0777
913 #else
914 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
915 #endif
916
917 int
__gnat_open_rw(char * path,int fmode)918 __gnat_open_rw (char *path, int fmode)
919 {
920 int fd;
921 int o_fmode = O_BINARY;
922
923 if (fmode)
924 o_fmode = O_TEXT;
925
926 #if defined (VMS)
927 fd = open (path, O_RDWR | o_fmode, PERM,
928 "mbc=16", "deq=64", "fop=tef");
929 #elif defined (__MINGW32__)
930 {
931 TCHAR wpath[GNAT_MAX_PATH_LEN];
932
933 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
934 fd = _topen (wpath, O_RDWR | o_fmode, PERM);
935 }
936 #else
937 fd = open (path, O_RDWR | o_fmode, PERM);
938 #endif
939
940 return fd < 0 ? -1 : fd;
941 }
942
943 int
__gnat_open_create(char * path,int fmode)944 __gnat_open_create (char *path, int fmode)
945 {
946 int fd;
947 int o_fmode = O_BINARY;
948
949 if (fmode)
950 o_fmode = O_TEXT;
951
952 #if defined (VMS)
953 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM,
954 "mbc=16", "deq=64", "fop=tef");
955 #elif defined (__MINGW32__)
956 {
957 TCHAR wpath[GNAT_MAX_PATH_LEN];
958
959 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
960 fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
961 }
962 #else
963 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
964 #endif
965
966 return fd < 0 ? -1 : fd;
967 }
968
969 int
__gnat_create_output_file(char * path)970 __gnat_create_output_file (char *path)
971 {
972 int fd;
973 #if defined (VMS)
974 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM,
975 "rfm=stmlf", "ctx=rec", "rat=none", "rop=nlk",
976 "shr=del,get,put,upd");
977 #elif defined (__MINGW32__)
978 {
979 TCHAR wpath[GNAT_MAX_PATH_LEN];
980
981 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
982 fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
983 }
984 #else
985 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
986 #endif
987
988 return fd < 0 ? -1 : fd;
989 }
990
991 int
__gnat_create_output_file_new(char * path)992 __gnat_create_output_file_new (char *path)
993 {
994 int fd;
995 #if defined (VMS)
996 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM,
997 "rfm=stmlf", "ctx=rec", "rat=none", "rop=nlk",
998 "shr=del,get,put,upd");
999 #elif defined (__MINGW32__)
1000 {
1001 TCHAR wpath[GNAT_MAX_PATH_LEN];
1002
1003 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
1004 fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM);
1005 }
1006 #else
1007 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM);
1008 #endif
1009
1010 return fd < 0 ? -1 : fd;
1011 }
1012
1013 int
__gnat_open_append(char * path,int fmode)1014 __gnat_open_append (char *path, int fmode)
1015 {
1016 int fd;
1017 int o_fmode = O_BINARY;
1018
1019 if (fmode)
1020 o_fmode = O_TEXT;
1021
1022 #if defined (VMS)
1023 fd = open (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM,
1024 "mbc=16", "deq=64", "fop=tef");
1025 #elif defined (__MINGW32__)
1026 {
1027 TCHAR wpath[GNAT_MAX_PATH_LEN];
1028
1029 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
1030 fd = _topen (wpath, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
1031 }
1032 #else
1033 fd = open (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
1034 #endif
1035
1036 return fd < 0 ? -1 : fd;
1037 }
1038
1039 /* Open a new file. Return error (-1) if the file already exists. */
1040
1041 int
__gnat_open_new(char * path,int fmode)1042 __gnat_open_new (char *path, int fmode)
1043 {
1044 int fd;
1045 int o_fmode = O_BINARY;
1046
1047 if (fmode)
1048 o_fmode = O_TEXT;
1049
1050 #if defined (VMS)
1051 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM,
1052 "mbc=16", "deq=64", "fop=tef");
1053 #elif defined (__MINGW32__)
1054 {
1055 TCHAR wpath[GNAT_MAX_PATH_LEN];
1056
1057 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
1058 fd = _topen (wpath, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
1059 }
1060 #else
1061 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
1062 #endif
1063
1064 return fd < 0 ? -1 : fd;
1065 }
1066
1067 /* Open a new temp file. Return error (-1) if the file already exists.
1068 Special options for VMS allow the file to be shared between parent and child
1069 processes, however they really slow down output. Used in gnatchop. */
1070
1071 int
__gnat_open_new_temp(char * path,int fmode)1072 __gnat_open_new_temp (char *path, int fmode)
1073 {
1074 int fd;
1075 int o_fmode = O_BINARY;
1076
1077 strcpy (path, "GNAT-XXXXXX");
1078
1079 #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
1080 || defined (linux) || defined(__GLIBC__)) && !defined (__vxworks)
1081 return mkstemp (path);
1082 #elif defined (__Lynx__)
1083 mktemp (path);
1084 #elif defined (__nucleus__)
1085 return -1;
1086 #else
1087 if (mktemp (path) == NULL)
1088 return -1;
1089 #endif
1090
1091 if (fmode)
1092 o_fmode = O_TEXT;
1093
1094 #if defined (VMS)
1095 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM,
1096 "rfm=stmlf", "ctx=rec", "rat=none", "shr=del,get,put,upd",
1097 "mbc=16", "deq=64", "fop=tef");
1098 #else
1099 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
1100 #endif
1101
1102 return fd < 0 ? -1 : fd;
1103 }
1104
1105 /****************************************************************
1106 ** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information
1107 ** as possible from it, storing the result in a cache for later reuse
1108 ****************************************************************/
1109
1110 void
__gnat_stat_to_attr(int fd,char * name,struct file_attributes * attr)1111 __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr)
1112 {
1113 GNAT_STRUCT_STAT statbuf;
1114 int ret;
1115
1116 if (fd != -1)
1117 ret = GNAT_FSTAT (fd, &statbuf);
1118 else
1119 ret = __gnat_stat (name, &statbuf);
1120
1121 attr->regular = (!ret && S_ISREG (statbuf.st_mode));
1122 attr->directory = (!ret && S_ISDIR (statbuf.st_mode));
1123
1124 if (!attr->regular)
1125 attr->file_length = 0;
1126 else
1127 /* st_size may be 32 bits, or 64 bits which is converted to long. We
1128 don't return a useful value for files larger than 2 gigabytes in
1129 either case. */
1130 attr->file_length = statbuf.st_size; /* all systems */
1131
1132 attr->exists = !ret;
1133
1134 #if !defined (_WIN32) || defined (RTX)
1135 /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
1136 attr->readable = (!ret && (statbuf.st_mode & S_IRUSR));
1137 attr->writable = (!ret && (statbuf.st_mode & S_IWUSR));
1138 attr->executable = (!ret && (statbuf.st_mode & S_IXUSR));
1139 #endif
1140
1141 if (ret != 0) {
1142 attr->timestamp = (OS_Time)-1;
1143 } else {
1144 #ifdef VMS
1145 /* VMS has file versioning. */
1146 attr->timestamp = (OS_Time)statbuf.st_ctime;
1147 #else
1148 attr->timestamp = (OS_Time)statbuf.st_mtime;
1149 #endif
1150 }
1151 }
1152
1153 /****************************************************************
1154 ** Return the number of bytes in the specified file
1155 ****************************************************************/
1156
1157 long
__gnat_file_length_attr(int fd,char * name,struct file_attributes * attr)1158 __gnat_file_length_attr (int fd, char* name, struct file_attributes* attr)
1159 {
1160 if (attr->file_length == -1) {
1161 __gnat_stat_to_attr (fd, name, attr);
1162 }
1163
1164 return attr->file_length;
1165 }
1166
1167 long
__gnat_file_length(int fd)1168 __gnat_file_length (int fd)
1169 {
1170 struct file_attributes attr;
1171 __gnat_reset_attributes (&attr);
1172 return __gnat_file_length_attr (fd, NULL, &attr);
1173 }
1174
1175 long
__gnat_named_file_length(char * name)1176 __gnat_named_file_length (char *name)
1177 {
1178 struct file_attributes attr;
1179 __gnat_reset_attributes (&attr);
1180 return __gnat_file_length_attr (-1, name, &attr);
1181 }
1182
1183 /* Create a temporary filename and put it in string pointed to by
1184 TMP_FILENAME. */
1185
1186 void
__gnat_tmp_name(char * tmp_filename)1187 __gnat_tmp_name (char *tmp_filename)
1188 {
1189 #ifdef RTX
1190 /* Variable used to create a series of unique names */
1191 static int counter = 0;
1192
1193 /* RTX in RTSS mode does not support tempnam nor tmpnam so we emulate it */
1194 strcpy (tmp_filename, "c:\\WINDOWS\\Temp\\gnat-");
1195 sprintf (&tmp_filename[strlen (tmp_filename)], "%d\0", counter++);
1196
1197 #elif defined (__MINGW32__)
1198 {
1199 char *pname;
1200 char prefix[25];
1201
1202 /* tempnam tries to create a temporary file in directory pointed to by
1203 TMP environment variable, in c:\temp if TMP is not set, and in
1204 directory specified by P_tmpdir in stdio.h if c:\temp does not
1205 exist. The filename will be created with the prefix "gnat-". */
1206
1207 sprintf (prefix, "gnat-%d-", (int)getpid());
1208 pname = (char *) _tempnam ("c:\\temp", prefix);
1209
1210 /* if pname is NULL, the file was not created properly, the disk is full
1211 or there is no more free temporary files */
1212
1213 if (pname == NULL)
1214 *tmp_filename = '\0';
1215
1216 /* If pname start with a back slash and not path information it means that
1217 the filename is valid for the current working directory. */
1218
1219 else if (pname[0] == '\\')
1220 {
1221 strcpy (tmp_filename, ".\\");
1222 strcat (tmp_filename, pname+1);
1223 }
1224 else
1225 strcpy (tmp_filename, pname);
1226
1227 free (pname);
1228 }
1229
1230 #elif defined (linux) || defined (__FreeBSD__) || defined (__NetBSD__) \
1231 || defined (__OpenBSD__) || defined(__GLIBC__)
1232 #define MAX_SAFE_PATH 1000
1233 char *tmpdir = getenv ("TMPDIR");
1234
1235 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1236 a buffer overflow. */
1237 if (tmpdir == NULL || strlen (tmpdir) > MAX_SAFE_PATH)
1238 strcpy (tmp_filename, "/tmp/gnat-XXXXXX");
1239 else
1240 sprintf (tmp_filename, "%s/gnat-XXXXXX", tmpdir);
1241
1242 close (mkstemp(tmp_filename));
1243 #elif defined (__vxworks) && !(defined (__RTP__) || defined (VTHREADS))
1244 int index;
1245 char * pos;
1246 ushort_t t;
1247 static ushort_t seed = 0; /* used to generate unique name */
1248
1249 /* generate unique name */
1250 strcpy (tmp_filename, "tmp");
1251
1252 /* fill up the name buffer from the last position */
1253 index = 5;
1254 pos = tmp_filename + strlen (tmp_filename) + index;
1255 *pos = '\0';
1256
1257 seed++;
1258 for (t = seed; 0 <= --index; t >>= 3)
1259 *--pos = '0' + (t & 07);
1260 #else
1261 tmpnam (tmp_filename);
1262 #endif
1263 }
1264
1265 /* Open directory and returns a DIR pointer. */
1266
__gnat_opendir(char * name)1267 DIR* __gnat_opendir (char *name)
1268 {
1269 #if defined (RTX)
1270 /* Not supported in RTX */
1271
1272 return NULL;
1273
1274 #elif defined (__MINGW32__)
1275 TCHAR wname[GNAT_MAX_PATH_LEN];
1276
1277 S2WSC (wname, name, GNAT_MAX_PATH_LEN);
1278 return (DIR*)_topendir (wname);
1279
1280 #else
1281 return opendir (name);
1282 #endif
1283 }
1284
1285 /* Read the next entry in a directory. The returned string points somewhere
1286 in the buffer. */
1287
1288 char *
__gnat_readdir(DIR * dirp,char * buffer,int * len)1289 __gnat_readdir (DIR *dirp, char *buffer, int *len)
1290 {
1291 #if defined (RTX)
1292 /* Not supported in RTX */
1293
1294 return NULL;
1295
1296 #elif defined (__MINGW32__)
1297 struct _tdirent *dirent = _treaddir ((_TDIR*)dirp);
1298
1299 if (dirent != NULL)
1300 {
1301 WS2SC (buffer, dirent->d_name, GNAT_MAX_PATH_LEN);
1302 *len = strlen (buffer);
1303
1304 return buffer;
1305 }
1306 else
1307 return NULL;
1308
1309 #elif defined (HAVE_READDIR_R)
1310 /* If possible, try to use the thread-safe version. */
1311 if (readdir_r (dirp, buffer) != NULL)
1312 {
1313 *len = strlen (((struct dirent*) buffer)->d_name);
1314 return ((struct dirent*) buffer)->d_name;
1315 }
1316 else
1317 return NULL;
1318
1319 #else
1320 struct dirent *dirent = (struct dirent *) readdir (dirp);
1321
1322 if (dirent != NULL)
1323 {
1324 strcpy (buffer, dirent->d_name);
1325 *len = strlen (buffer);
1326 return buffer;
1327 }
1328 else
1329 return NULL;
1330
1331 #endif
1332 }
1333
1334 /* Close a directory entry. */
1335
__gnat_closedir(DIR * dirp)1336 int __gnat_closedir (DIR *dirp)
1337 {
1338 #if defined (RTX)
1339 /* Not supported in RTX */
1340
1341 return 0;
1342
1343 #elif defined (__MINGW32__)
1344 return _tclosedir ((_TDIR*)dirp);
1345
1346 #else
1347 return closedir (dirp);
1348 #endif
1349 }
1350
1351 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1352
1353 int
__gnat_readdir_is_thread_safe(void)1354 __gnat_readdir_is_thread_safe (void)
1355 {
1356 #ifdef HAVE_READDIR_R
1357 return 1;
1358 #else
1359 return 0;
1360 #endif
1361 }
1362
1363 #if defined (_WIN32) && !defined (RTX)
1364 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1365 static const unsigned long long w32_epoch_offset = 11644473600ULL;
1366
1367 /* Returns the file modification timestamp using Win32 routines which are
1368 immune against daylight saving time change. It is in fact not possible to
1369 use fstat for this purpose as the DST modify the st_mtime field of the
1370 stat structure. */
1371
1372 static time_t
win32_filetime(HANDLE h)1373 win32_filetime (HANDLE h)
1374 {
1375 union
1376 {
1377 FILETIME ft_time;
1378 unsigned long long ull_time;
1379 } t_write;
1380
1381 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1382 since <Jan 1st 1601>. This function must return the number of seconds
1383 since <Jan 1st 1970>. */
1384
1385 if (GetFileTime (h, NULL, NULL, &t_write.ft_time))
1386 return (time_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
1387 return (time_t) 0;
1388 }
1389
1390 /* As above but starting from a FILETIME. */
1391 static void
f2t(const FILETIME * ft,time_t * t)1392 f2t (const FILETIME *ft, time_t *t)
1393 {
1394 union
1395 {
1396 FILETIME ft_time;
1397 unsigned long long ull_time;
1398 } t_write;
1399
1400 t_write.ft_time = *ft;
1401 *t = (time_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
1402 }
1403 #endif
1404
1405 /* Return a GNAT time stamp given a file name. */
1406
1407 OS_Time
__gnat_file_time_name_attr(char * name,struct file_attributes * attr)1408 __gnat_file_time_name_attr (char* name, struct file_attributes* attr)
1409 {
1410 if (attr->timestamp == (OS_Time)-2) {
1411 #if defined (_WIN32) && !defined (RTX)
1412 BOOL res;
1413 WIN32_FILE_ATTRIBUTE_DATA fad;
1414 time_t ret = -1;
1415 TCHAR wname[GNAT_MAX_PATH_LEN];
1416 S2WSC (wname, name, GNAT_MAX_PATH_LEN);
1417
1418 if ((res = GetFileAttributesEx (wname, GetFileExInfoStandard, &fad)))
1419 f2t (&fad.ftLastWriteTime, &ret);
1420 attr->timestamp = (OS_Time) ret;
1421 #else
1422 __gnat_stat_to_attr (-1, name, attr);
1423 #endif
1424 }
1425 return attr->timestamp;
1426 }
1427
1428 OS_Time
__gnat_file_time_name(char * name)1429 __gnat_file_time_name (char *name)
1430 {
1431 struct file_attributes attr;
1432 __gnat_reset_attributes (&attr);
1433 return __gnat_file_time_name_attr (name, &attr);
1434 }
1435
1436 /* Return a GNAT time stamp given a file descriptor. */
1437
1438 OS_Time
__gnat_file_time_fd_attr(int fd,struct file_attributes * attr)1439 __gnat_file_time_fd_attr (int fd, struct file_attributes* attr)
1440 {
1441 if (attr->timestamp == (OS_Time)-2) {
1442 #if defined (_WIN32) && !defined (RTX)
1443 HANDLE h = (HANDLE) _get_osfhandle (fd);
1444 time_t ret = win32_filetime (h);
1445 attr->timestamp = (OS_Time) ret;
1446
1447 #else
1448 __gnat_stat_to_attr (fd, NULL, attr);
1449 #endif
1450 }
1451
1452 return attr->timestamp;
1453 }
1454
1455 OS_Time
__gnat_file_time_fd(int fd)1456 __gnat_file_time_fd (int fd)
1457 {
1458 struct file_attributes attr;
1459 __gnat_reset_attributes (&attr);
1460 return __gnat_file_time_fd_attr (fd, &attr);
1461 }
1462
1463 /* Set the file time stamp. */
1464
1465 void
__gnat_set_file_time_name(char * name,time_t time_stamp)1466 __gnat_set_file_time_name (char *name, time_t time_stamp)
1467 {
1468 #if defined (__vxworks)
1469
1470 /* Code to implement __gnat_set_file_time_name for these systems. */
1471
1472 #elif defined (_WIN32) && !defined (RTX)
1473 union
1474 {
1475 FILETIME ft_time;
1476 unsigned long long ull_time;
1477 } t_write;
1478 TCHAR wname[GNAT_MAX_PATH_LEN];
1479
1480 S2WSC (wname, name, GNAT_MAX_PATH_LEN);
1481
1482 HANDLE h = CreateFile
1483 (wname, GENERIC_WRITE, FILE_SHARE_WRITE, NULL,
1484 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS,
1485 NULL);
1486 if (h == INVALID_HANDLE_VALUE)
1487 return;
1488 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1489 t_write.ull_time = ((unsigned long long)time_stamp + w32_epoch_offset);
1490 /* Convert to 100 nanosecond units */
1491 t_write.ull_time *= 10000000ULL;
1492
1493 SetFileTime(h, NULL, NULL, &t_write.ft_time);
1494 CloseHandle (h);
1495 return;
1496
1497 #elif defined (VMS)
1498 struct FAB fab;
1499 struct NAM nam;
1500
1501 struct
1502 {
1503 unsigned long long backup, create, expire, revise;
1504 unsigned int uic;
1505 union
1506 {
1507 unsigned short value;
1508 struct
1509 {
1510 unsigned system : 4;
1511 unsigned owner : 4;
1512 unsigned group : 4;
1513 unsigned world : 4;
1514 } bits;
1515 } prot;
1516 } Fat = { 0, 0, 0, 0, 0, { 0 }};
1517
1518 ATRDEF atrlst[]
1519 = {
1520 { ATR$S_CREDATE, ATR$C_CREDATE, &Fat.create },
1521 { ATR$S_REVDATE, ATR$C_REVDATE, &Fat.revise },
1522 { ATR$S_EXPDATE, ATR$C_EXPDATE, &Fat.expire },
1523 { ATR$S_BAKDATE, ATR$C_BAKDATE, &Fat.backup },
1524 { ATR$S_FPRO, ATR$C_FPRO, &Fat.prot },
1525 { ATR$S_UIC, ATR$C_UIC, &Fat.uic },
1526 { 0, 0, 0}
1527 };
1528
1529 FIBDEF fib;
1530 struct dsc$descriptor_fib fibdsc = {sizeof (fib), (void *) &fib};
1531
1532 struct IOSB iosb;
1533
1534 unsigned long long newtime;
1535 unsigned long long revtime;
1536 long status;
1537 short chan;
1538
1539 struct vstring file;
1540 struct dsc$descriptor_s filedsc
1541 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) file.string};
1542 struct vstring device;
1543 struct dsc$descriptor_s devicedsc
1544 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) device.string};
1545 struct vstring timev;
1546 struct dsc$descriptor_s timedsc
1547 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) timev.string};
1548 struct vstring result;
1549 struct dsc$descriptor_s resultdsc
1550 = {NAM$C_MAXRSS, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, (void *) result.string};
1551
1552 /* Convert parameter name (a file spec) to host file form. Note that this
1553 is needed on VMS to prepare for subsequent calls to VMS RMS library
1554 routines. Note that it would not work to call __gnat_to_host_dir_spec
1555 as was done in a previous version, since this fails silently unless
1556 the feature logical DECC$EFS_CHARSET is enabled, in which case a DNF
1557 (directory not found) condition is signalled. */
1558 tryfile = (char *) __gnat_to_host_file_spec (name);
1559
1560 /* Allocate and initialize a FAB and NAM structures. */
1561 fab = cc$rms_fab;
1562 nam = cc$rms_nam;
1563
1564 nam.nam$l_esa = file.string;
1565 nam.nam$b_ess = NAM$C_MAXRSS;
1566 nam.nam$l_rsa = result.string;
1567 nam.nam$b_rss = NAM$C_MAXRSS;
1568 fab.fab$l_fna = tryfile;
1569 fab.fab$b_fns = strlen (tryfile);
1570 fab.fab$l_nam = &nam;
1571
1572 /* Validate filespec syntax and device existence. */
1573 status = SYS$PARSE (&fab, 0, 0);
1574 if ((status & 1) != 1)
1575 LIB$SIGNAL (status);
1576
1577 file.string[nam.nam$b_esl] = 0;
1578
1579 /* Find matching filespec. */
1580 status = SYS$SEARCH (&fab, 0, 0);
1581 if ((status & 1) != 1)
1582 LIB$SIGNAL (status);
1583
1584 file.string[nam.nam$b_esl] = 0;
1585 result.string[result.length=nam.nam$b_rsl] = 0;
1586
1587 /* Get the device name and assign an IO channel. */
1588 strncpy (device.string, nam.nam$l_dev, nam.nam$b_dev);
1589 devicedsc.dsc$w_length = nam.nam$b_dev;
1590 chan = 0;
1591 status = SYS$ASSIGN (&devicedsc, &chan, 0, 0, 0);
1592 if ((status & 1) != 1)
1593 LIB$SIGNAL (status);
1594
1595 /* Initialize the FIB and fill in the directory id field. */
1596 memset (&fib, 0, sizeof (fib));
1597 fib.fib$w_did[0] = nam.nam$w_did[0];
1598 fib.fib$w_did[1] = nam.nam$w_did[1];
1599 fib.fib$w_did[2] = nam.nam$w_did[2];
1600 fib.fib$l_acctl = 0;
1601 fib.fib$l_wcc = 0;
1602 strcpy (file.string, (strrchr (result.string, ']') + 1));
1603 filedsc.dsc$w_length = strlen (file.string);
1604 result.string[result.length = 0] = 0;
1605
1606 /* Open and close the file to fill in the attributes. */
1607 status
1608 = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
1609 &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
1610 if ((status & 1) != 1)
1611 LIB$SIGNAL (status);
1612 if ((iosb.status & 1) != 1)
1613 LIB$SIGNAL (iosb.status);
1614
1615 result.string[result.length] = 0;
1616 status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0, &fibdsc, 0, 0, 0,
1617 &atrlst, 0);
1618 if ((status & 1) != 1)
1619 LIB$SIGNAL (status);
1620 if ((iosb.status & 1) != 1)
1621 LIB$SIGNAL (iosb.status);
1622
1623 {
1624 time_t t;
1625
1626 /* Set creation time to requested time. */
1627 unix_time_to_vms (time_stamp, newtime);
1628
1629 t = time ((time_t) 0);
1630
1631 /* Set revision time to now in local time. */
1632 unix_time_to_vms (t, revtime);
1633 }
1634
1635 /* Reopen the file, modify the times and then close. */
1636 fib.fib$l_acctl = FIB$M_WRITE;
1637 status
1638 = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
1639 &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
1640 if ((status & 1) != 1)
1641 LIB$SIGNAL (status);
1642 if ((iosb.status & 1) != 1)
1643 LIB$SIGNAL (iosb.status);
1644
1645 Fat.create = newtime;
1646 Fat.revise = revtime;
1647
1648 status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0,
1649 &fibdsc, 0, 0, 0, &atrlst, 0);
1650 if ((status & 1) != 1)
1651 LIB$SIGNAL (status);
1652 if ((iosb.status & 1) != 1)
1653 LIB$SIGNAL (iosb.status);
1654
1655 /* Deassign the channel and exit. */
1656 status = SYS$DASSGN (chan);
1657 if ((status & 1) != 1)
1658 LIB$SIGNAL (status);
1659 #else
1660 struct utimbuf utimbuf;
1661 time_t t;
1662
1663 /* Set modification time to requested time. */
1664 utimbuf.modtime = time_stamp;
1665
1666 /* Set access time to now in local time. */
1667 t = time ((time_t) 0);
1668 utimbuf.actime = mktime (localtime (&t));
1669
1670 utime (name, &utimbuf);
1671 #endif
1672 }
1673
1674 /* Get the list of installed standard libraries from the
1675 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1676 key. */
1677
1678 char *
__gnat_get_libraries_from_registry(void)1679 __gnat_get_libraries_from_registry (void)
1680 {
1681 char *result = (char *) xmalloc (1);
1682
1683 result[0] = '\0';
1684
1685 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS) \
1686 && ! defined (RTX)
1687
1688 HKEY reg_key;
1689 DWORD name_size, value_size;
1690 char name[256];
1691 char value[256];
1692 DWORD type;
1693 DWORD index;
1694 LONG res;
1695
1696 /* First open the key. */
1697 res = RegOpenKeyExA (HKEY_LOCAL_MACHINE, "SOFTWARE", 0, KEY_READ, ®_key);
1698
1699 if (res == ERROR_SUCCESS)
1700 res = RegOpenKeyExA (reg_key, "Ada Core Technologies", 0,
1701 KEY_READ, ®_key);
1702
1703 if (res == ERROR_SUCCESS)
1704 res = RegOpenKeyExA (reg_key, "GNAT", 0, KEY_READ, ®_key);
1705
1706 if (res == ERROR_SUCCESS)
1707 res = RegOpenKeyExA (reg_key, "Standard Libraries", 0, KEY_READ, ®_key);
1708
1709 /* If the key exists, read out all the values in it and concatenate them
1710 into a path. */
1711 for (index = 0; res == ERROR_SUCCESS; index++)
1712 {
1713 value_size = name_size = 256;
1714 res = RegEnumValueA (reg_key, index, name, &name_size, 0,
1715 &type, (LPBYTE)value, &value_size);
1716
1717 if (res == ERROR_SUCCESS && type == REG_SZ)
1718 {
1719 char *old_result = result;
1720
1721 result = (char *) xmalloc (strlen (old_result) + value_size + 2);
1722 strcpy (result, old_result);
1723 strcat (result, value);
1724 strcat (result, ";");
1725 free (old_result);
1726 }
1727 }
1728
1729 /* Remove the trailing ";". */
1730 if (result[0] != 0)
1731 result[strlen (result) - 1] = 0;
1732
1733 #endif
1734 return result;
1735 }
1736
1737 int
__gnat_stat(char * name,GNAT_STRUCT_STAT * statbuf)1738 __gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf)
1739 {
1740 #ifdef __MINGW32__
1741 WIN32_FILE_ATTRIBUTE_DATA fad;
1742 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
1743 int name_len;
1744 BOOL res;
1745 DWORD error;
1746
1747 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
1748 name_len = _tcslen (wname);
1749
1750 if (name_len > GNAT_MAX_PATH_LEN)
1751 return -1;
1752
1753 ZeroMemory (statbuf, sizeof(GNAT_STRUCT_STAT));
1754
1755 res = GetFileAttributesEx (wname, GetFileExInfoStandard, &fad);
1756
1757 if (res == FALSE) {
1758 error = GetLastError();
1759
1760 /* Check file existence using GetFileAttributes() which does not fail on
1761 special Windows files like con:, aux:, nul: etc... */
1762
1763 if (GetFileAttributes(wname) != INVALID_FILE_ATTRIBUTES) {
1764 /* Just pretend that it is a regular and readable file */
1765 statbuf->st_mode = S_IFREG | S_IREAD | S_IWRITE;
1766 return 0;
1767 }
1768
1769 switch (error) {
1770 case ERROR_ACCESS_DENIED:
1771 case ERROR_SHARING_VIOLATION:
1772 case ERROR_LOCK_VIOLATION:
1773 case ERROR_SHARING_BUFFER_EXCEEDED:
1774 return EACCES;
1775 case ERROR_BUFFER_OVERFLOW:
1776 return ENAMETOOLONG;
1777 case ERROR_NOT_ENOUGH_MEMORY:
1778 return ENOMEM;
1779 default:
1780 return ENOENT;
1781 }
1782 }
1783
1784 f2t (&fad.ftCreationTime, &statbuf->st_ctime);
1785 f2t (&fad.ftLastWriteTime, &statbuf->st_mtime);
1786 f2t (&fad.ftLastAccessTime, &statbuf->st_atime);
1787
1788 statbuf->st_size = (off_t)fad.nFileSizeLow;
1789
1790 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1791 statbuf->st_mode = S_IREAD;
1792
1793 if (fad.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY)
1794 statbuf->st_mode |= S_IFDIR;
1795 else
1796 statbuf->st_mode |= S_IFREG;
1797
1798 if (!(fad.dwFileAttributes & FILE_ATTRIBUTE_READONLY))
1799 statbuf->st_mode |= S_IWRITE;
1800
1801 return 0;
1802
1803 #else
1804 return GNAT_STAT (name, statbuf);
1805 #endif
1806 }
1807
1808 /*************************************************************************
1809 ** Check whether a file exists
1810 *************************************************************************/
1811
1812 int
__gnat_file_exists_attr(char * name,struct file_attributes * attr)1813 __gnat_file_exists_attr (char* name, struct file_attributes* attr)
1814 {
1815 if (attr->exists == ATTR_UNSET) {
1816 __gnat_stat_to_attr (-1, name, attr);
1817 }
1818
1819 return attr->exists;
1820 }
1821
1822 int
__gnat_file_exists(char * name)1823 __gnat_file_exists (char *name)
1824 {
1825 struct file_attributes attr;
1826 __gnat_reset_attributes (&attr);
1827 return __gnat_file_exists_attr (name, &attr);
1828 }
1829
1830 /**********************************************************************
1831 ** Whether name is an absolute path
1832 **********************************************************************/
1833
1834 int
__gnat_is_absolute_path(char * name,int length)1835 __gnat_is_absolute_path (char *name, int length)
1836 {
1837 #ifdef __vxworks
1838 /* On VxWorks systems, an absolute path can be represented (depending on
1839 the host platform) as either /dir/file, or device:/dir/file, or
1840 device:drive_letter:/dir/file. */
1841
1842 int index;
1843
1844 if (name[0] == '/')
1845 return 1;
1846
1847 for (index = 0; index < length; index++)
1848 {
1849 if (name[index] == ':' &&
1850 ((name[index + 1] == '/') ||
1851 (isalpha (name[index + 1]) && index + 2 <= length &&
1852 name[index + 2] == '/')))
1853 return 1;
1854
1855 else if (name[index] == '/')
1856 return 0;
1857 }
1858 return 0;
1859 #else
1860 return (length != 0) &&
1861 (*name == '/' || *name == DIR_SEPARATOR
1862 #if defined (WINNT)
1863 || (length > 1 && ISALPHA (name[0]) && name[1] == ':')
1864 #endif
1865 );
1866 #endif
1867 }
1868
1869 int
__gnat_is_regular_file_attr(char * name,struct file_attributes * attr)1870 __gnat_is_regular_file_attr (char* name, struct file_attributes* attr)
1871 {
1872 if (attr->regular == ATTR_UNSET) {
1873 __gnat_stat_to_attr (-1, name, attr);
1874 }
1875
1876 return attr->regular;
1877 }
1878
1879 int
__gnat_is_regular_file(char * name)1880 __gnat_is_regular_file (char *name)
1881 {
1882 struct file_attributes attr;
1883 __gnat_reset_attributes (&attr);
1884 return __gnat_is_regular_file_attr (name, &attr);
1885 }
1886
1887 int
__gnat_is_directory_attr(char * name,struct file_attributes * attr)1888 __gnat_is_directory_attr (char* name, struct file_attributes* attr)
1889 {
1890 if (attr->directory == ATTR_UNSET) {
1891 __gnat_stat_to_attr (-1, name, attr);
1892 }
1893
1894 return attr->directory;
1895 }
1896
1897 int
__gnat_is_directory(char * name)1898 __gnat_is_directory (char *name)
1899 {
1900 struct file_attributes attr;
1901 __gnat_reset_attributes (&attr);
1902 return __gnat_is_directory_attr (name, &attr);
1903 }
1904
1905 #if defined (_WIN32) && !defined (RTX)
1906
1907 /* Returns the same constant as GetDriveType but takes a pathname as
1908 argument. */
1909
1910 static UINT
GetDriveTypeFromPath(TCHAR * wfullpath)1911 GetDriveTypeFromPath (TCHAR *wfullpath)
1912 {
1913 TCHAR wdrv[MAX_PATH];
1914 TCHAR wpath[MAX_PATH];
1915 TCHAR wfilename[MAX_PATH];
1916 TCHAR wext[MAX_PATH];
1917
1918 _tsplitpath (wfullpath, wdrv, wpath, wfilename, wext);
1919
1920 if (_tcslen (wdrv) != 0)
1921 {
1922 /* we have a drive specified. */
1923 _tcscat (wdrv, _T("\\"));
1924 return GetDriveType (wdrv);
1925 }
1926 else
1927 {
1928 /* No drive specified. */
1929
1930 /* Is this a relative path, if so get current drive type. */
1931 if (wpath[0] != _T('\\') ||
1932 (_tcslen (wpath) > 2 && wpath[0] == _T('\\') && wpath[1] != _T('\\')))
1933 return GetDriveType (NULL);
1934
1935 UINT result = GetDriveType (wpath);
1936
1937 /* Cannot guess the drive type, is this \\.\ ? */
1938
1939 if (result == DRIVE_NO_ROOT_DIR &&
1940 _tcslen (wpath) >= 4 && wpath[0] == _T('\\') && wpath[1] == _T('\\')
1941 && wpath[2] == _T('.') && wpath[3] == _T('\\'))
1942 {
1943 if (_tcslen (wpath) == 4)
1944 _tcscat (wpath, wfilename);
1945
1946 LPTSTR p = &wpath[4];
1947 LPTSTR b = _tcschr (p, _T('\\'));
1948
1949 if (b != NULL)
1950 { /* logical drive \\.\c\dir\file */
1951 *b++ = _T(':');
1952 *b++ = _T('\\');
1953 *b = _T('\0');
1954 }
1955 else
1956 _tcscat (p, _T(":\\"));
1957
1958 return GetDriveType (p);
1959 }
1960
1961 return result;
1962 }
1963 }
1964
1965 /* This MingW section contains code to work with ACL. */
1966 static int
__gnat_check_OWNER_ACL(TCHAR * wname,DWORD CheckAccessDesired,GENERIC_MAPPING CheckGenericMapping)1967 __gnat_check_OWNER_ACL
1968 (TCHAR *wname,
1969 DWORD CheckAccessDesired,
1970 GENERIC_MAPPING CheckGenericMapping)
1971 {
1972 DWORD dwAccessDesired, dwAccessAllowed;
1973 PRIVILEGE_SET PrivilegeSet;
1974 DWORD dwPrivSetSize = sizeof (PRIVILEGE_SET);
1975 BOOL fAccessGranted = FALSE;
1976 HANDLE hToken = NULL;
1977 DWORD nLength = 0;
1978 SECURITY_DESCRIPTOR* pSD = NULL;
1979
1980 GetFileSecurity
1981 (wname, OWNER_SECURITY_INFORMATION |
1982 GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION,
1983 NULL, 0, &nLength);
1984
1985 if ((pSD = (SECURITY_DESCRIPTOR *) HeapAlloc
1986 (GetProcessHeap (), HEAP_ZERO_MEMORY, nLength)) == NULL)
1987 return 0;
1988
1989 /* Obtain the security descriptor. */
1990
1991 if (!GetFileSecurity
1992 (wname, OWNER_SECURITY_INFORMATION |
1993 GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION,
1994 pSD, nLength, &nLength))
1995 goto error;
1996
1997 if (!ImpersonateSelf (SecurityImpersonation))
1998 goto error;
1999
2000 if (!OpenThreadToken
2001 (GetCurrentThread(), TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken))
2002 goto error;
2003
2004 /* Undoes the effect of ImpersonateSelf. */
2005
2006 RevertToSelf ();
2007
2008 /* We want to test for write permissions. */
2009
2010 dwAccessDesired = CheckAccessDesired;
2011
2012 MapGenericMask (&dwAccessDesired, &CheckGenericMapping);
2013
2014 if (!AccessCheck
2015 (pSD , /* security descriptor to check */
2016 hToken, /* impersonation token */
2017 dwAccessDesired, /* requested access rights */
2018 &CheckGenericMapping, /* pointer to GENERIC_MAPPING */
2019 &PrivilegeSet, /* receives privileges used in check */
2020 &dwPrivSetSize, /* size of PrivilegeSet buffer */
2021 &dwAccessAllowed, /* receives mask of allowed access rights */
2022 &fAccessGranted))
2023 goto error;
2024
2025 CloseHandle (hToken);
2026 HeapFree (GetProcessHeap (), 0, pSD);
2027 return fAccessGranted;
2028
2029 error:
2030 if (hToken)
2031 CloseHandle (hToken);
2032 HeapFree (GetProcessHeap (), 0, pSD);
2033 return 0;
2034 }
2035
2036 static void
__gnat_set_OWNER_ACL(TCHAR * wname,DWORD AccessMode,DWORD AccessPermissions)2037 __gnat_set_OWNER_ACL
2038 (TCHAR *wname,
2039 DWORD AccessMode,
2040 DWORD AccessPermissions)
2041 {
2042 PACL pOldDACL = NULL;
2043 PACL pNewDACL = NULL;
2044 PSECURITY_DESCRIPTOR pSD = NULL;
2045 EXPLICIT_ACCESS ea;
2046 TCHAR username [100];
2047 DWORD unsize = 100;
2048
2049 /* Get current user, he will act as the owner */
2050
2051 if (!GetUserName (username, &unsize))
2052 return;
2053
2054 if (GetNamedSecurityInfo
2055 (wname,
2056 SE_FILE_OBJECT,
2057 DACL_SECURITY_INFORMATION,
2058 NULL, NULL, &pOldDACL, NULL, &pSD) != ERROR_SUCCESS)
2059 return;
2060
2061 BuildExplicitAccessWithName
2062 (&ea, username, AccessPermissions, (ACCESS_MODE) AccessMode, NO_INHERITANCE);
2063
2064 if (AccessMode == SET_ACCESS)
2065 {
2066 /* SET_ACCESS, we want to set an explicte set of permissions, do not
2067 merge with current DACL. */
2068 if (SetEntriesInAcl (1, &ea, NULL, &pNewDACL) != ERROR_SUCCESS)
2069 return;
2070 }
2071 else
2072 if (SetEntriesInAcl (1, &ea, pOldDACL, &pNewDACL) != ERROR_SUCCESS)
2073 return;
2074
2075 if (SetNamedSecurityInfo
2076 (wname, SE_FILE_OBJECT,
2077 DACL_SECURITY_INFORMATION, NULL, NULL, pNewDACL, NULL) != ERROR_SUCCESS)
2078 return;
2079
2080 LocalFree (pSD);
2081 LocalFree (pNewDACL);
2082 }
2083
2084 /* Check if it is possible to use ACL for wname, the file must not be on a
2085 network drive. */
2086
2087 static int
__gnat_can_use_acl(TCHAR * wname)2088 __gnat_can_use_acl (TCHAR *wname)
2089 {
2090 return __gnat_use_acl && GetDriveTypeFromPath (wname) != DRIVE_REMOTE;
2091 }
2092
2093 #endif /* defined (_WIN32) && !defined (RTX) */
2094
2095 int
__gnat_is_readable_file_attr(char * name,struct file_attributes * attr)2096 __gnat_is_readable_file_attr (char* name, struct file_attributes* attr)
2097 {
2098 if (attr->readable == ATTR_UNSET) {
2099 #if defined (_WIN32) && !defined (RTX)
2100 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2101 GENERIC_MAPPING GenericMapping;
2102
2103 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2104
2105 if (__gnat_can_use_acl (wname))
2106 {
2107 ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
2108 GenericMapping.GenericRead = GENERIC_READ;
2109 attr->readable =
2110 __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping);
2111 }
2112 else
2113 attr->readable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
2114 #else
2115 __gnat_stat_to_attr (-1, name, attr);
2116 #endif
2117 }
2118
2119 return attr->readable;
2120 }
2121
2122 int
__gnat_is_readable_file(char * name)2123 __gnat_is_readable_file (char *name)
2124 {
2125 struct file_attributes attr;
2126 __gnat_reset_attributes (&attr);
2127 return __gnat_is_readable_file_attr (name, &attr);
2128 }
2129
2130 int
__gnat_is_writable_file_attr(char * name,struct file_attributes * attr)2131 __gnat_is_writable_file_attr (char* name, struct file_attributes* attr)
2132 {
2133 if (attr->writable == ATTR_UNSET) {
2134 #if defined (_WIN32) && !defined (RTX)
2135 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2136 GENERIC_MAPPING GenericMapping;
2137
2138 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2139
2140 if (__gnat_can_use_acl (wname))
2141 {
2142 ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
2143 GenericMapping.GenericWrite = GENERIC_WRITE;
2144
2145 attr->writable = __gnat_check_OWNER_ACL
2146 (wname, FILE_WRITE_DATA | FILE_APPEND_DATA, GenericMapping)
2147 && !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
2148 }
2149 else
2150 attr->writable = !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
2151
2152 #else
2153 __gnat_stat_to_attr (-1, name, attr);
2154 #endif
2155 }
2156
2157 return attr->writable;
2158 }
2159
2160 int
__gnat_is_writable_file(char * name)2161 __gnat_is_writable_file (char *name)
2162 {
2163 struct file_attributes attr;
2164 __gnat_reset_attributes (&attr);
2165 return __gnat_is_writable_file_attr (name, &attr);
2166 }
2167
2168 int
__gnat_is_executable_file_attr(char * name,struct file_attributes * attr)2169 __gnat_is_executable_file_attr (char* name, struct file_attributes* attr)
2170 {
2171 if (attr->executable == ATTR_UNSET) {
2172 #if defined (_WIN32) && !defined (RTX)
2173 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2174 GENERIC_MAPPING GenericMapping;
2175
2176 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2177
2178 if (__gnat_can_use_acl (wname))
2179 {
2180 ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
2181 GenericMapping.GenericExecute = GENERIC_EXECUTE;
2182
2183 attr->executable =
2184 __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
2185 }
2186 else
2187 {
2188 TCHAR *l, *last = _tcsstr(wname, _T(".exe"));
2189
2190 /* look for last .exe */
2191 if (last)
2192 while ((l = _tcsstr(last+1, _T(".exe")))) last = l;
2193
2194 attr->executable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
2195 && (last - wname) == (int) (_tcslen (wname) - 4);
2196 }
2197 #else
2198 __gnat_stat_to_attr (-1, name, attr);
2199 #endif
2200 }
2201
2202 return attr->executable;
2203 }
2204
2205 int
__gnat_is_executable_file(char * name)2206 __gnat_is_executable_file (char *name)
2207 {
2208 struct file_attributes attr;
2209 __gnat_reset_attributes (&attr);
2210 return __gnat_is_executable_file_attr (name, &attr);
2211 }
2212
2213 void
__gnat_set_writable(char * name)2214 __gnat_set_writable (char *name)
2215 {
2216 #if defined (_WIN32) && !defined (RTX)
2217 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2218
2219 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2220
2221 if (__gnat_can_use_acl (wname))
2222 __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_WRITE);
2223
2224 SetFileAttributes
2225 (wname, GetFileAttributes (wname) & ~FILE_ATTRIBUTE_READONLY);
2226 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2227 ! defined(__nucleus__)
2228 GNAT_STRUCT_STAT statbuf;
2229
2230 if (GNAT_STAT (name, &statbuf) == 0)
2231 {
2232 statbuf.st_mode = statbuf.st_mode | S_IWUSR;
2233 chmod (name, statbuf.st_mode);
2234 }
2235 #endif
2236 }
2237
2238 void
__gnat_set_executable(char * name)2239 __gnat_set_executable (char *name)
2240 {
2241 #if defined (_WIN32) && !defined (RTX)
2242 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2243
2244 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2245
2246 if (__gnat_can_use_acl (wname))
2247 __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_EXECUTE);
2248
2249 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2250 ! defined(__nucleus__)
2251 GNAT_STRUCT_STAT statbuf;
2252
2253 if (GNAT_STAT (name, &statbuf) == 0)
2254 {
2255 statbuf.st_mode = statbuf.st_mode | S_IXUSR;
2256 chmod (name, statbuf.st_mode);
2257 }
2258 #endif
2259 }
2260
2261 void
__gnat_set_non_writable(char * name)2262 __gnat_set_non_writable (char *name)
2263 {
2264 #if defined (_WIN32) && !defined (RTX)
2265 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2266
2267 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2268
2269 if (__gnat_can_use_acl (wname))
2270 __gnat_set_OWNER_ACL
2271 (wname, DENY_ACCESS,
2272 FILE_WRITE_DATA | FILE_APPEND_DATA |
2273 FILE_WRITE_EA | FILE_WRITE_ATTRIBUTES);
2274
2275 SetFileAttributes
2276 (wname, GetFileAttributes (wname) | FILE_ATTRIBUTE_READONLY);
2277 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2278 ! defined(__nucleus__)
2279 GNAT_STRUCT_STAT statbuf;
2280
2281 if (GNAT_STAT (name, &statbuf) == 0)
2282 {
2283 statbuf.st_mode = statbuf.st_mode & 07577;
2284 chmod (name, statbuf.st_mode);
2285 }
2286 #endif
2287 }
2288
2289 void
__gnat_set_readable(char * name)2290 __gnat_set_readable (char *name)
2291 {
2292 #if defined (_WIN32) && !defined (RTX)
2293 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2294
2295 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2296
2297 if (__gnat_can_use_acl (wname))
2298 __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_READ);
2299
2300 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2301 ! defined(__nucleus__)
2302 GNAT_STRUCT_STAT statbuf;
2303
2304 if (GNAT_STAT (name, &statbuf) == 0)
2305 {
2306 chmod (name, statbuf.st_mode | S_IREAD);
2307 }
2308 #endif
2309 }
2310
2311 void
__gnat_set_non_readable(char * name)2312 __gnat_set_non_readable (char *name)
2313 {
2314 #if defined (_WIN32) && !defined (RTX)
2315 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2316
2317 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2318
2319 if (__gnat_can_use_acl (wname))
2320 __gnat_set_OWNER_ACL (wname, DENY_ACCESS, FILE_GENERIC_READ);
2321
2322 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2323 ! defined(__nucleus__)
2324 GNAT_STRUCT_STAT statbuf;
2325
2326 if (GNAT_STAT (name, &statbuf) == 0)
2327 {
2328 chmod (name, statbuf.st_mode & (~S_IREAD));
2329 }
2330 #endif
2331 }
2332
2333 int
__gnat_is_symbolic_link_attr(char * name ATTRIBUTE_UNUSED,struct file_attributes * attr)2334 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED,
2335 struct file_attributes* attr)
2336 {
2337 if (attr->symbolic_link == ATTR_UNSET) {
2338 #if defined (__vxworks) || defined (__nucleus__)
2339 attr->symbolic_link = 0;
2340
2341 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2342 int ret;
2343 GNAT_STRUCT_STAT statbuf;
2344 ret = GNAT_LSTAT (name, &statbuf);
2345 attr->symbolic_link = (!ret && S_ISLNK (statbuf.st_mode));
2346 #else
2347 attr->symbolic_link = 0;
2348 #endif
2349 }
2350 return attr->symbolic_link;
2351 }
2352
2353 int
__gnat_is_symbolic_link(char * name ATTRIBUTE_UNUSED)2354 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
2355 {
2356 struct file_attributes attr;
2357 __gnat_reset_attributes (&attr);
2358 return __gnat_is_symbolic_link_attr (name, &attr);
2359
2360 }
2361
2362 #if defined (sun) && defined (__SVR4)
2363 /* Using fork on Solaris will duplicate all the threads. fork1, which
2364 duplicates only the active thread, must be used instead, or spawning
2365 subprocess from a program with tasking will lead into numerous problems. */
2366 #define fork fork1
2367 #endif
2368
2369 int
__gnat_portable_spawn(char * args[])2370 __gnat_portable_spawn (char *args[])
2371 {
2372 int status = 0;
2373 int finished ATTRIBUTE_UNUSED;
2374 int pid ATTRIBUTE_UNUSED;
2375
2376 #if defined (__vxworks) || defined(__nucleus__) || defined(RTX)
2377 return -1;
2378
2379 #elif defined (_WIN32)
2380 /* args[0] must be quotes as it could contain a full pathname with spaces */
2381 char *args_0 = args[0];
2382 args[0] = (char *)xmalloc (strlen (args_0) + 3);
2383 strcpy (args[0], "\"");
2384 strcat (args[0], args_0);
2385 strcat (args[0], "\"");
2386
2387 status = spawnvp (P_WAIT, args_0, (char* const*)args);
2388
2389 /* restore previous value */
2390 free (args[0]);
2391 args[0] = (char *)args_0;
2392
2393 if (status < 0)
2394 return -1;
2395 else
2396 return status;
2397
2398 #else
2399
2400 pid = fork ();
2401 if (pid < 0)
2402 return -1;
2403
2404 if (pid == 0)
2405 {
2406 /* The child. */
2407 if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
2408 #if defined (VMS)
2409 return -1; /* execv is in parent context on VMS. */
2410 #else
2411 _exit (1);
2412 #endif
2413 }
2414
2415 /* The parent. */
2416 finished = waitpid (pid, &status, 0);
2417
2418 if (finished != pid || WIFEXITED (status) == 0)
2419 return -1;
2420
2421 return WEXITSTATUS (status);
2422 #endif
2423
2424 return 0;
2425 }
2426
2427 /* Create a copy of the given file descriptor.
2428 Return -1 if an error occurred. */
2429
2430 int
__gnat_dup(int oldfd)2431 __gnat_dup (int oldfd)
2432 {
2433 #if defined (__vxworks) && !defined (__RTP__)
2434 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2435 RTPs. */
2436 return -1;
2437 #else
2438 return dup (oldfd);
2439 #endif
2440 }
2441
2442 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2443 Return -1 if an error occurred. */
2444
2445 int
__gnat_dup2(int oldfd,int newfd)2446 __gnat_dup2 (int oldfd, int newfd)
2447 {
2448 #if defined (__vxworks) && !defined (__RTP__)
2449 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2450 RTPs. */
2451 return -1;
2452 #elif defined (_WIN32)
2453 /* Special case when oldfd and newfd are identical and are the standard
2454 input, output or error as this makes Windows XP hangs. Note that we
2455 do that only for standard file descriptors that are known to be valid. */
2456 if (oldfd == newfd && newfd >= 0 && newfd <= 2)
2457 return newfd;
2458 else
2459 return dup2 (oldfd, newfd);
2460 #else
2461 return dup2 (oldfd, newfd);
2462 #endif
2463 }
2464
2465 int
__gnat_number_of_cpus(void)2466 __gnat_number_of_cpus (void)
2467 {
2468 int cores = 1;
2469
2470 #if defined (linux) || defined (sun) || defined (AIX) || defined (__APPLE__)
2471 cores = (int) sysconf (_SC_NPROCESSORS_ONLN);
2472
2473 #elif defined (__hpux__)
2474 struct pst_dynamic psd;
2475 if (pstat_getdynamic (&psd, sizeof (psd), 1, 0) != -1)
2476 cores = (int) psd.psd_proc_cnt;
2477
2478 #elif defined (_WIN32)
2479 SYSTEM_INFO sysinfo;
2480 GetSystemInfo (&sysinfo);
2481 cores = (int) sysinfo.dwNumberOfProcessors;
2482
2483 #elif defined (VMS)
2484 int code = SYI$_ACTIVECPU_CNT;
2485 unsigned int res;
2486 int status;
2487
2488 status = LIB$GETSYI (&code, &res);
2489 if ((status & 1) != 0)
2490 cores = res;
2491
2492 #elif defined (_WRS_CONFIG_SMP)
2493 unsigned int vxCpuConfiguredGet (void);
2494
2495 cores = vxCpuConfiguredGet ();
2496
2497 #endif
2498
2499 return cores;
2500 }
2501
2502 /* WIN32 code to implement a wait call that wait for any child process. */
2503
2504 #if defined (_WIN32) && !defined (RTX)
2505
2506 /* Synchronization code, to be thread safe. */
2507
2508 #ifdef CERT
2509
2510 /* For the Cert run times on native Windows we use dummy functions
2511 for locking and unlocking tasks since we do not support multiple
2512 threads on this configuration (Cert run time on native Windows). */
2513
dummy(void)2514 void dummy (void) {}
2515
2516 void (*Lock_Task) () = &dummy;
2517 void (*Unlock_Task) () = &dummy;
2518
2519 #else
2520
2521 #define Lock_Task system__soft_links__lock_task
2522 extern void (*Lock_Task) (void);
2523
2524 #define Unlock_Task system__soft_links__unlock_task
2525 extern void (*Unlock_Task) (void);
2526
2527 #endif
2528
2529 static HANDLE *HANDLES_LIST = NULL;
2530 static int *PID_LIST = NULL, plist_length = 0, plist_max_length = 0;
2531
2532 static void
add_handle(HANDLE h,int pid)2533 add_handle (HANDLE h, int pid)
2534 {
2535
2536 /* -------------------- critical section -------------------- */
2537 (*Lock_Task) ();
2538
2539 if (plist_length == plist_max_length)
2540 {
2541 plist_max_length += 1000;
2542 HANDLES_LIST =
2543 (void **) xrealloc (HANDLES_LIST, sizeof (HANDLE) * plist_max_length);
2544 PID_LIST =
2545 (int *) xrealloc (PID_LIST, sizeof (int) * plist_max_length);
2546 }
2547
2548 HANDLES_LIST[plist_length] = h;
2549 PID_LIST[plist_length] = pid;
2550 ++plist_length;
2551
2552 (*Unlock_Task) ();
2553 /* -------------------- critical section -------------------- */
2554 }
2555
2556 void
__gnat_win32_remove_handle(HANDLE h,int pid)2557 __gnat_win32_remove_handle (HANDLE h, int pid)
2558 {
2559 int j;
2560
2561 /* -------------------- critical section -------------------- */
2562 (*Lock_Task) ();
2563
2564 for (j = 0; j < plist_length; j++)
2565 {
2566 if ((HANDLES_LIST[j] == h) || (PID_LIST[j] == pid))
2567 {
2568 CloseHandle (h);
2569 --plist_length;
2570 HANDLES_LIST[j] = HANDLES_LIST[plist_length];
2571 PID_LIST[j] = PID_LIST[plist_length];
2572 break;
2573 }
2574 }
2575
2576 (*Unlock_Task) ();
2577 /* -------------------- critical section -------------------- */
2578 }
2579
2580 static void
win32_no_block_spawn(char * command,char * args[],HANDLE * h,int * pid)2581 win32_no_block_spawn (char *command, char *args[], HANDLE *h, int *pid)
2582 {
2583 BOOL result;
2584 STARTUPINFO SI;
2585 PROCESS_INFORMATION PI;
2586 SECURITY_ATTRIBUTES SA;
2587 int csize = 1;
2588 char *full_command;
2589 int k;
2590
2591 /* compute the total command line length */
2592 k = 0;
2593 while (args[k])
2594 {
2595 csize += strlen (args[k]) + 1;
2596 k++;
2597 }
2598
2599 full_command = (char *) xmalloc (csize);
2600
2601 /* Startup info. */
2602 SI.cb = sizeof (STARTUPINFO);
2603 SI.lpReserved = NULL;
2604 SI.lpReserved2 = NULL;
2605 SI.lpDesktop = NULL;
2606 SI.cbReserved2 = 0;
2607 SI.lpTitle = NULL;
2608 SI.dwFlags = 0;
2609 SI.wShowWindow = SW_HIDE;
2610
2611 /* Security attributes. */
2612 SA.nLength = sizeof (SECURITY_ATTRIBUTES);
2613 SA.bInheritHandle = TRUE;
2614 SA.lpSecurityDescriptor = NULL;
2615
2616 /* Prepare the command string. */
2617 strcpy (full_command, command);
2618 strcat (full_command, " ");
2619
2620 k = 1;
2621 while (args[k])
2622 {
2623 strcat (full_command, args[k]);
2624 strcat (full_command, " ");
2625 k++;
2626 }
2627
2628 {
2629 int wsize = csize * 2;
2630 TCHAR *wcommand = (TCHAR *) xmalloc (wsize);
2631
2632 S2WSC (wcommand, full_command, wsize);
2633
2634 free (full_command);
2635
2636 result = CreateProcess
2637 (NULL, wcommand, &SA, NULL, TRUE,
2638 GetPriorityClass (GetCurrentProcess()), NULL, NULL, &SI, &PI);
2639
2640 free (wcommand);
2641 }
2642
2643 if (result == TRUE)
2644 {
2645 CloseHandle (PI.hThread);
2646 *h = PI.hProcess;
2647 *pid = PI.dwProcessId;
2648 }
2649 else
2650 {
2651 *h = NULL;
2652 *pid = 0;
2653 }
2654 }
2655
2656 static int
win32_wait(int * status)2657 win32_wait (int *status)
2658 {
2659 DWORD exitcode, pid;
2660 HANDLE *hl;
2661 HANDLE h;
2662 DWORD res;
2663 int k;
2664 int hl_len;
2665
2666 if (plist_length == 0)
2667 {
2668 errno = ECHILD;
2669 return -1;
2670 }
2671
2672 k = 0;
2673
2674 /* -------------------- critical section -------------------- */
2675 (*Lock_Task) ();
2676
2677 hl_len = plist_length;
2678
2679 hl = (HANDLE *) xmalloc (sizeof (HANDLE) * hl_len);
2680
2681 memmove (hl, HANDLES_LIST, sizeof (HANDLE) * hl_len);
2682
2683 (*Unlock_Task) ();
2684 /* -------------------- critical section -------------------- */
2685
2686 res = WaitForMultipleObjects (hl_len, hl, FALSE, INFINITE);
2687 h = hl[res - WAIT_OBJECT_0];
2688
2689 GetExitCodeProcess (h, &exitcode);
2690 pid = PID_LIST [res - WAIT_OBJECT_0];
2691 __gnat_win32_remove_handle (h, -1);
2692
2693 free (hl);
2694
2695 *status = (int) exitcode;
2696 return (int) pid;
2697 }
2698
2699 #endif
2700
2701 int
__gnat_portable_no_block_spawn(char * args[])2702 __gnat_portable_no_block_spawn (char *args[])
2703 {
2704
2705 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX)
2706 return -1;
2707
2708 #elif defined (_WIN32)
2709
2710 HANDLE h = NULL;
2711 int pid;
2712
2713 win32_no_block_spawn (args[0], args, &h, &pid);
2714 if (h != NULL)
2715 {
2716 add_handle (h, pid);
2717 return pid;
2718 }
2719 else
2720 return -1;
2721
2722 #else
2723
2724 int pid = fork ();
2725
2726 if (pid == 0)
2727 {
2728 /* The child. */
2729 if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
2730 #if defined (VMS)
2731 return -1; /* execv is in parent context on VMS. */
2732 #else
2733 _exit (1);
2734 #endif
2735 }
2736
2737 return pid;
2738
2739 #endif
2740 }
2741
2742 int
__gnat_portable_wait(int * process_status)2743 __gnat_portable_wait (int *process_status)
2744 {
2745 int status = 0;
2746 int pid = 0;
2747
2748 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX)
2749 /* Not sure what to do here, so do nothing but return zero. */
2750
2751 #elif defined (_WIN32)
2752
2753 pid = win32_wait (&status);
2754
2755 #else
2756
2757 pid = waitpid (-1, &status, 0);
2758 status = status & 0xffff;
2759 #endif
2760
2761 *process_status = status;
2762 return pid;
2763 }
2764
2765 void
__gnat_os_exit(int status)2766 __gnat_os_exit (int status)
2767 {
2768 exit (status);
2769 }
2770
2771 /* Locate file on path, that matches a predicate */
2772
2773 char *
__gnat_locate_file_with_predicate(char * file_name,char * path_val,int (* predicate)(char *))2774 __gnat_locate_file_with_predicate
2775 (char *file_name, char *path_val, int (*predicate)(char*))
2776 {
2777 char *ptr;
2778 char *file_path = (char *) alloca (strlen (file_name) + 1);
2779 int absolute;
2780
2781 /* Return immediately if file_name is empty */
2782
2783 if (*file_name == '\0')
2784 return 0;
2785
2786 /* Remove quotes around file_name if present */
2787
2788 ptr = file_name;
2789 if (*ptr == '"')
2790 ptr++;
2791
2792 strcpy (file_path, ptr);
2793
2794 ptr = file_path + strlen (file_path) - 1;
2795
2796 if (*ptr == '"')
2797 *ptr = '\0';
2798
2799 /* Handle absolute pathnames. */
2800
2801 absolute = __gnat_is_absolute_path (file_path, strlen (file_name));
2802
2803 if (absolute)
2804 {
2805 if (predicate (file_path))
2806 return xstrdup (file_path);
2807
2808 return 0;
2809 }
2810
2811 /* If file_name include directory separator(s), try it first as
2812 a path name relative to the current directory */
2813 for (ptr = file_name; *ptr && *ptr != '/' && *ptr != DIR_SEPARATOR; ptr++)
2814 ;
2815
2816 if (*ptr != 0)
2817 {
2818 if (predicate (file_name))
2819 return xstrdup (file_name);
2820 }
2821
2822 if (path_val == 0)
2823 return 0;
2824
2825 {
2826 /* The result has to be smaller than path_val + file_name. */
2827 char *file_path =
2828 (char *) alloca (strlen (path_val) + strlen (file_name) + 2);
2829
2830 for (;;)
2831 {
2832 /* Skip the starting quote */
2833
2834 if (*path_val == '"')
2835 path_val++;
2836
2837 for (ptr = file_path; *path_val && *path_val != PATH_SEPARATOR; )
2838 *ptr++ = *path_val++;
2839
2840 /* If directory is empty, it is the current directory*/
2841
2842 if (ptr == file_path)
2843 {
2844 *ptr = '.';
2845 }
2846 else
2847 ptr--;
2848
2849 /* Skip the ending quote */
2850
2851 if (*ptr == '"')
2852 ptr--;
2853
2854 if (*ptr != '/' && *ptr != DIR_SEPARATOR)
2855 *++ptr = DIR_SEPARATOR;
2856
2857 strcpy (++ptr, file_name);
2858
2859 if (predicate (file_path))
2860 return xstrdup (file_path);
2861
2862 if (*path_val == 0)
2863 return 0;
2864
2865 /* Skip path separator */
2866
2867 path_val++;
2868 }
2869 }
2870
2871 return 0;
2872 }
2873
2874 /* Locate an executable file, give a Path value. */
2875
2876 char *
__gnat_locate_executable_file(char * file_name,char * path_val)2877 __gnat_locate_executable_file (char *file_name, char *path_val)
2878 {
2879 return __gnat_locate_file_with_predicate
2880 (file_name, path_val, &__gnat_is_executable_file);
2881 }
2882
2883 /* Locate a regular file, give a Path value. */
2884
2885 char *
__gnat_locate_regular_file(char * file_name,char * path_val)2886 __gnat_locate_regular_file (char *file_name, char *path_val)
2887 {
2888 return __gnat_locate_file_with_predicate
2889 (file_name, path_val, &__gnat_is_regular_file);
2890 }
2891
2892 /* Locate an executable given a Path argument. This routine is only used by
2893 gnatbl and should not be used otherwise. Use locate_exec_on_path
2894 instead. */
2895
2896 char *
__gnat_locate_exec(char * exec_name,char * path_val)2897 __gnat_locate_exec (char *exec_name, char *path_val)
2898 {
2899 char *ptr;
2900 if (!strstr (exec_name, HOST_EXECUTABLE_SUFFIX))
2901 {
2902 char *full_exec_name =
2903 (char *) alloca
2904 (strlen (exec_name) + strlen (HOST_EXECUTABLE_SUFFIX) + 1);
2905
2906 strcpy (full_exec_name, exec_name);
2907 strcat (full_exec_name, HOST_EXECUTABLE_SUFFIX);
2908 ptr = __gnat_locate_executable_file (full_exec_name, path_val);
2909
2910 if (ptr == 0)
2911 return __gnat_locate_executable_file (exec_name, path_val);
2912 return ptr;
2913 }
2914 else
2915 return __gnat_locate_executable_file (exec_name, path_val);
2916 }
2917
2918 /* Locate an executable using the Systems default PATH. */
2919
2920 char *
__gnat_locate_exec_on_path(char * exec_name)2921 __gnat_locate_exec_on_path (char *exec_name)
2922 {
2923 char *apath_val;
2924
2925 #if defined (_WIN32) && !defined (RTX)
2926 TCHAR *wpath_val = _tgetenv (_T("PATH"));
2927 TCHAR *wapath_val;
2928 /* In Win32 systems we expand the PATH as for XP environment
2929 variables are not automatically expanded. We also prepend the
2930 ".;" to the path to match normal NT path search semantics */
2931
2932 #define EXPAND_BUFFER_SIZE 32767
2933
2934 wapath_val = (TCHAR *) alloca (EXPAND_BUFFER_SIZE);
2935
2936 wapath_val [0] = '.';
2937 wapath_val [1] = ';';
2938
2939 DWORD res = ExpandEnvironmentStrings
2940 (wpath_val, &wapath_val[2], EXPAND_BUFFER_SIZE - 2);
2941
2942 if (!res) wapath_val [0] = _T('\0');
2943
2944 apath_val = (char *) alloca (EXPAND_BUFFER_SIZE);
2945
2946 WS2SC (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
2947 return __gnat_locate_exec (exec_name, apath_val);
2948
2949 #else
2950
2951 #ifdef VMS
2952 char *path_val = "/VAXC$PATH";
2953 #else
2954 char *path_val = getenv ("PATH");
2955 #endif
2956 if (path_val == NULL) return NULL;
2957 apath_val = (char *) alloca (strlen (path_val) + 1);
2958 strcpy (apath_val, path_val);
2959 return __gnat_locate_exec (exec_name, apath_val);
2960 #endif
2961 }
2962
2963 #ifdef VMS
2964
2965 /* These functions are used to translate to and from VMS and Unix syntax
2966 file, directory and path specifications. */
2967
2968 #define MAXPATH 256
2969 #define MAXNAMES 256
2970 #define NEW_CANONICAL_FILELIST_INCREMENT 64
2971
2972 static char new_canonical_dirspec [MAXPATH];
2973 static char new_canonical_filespec [MAXPATH];
2974 static char new_canonical_pathspec [MAXNAMES*MAXPATH];
2975 static unsigned new_canonical_filelist_index;
2976 static unsigned new_canonical_filelist_in_use;
2977 static unsigned new_canonical_filelist_allocated;
2978 static char **new_canonical_filelist;
2979 static char new_host_pathspec [MAXNAMES*MAXPATH];
2980 static char new_host_dirspec [MAXPATH];
2981 static char new_host_filespec [MAXPATH];
2982
2983 /* Routine is called repeatedly by decc$from_vms via
2984 __gnat_to_canonical_file_list_init until it returns 0 or the expansion
2985 runs out. */
2986
2987 static int
wildcard_translate_unix(char * name)2988 wildcard_translate_unix (char *name)
2989 {
2990 char *ver;
2991 char buff [MAXPATH];
2992
2993 strncpy (buff, name, MAXPATH);
2994 buff [MAXPATH - 1] = (char) 0;
2995 ver = strrchr (buff, '.');
2996
2997 /* Chop off the version. */
2998 if (ver)
2999 *ver = 0;
3000
3001 /* Dynamically extend the allocation by the increment. */
3002 if (new_canonical_filelist_in_use == new_canonical_filelist_allocated)
3003 {
3004 new_canonical_filelist_allocated += NEW_CANONICAL_FILELIST_INCREMENT;
3005 new_canonical_filelist = (char **) xrealloc
3006 (new_canonical_filelist,
3007 new_canonical_filelist_allocated * sizeof (char *));
3008 }
3009
3010 new_canonical_filelist[new_canonical_filelist_in_use++] = xstrdup (buff);
3011
3012 return 1;
3013 }
3014
3015 /* Translate a wildcard VMS file spec into a list of Unix file specs. First do
3016 full translation and copy the results into a list (_init), then return them
3017 one at a time (_next). If onlydirs set, only expand directory files. */
3018
3019 int
__gnat_to_canonical_file_list_init(char * filespec,int onlydirs)3020 __gnat_to_canonical_file_list_init (char *filespec, int onlydirs)
3021 {
3022 int len;
3023 char buff [MAXPATH];
3024
3025 len = strlen (filespec);
3026 strncpy (buff, filespec, MAXPATH);
3027
3028 /* Only look for directories */
3029 if (onlydirs && !strstr (&buff [len-5], "*.dir"))
3030 strncat (buff, "*.dir", MAXPATH);
3031
3032 buff [MAXPATH - 1] = (char) 0;
3033
3034 decc$from_vms (buff, wildcard_translate_unix, 1);
3035
3036 /* Remove the .dir extension. */
3037 if (onlydirs)
3038 {
3039 int i;
3040 char *ext;
3041
3042 for (i = 0; i < new_canonical_filelist_in_use; i++)
3043 {
3044 ext = strstr (new_canonical_filelist[i], ".dir");
3045 if (ext)
3046 *ext = 0;
3047 }
3048 }
3049
3050 return new_canonical_filelist_in_use;
3051 }
3052
3053 /* Return the next filespec in the list. */
3054
3055 char *
__gnat_to_canonical_file_list_next()3056 __gnat_to_canonical_file_list_next ()
3057 {
3058 return new_canonical_filelist[new_canonical_filelist_index++];
3059 }
3060
3061 /* Free storage used in the wildcard expansion. */
3062
3063 void
__gnat_to_canonical_file_list_free()3064 __gnat_to_canonical_file_list_free ()
3065 {
3066 int i;
3067
3068 for (i = 0; i < new_canonical_filelist_in_use; i++)
3069 free (new_canonical_filelist[i]);
3070
3071 free (new_canonical_filelist);
3072
3073 new_canonical_filelist_in_use = 0;
3074 new_canonical_filelist_allocated = 0;
3075 new_canonical_filelist_index = 0;
3076 new_canonical_filelist = 0;
3077 }
3078
3079 /* The functional equivalent of decc$translate_vms routine.
3080 Designed to produce the same output, but is protected against
3081 malformed paths (original version ACCVIOs in this case) and
3082 does not require VMS-specific DECC RTL */
3083
3084 #define NAM$C_MAXRSS 1024
3085
3086 char *
__gnat_translate_vms(char * src)3087 __gnat_translate_vms (char *src)
3088 {
3089 static char retbuf [NAM$C_MAXRSS + 1];
3090 char *srcendpos, *pos1, *pos2, *retpos;
3091 int disp, path_present = 0;
3092
3093 if (!src)
3094 return NULL;
3095
3096 srcendpos = strchr (src, '\0');
3097 retpos = retbuf;
3098
3099 /* Look for the node and/or device in front of the path */
3100 pos1 = src;
3101 pos2 = strchr (pos1, ':');
3102
3103 if (pos2 && (pos2 < srcendpos) && (*(pos2 + 1) == ':'))
3104 {
3105 /* There is a node name. "node_name::" becomes "node_name!" */
3106 disp = pos2 - pos1;
3107 strncpy (retbuf, pos1, disp);
3108 retpos [disp] = '!';
3109 retpos = retpos + disp + 1;
3110 pos1 = pos2 + 2;
3111 pos2 = strchr (pos1, ':');
3112 }
3113
3114 if (pos2)
3115 {
3116 /* There is a device name. "dev_name:" becomes "/dev_name/" */
3117 *(retpos++) = '/';
3118 disp = pos2 - pos1;
3119 strncpy (retpos, pos1, disp);
3120 retpos = retpos + disp;
3121 pos1 = pos2 + 1;
3122 *(retpos++) = '/';
3123 }
3124 else
3125 /* No explicit device; we must look ahead and prepend /sys$disk/ if
3126 the path is absolute */
3127 if ((*pos1 == '[' || *pos1 == '<') && (pos1 < srcendpos)
3128 && !strchr (".-]>", *(pos1 + 1)))
3129 {
3130 strncpy (retpos, "/sys$disk/", 10);
3131 retpos += 10;
3132 }
3133
3134 /* Process the path part */
3135 while (*pos1 == '[' || *pos1 == '<')
3136 {
3137 path_present++;
3138 pos1++;
3139 if (*pos1 == ']' || *pos1 == '>')
3140 {
3141 /* Special case, [] translates to '.' */
3142 *(retpos++) = '.';
3143 pos1++;
3144 }
3145 else
3146 {
3147 /* '[000000' means root dir. It can be present in the middle of
3148 the path due to expansion of logical devices, in which case
3149 we skip it */
3150 if (!strncmp (pos1, "000000", 6) && path_present > 1 &&
3151 (*(pos1 + 6) == ']' || *(pos1 + 6) == '>' || *(pos1 + 6) == '.'))
3152 {
3153 pos1 += 6;
3154 if (*pos1 == '.') pos1++;
3155 }
3156 else if (*pos1 == '.')
3157 {
3158 /* Relative path */
3159 *(retpos++) = '.';
3160 }
3161
3162 /* There is a qualified path */
3163 while (*pos1 && *pos1 != ']' && *pos1 != '>')
3164 {
3165 switch (*pos1)
3166 {
3167 case '.':
3168 /* '.' is used to separate directories. Replace it with '/' but
3169 only if there isn't already '/' just before */
3170 if (*(retpos - 1) != '/')
3171 *(retpos++) = '/';
3172 pos1++;
3173 if (pos1 + 1 < srcendpos && *pos1 == '.' && *(pos1 + 1) == '.')
3174 {
3175 /* ellipsis refers to entire subtree; replace with '**' */
3176 *(retpos++) = '*';
3177 *(retpos++) = '*';
3178 *(retpos++) = '/';
3179 pos1 += 2;
3180 }
3181 break;
3182 case '-' :
3183 /* When after '.' '[' '<' is equivalent to Unix ".." but there
3184 may be several in a row */
3185 if (*(pos1 - 1) == '.' || *(pos1 - 1) == '[' ||
3186 *(pos1 - 1) == '<')
3187 {
3188 while (*pos1 == '-')
3189 {
3190 pos1++;
3191 *(retpos++) = '.';
3192 *(retpos++) = '.';
3193 *(retpos++) = '/';
3194 }
3195 retpos--;
3196 break;
3197 }
3198 /* otherwise fall through to default */
3199 default:
3200 *(retpos++) = *(pos1++);
3201 }
3202 }
3203 pos1++;
3204 }
3205 }
3206
3207 if (pos1 < srcendpos)
3208 {
3209 /* Now add the actual file name, until the version suffix if any */
3210 if (path_present)
3211 *(retpos++) = '/';
3212 pos2 = strchr (pos1, ';');
3213 disp = pos2? (pos2 - pos1) : (srcendpos - pos1);
3214 strncpy (retpos, pos1, disp);
3215 retpos += disp;
3216 if (pos2 && pos2 < srcendpos)
3217 {
3218 /* There is a non-empty version suffix. ";<ver>" becomes ".<ver>" */
3219 *retpos++ = '.';
3220 disp = srcendpos - pos2 - 1;
3221 strncpy (retpos, pos2 + 1, disp);
3222 retpos += disp;
3223 }
3224 }
3225
3226 *retpos = '\0';
3227
3228 return retbuf;
3229 }
3230
3231 /* Translate a VMS syntax directory specification in to Unix syntax. If
3232 PREFIXFLAG is set, append an underscore "/". If no indicators of VMS syntax
3233 found, return input string. Also translate a dirname that contains no
3234 slashes, in case it's a logical name. */
3235
3236 char *
__gnat_to_canonical_dir_spec(char * dirspec,int prefixflag)3237 __gnat_to_canonical_dir_spec (char *dirspec, int prefixflag)
3238 {
3239 int len;
3240
3241 strcpy (new_canonical_dirspec, "");
3242 if (strlen (dirspec))
3243 {
3244 char *dirspec1;
3245
3246 if (strchr (dirspec, ']') || strchr (dirspec, ':'))
3247 {
3248 strncpy (new_canonical_dirspec,
3249 __gnat_translate_vms (dirspec),
3250 MAXPATH);
3251 }
3252 else if (!strchr (dirspec, '/') && (dirspec1 = getenv (dirspec)) != 0)
3253 {
3254 strncpy (new_canonical_dirspec,
3255 __gnat_translate_vms (dirspec1),
3256 MAXPATH);
3257 }
3258 else
3259 {
3260 strncpy (new_canonical_dirspec, dirspec, MAXPATH);
3261 }
3262 }
3263
3264 len = strlen (new_canonical_dirspec);
3265 if (prefixflag && new_canonical_dirspec [len-1] != '/')
3266 strncat (new_canonical_dirspec, "/", MAXPATH);
3267
3268 new_canonical_dirspec [MAXPATH - 1] = (char) 0;
3269
3270 return new_canonical_dirspec;
3271
3272 }
3273
3274 /* Translate a VMS syntax file specification into Unix syntax.
3275 If no indicators of VMS syntax found, check if it's an uppercase
3276 alphanumeric_ name and if so try it out as an environment
3277 variable (logical name). If all else fails return the
3278 input string. */
3279
3280 char *
__gnat_to_canonical_file_spec(char * filespec)3281 __gnat_to_canonical_file_spec (char *filespec)
3282 {
3283 char *filespec1;
3284
3285 strncpy (new_canonical_filespec, "", MAXPATH);
3286
3287 if (strchr (filespec, ']') || strchr (filespec, ':'))
3288 {
3289 char *tspec = (char *) __gnat_translate_vms (filespec);
3290
3291 if (tspec != (char *) -1)
3292 strncpy (new_canonical_filespec, tspec, MAXPATH);
3293 }
3294 else if ((strlen (filespec) == strspn (filespec,
3295 "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"))
3296 && (filespec1 = getenv (filespec)))
3297 {
3298 char *tspec = (char *) __gnat_translate_vms (filespec1);
3299
3300 if (tspec != (char *) -1)
3301 strncpy (new_canonical_filespec, tspec, MAXPATH);
3302 }
3303 else
3304 {
3305 strncpy (new_canonical_filespec, filespec, MAXPATH);
3306 }
3307
3308 new_canonical_filespec [MAXPATH - 1] = (char) 0;
3309
3310 return new_canonical_filespec;
3311 }
3312
3313 /* Translate a VMS syntax path specification into Unix syntax.
3314 If no indicators of VMS syntax found, return input string. */
3315
3316 char *
__gnat_to_canonical_path_spec(char * pathspec)3317 __gnat_to_canonical_path_spec (char *pathspec)
3318 {
3319 char *curr, *next, buff [MAXPATH];
3320
3321 if (pathspec == 0)
3322 return pathspec;
3323
3324 /* If there are /'s, assume it's a Unix path spec and return. */
3325 if (strchr (pathspec, '/'))
3326 return pathspec;
3327
3328 new_canonical_pathspec[0] = 0;
3329 curr = pathspec;
3330
3331 for (;;)
3332 {
3333 next = strchr (curr, ',');
3334 if (next == 0)
3335 next = strchr (curr, 0);
3336
3337 strncpy (buff, curr, next - curr);
3338 buff[next - curr] = 0;
3339
3340 /* Check for wildcards and expand if present. */
3341 if (strchr (buff, '*') || strchr (buff, '%') || strstr (buff, "..."))
3342 {
3343 int i, dirs;
3344
3345 dirs = __gnat_to_canonical_file_list_init (buff, 1);
3346 for (i = 0; i < dirs; i++)
3347 {
3348 char *next_dir;
3349
3350 next_dir = __gnat_to_canonical_file_list_next ();
3351 strncat (new_canonical_pathspec, next_dir, MAXPATH);
3352
3353 /* Don't append the separator after the last expansion. */
3354 if (i+1 < dirs)
3355 strncat (new_canonical_pathspec, ":", MAXPATH);
3356 }
3357
3358 __gnat_to_canonical_file_list_free ();
3359 }
3360 else
3361 strncat (new_canonical_pathspec,
3362 __gnat_to_canonical_dir_spec (buff, 0), MAXPATH);
3363
3364 if (*next == 0)
3365 break;
3366
3367 strncat (new_canonical_pathspec, ":", MAXPATH);
3368 curr = next + 1;
3369 }
3370
3371 new_canonical_pathspec [MAXPATH - 1] = (char) 0;
3372
3373 return new_canonical_pathspec;
3374 }
3375
3376 static char filename_buff [MAXPATH];
3377
3378 static int
translate_unix(char * name,int type ATTRIBUTE_UNUSED)3379 translate_unix (char *name, int type ATTRIBUTE_UNUSED)
3380 {
3381 strncpy (filename_buff, name, MAXPATH);
3382 filename_buff [MAXPATH - 1] = (char) 0;
3383 return 0;
3384 }
3385
3386 /* Translate a Unix syntax directory specification into VMS syntax. The
3387 PREFIXFLAG has no effect, but is kept for symmetry with
3388 to_canonical_dir_spec. If indicators of VMS syntax found, return input
3389 string. */
3390
3391 char *
__gnat_to_host_dir_spec(char * dirspec,int prefixflag ATTRIBUTE_UNUSED)3392 __gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
3393 {
3394 int len = strlen (dirspec);
3395
3396 strncpy (new_host_dirspec, dirspec, MAXPATH);
3397 new_host_dirspec [MAXPATH - 1] = (char) 0;
3398
3399 if (strchr (new_host_dirspec, ']') || strchr (new_host_dirspec, ':'))
3400 return new_host_dirspec;
3401
3402 while (len > 1 && new_host_dirspec[len - 1] == '/')
3403 {
3404 new_host_dirspec[len - 1] = 0;
3405 len--;
3406 }
3407
3408 decc$to_vms (new_host_dirspec, translate_unix, 1, 2);
3409 strncpy (new_host_dirspec, filename_buff, MAXPATH);
3410 new_host_dirspec [MAXPATH - 1] = (char) 0;
3411
3412 return new_host_dirspec;
3413 }
3414
3415 /* Translate a Unix syntax file specification into VMS syntax.
3416 If indicators of VMS syntax found, return input string. */
3417
3418 char *
__gnat_to_host_file_spec(char * filespec)3419 __gnat_to_host_file_spec (char *filespec)
3420 {
3421 strncpy (new_host_filespec, "", MAXPATH);
3422 if (strchr (filespec, ']') || strchr (filespec, ':'))
3423 {
3424 strncpy (new_host_filespec, filespec, MAXPATH);
3425 }
3426 else
3427 {
3428 decc$to_vms (filespec, translate_unix, 1, 1);
3429 strncpy (new_host_filespec, filename_buff, MAXPATH);
3430 }
3431
3432 new_host_filespec [MAXPATH - 1] = (char) 0;
3433
3434 return new_host_filespec;
3435 }
3436
3437 void
__gnat_adjust_os_resource_limits()3438 __gnat_adjust_os_resource_limits ()
3439 {
3440 SYS$ADJWSL (131072, 0);
3441 }
3442
3443 #else /* VMS */
3444
3445 /* Dummy functions for Osint import for non-VMS systems. */
3446
3447 int
__gnat_to_canonical_file_list_init(char * dirspec ATTRIBUTE_UNUSED,int onlydirs ATTRIBUTE_UNUSED)3448 __gnat_to_canonical_file_list_init
3449 (char *dirspec ATTRIBUTE_UNUSED, int onlydirs ATTRIBUTE_UNUSED)
3450 {
3451 return 0;
3452 }
3453
3454 char *
__gnat_to_canonical_file_list_next(void)3455 __gnat_to_canonical_file_list_next (void)
3456 {
3457 static char empty[] = "";
3458 return empty;
3459 }
3460
3461 void
__gnat_to_canonical_file_list_free(void)3462 __gnat_to_canonical_file_list_free (void)
3463 {
3464 }
3465
3466 char *
__gnat_to_canonical_dir_spec(char * dirspec,int prefixflag ATTRIBUTE_UNUSED)3467 __gnat_to_canonical_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
3468 {
3469 return dirspec;
3470 }
3471
3472 char *
__gnat_to_canonical_file_spec(char * filespec)3473 __gnat_to_canonical_file_spec (char *filespec)
3474 {
3475 return filespec;
3476 }
3477
3478 char *
__gnat_to_canonical_path_spec(char * pathspec)3479 __gnat_to_canonical_path_spec (char *pathspec)
3480 {
3481 return pathspec;
3482 }
3483
3484 char *
__gnat_to_host_dir_spec(char * dirspec,int prefixflag ATTRIBUTE_UNUSED)3485 __gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
3486 {
3487 return dirspec;
3488 }
3489
3490 char *
__gnat_to_host_file_spec(char * filespec)3491 __gnat_to_host_file_spec (char *filespec)
3492 {
3493 return filespec;
3494 }
3495
3496 void
__gnat_adjust_os_resource_limits(void)3497 __gnat_adjust_os_resource_limits (void)
3498 {
3499 }
3500
3501 #endif
3502
3503 #if defined (__mips_vxworks)
3504 int
_flush_cache()3505 _flush_cache()
3506 {
3507 CACHE_USER_FLUSH (0, ENTIRE_CACHE);
3508 }
3509 #endif
3510
3511 #if defined (IS_CROSS) \
3512 || (! ((defined (sparc) || defined (i386)) && defined (sun) \
3513 && defined (__SVR4)) \
3514 && ! (defined (linux) && (defined (i386) || defined (__x86_64__))) \
3515 && ! (defined (linux) && defined (__ia64__)) \
3516 && ! (defined (linux) && defined (powerpc)) \
3517 && ! defined (__FreeBSD__) \
3518 && ! defined (__Lynx__) \
3519 && ! defined (__hpux__) \
3520 && ! defined (__APPLE__) \
3521 && ! defined (_AIX) \
3522 && ! defined (VMS) \
3523 && ! defined (__MINGW32__))
3524
3525 /* Dummy function to satisfy g-trasym.o. See the preprocessor conditional
3526 just above for a list of native platforms that provide a non-dummy
3527 version of this procedure in libaddr2line.a. */
3528
3529 void
convert_addresses(const char * file_name ATTRIBUTE_UNUSED,void * addrs ATTRIBUTE_UNUSED,int n_addr ATTRIBUTE_UNUSED,void * buf ATTRIBUTE_UNUSED,int * len ATTRIBUTE_UNUSED)3530 convert_addresses (const char *file_name ATTRIBUTE_UNUSED,
3531 void *addrs ATTRIBUTE_UNUSED,
3532 int n_addr ATTRIBUTE_UNUSED,
3533 void *buf ATTRIBUTE_UNUSED,
3534 int *len ATTRIBUTE_UNUSED)
3535 {
3536 *len = 0;
3537 }
3538 #endif
3539
3540 #if defined (_WIN32)
3541 int __gnat_argument_needs_quote = 1;
3542 #else
3543 int __gnat_argument_needs_quote = 0;
3544 #endif
3545
3546 /* This option is used to enable/disable object files handling from the
3547 binder file by the GNAT Project module. For example, this is disabled on
3548 Windows (prior to GCC 3.4) as it is already done by the mdll module.
3549 Stating with GCC 3.4 the shared libraries are not based on mdll
3550 anymore as it uses the GCC's -shared option */
3551 #if defined (_WIN32) \
3552 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
3553 int __gnat_prj_add_obj_files = 0;
3554 #else
3555 int __gnat_prj_add_obj_files = 1;
3556 #endif
3557
3558 /* char used as prefix/suffix for environment variables */
3559 #if defined (_WIN32)
3560 char __gnat_environment_char = '%';
3561 #else
3562 char __gnat_environment_char = '$';
3563 #endif
3564
3565 /* This functions copy the file attributes from a source file to a
3566 destination file.
3567
3568 mode = 0 : In this mode copy only the file time stamps (last access and
3569 last modification time stamps).
3570
3571 mode = 1 : In this mode, time stamps and read/write/execute attributes are
3572 copied.
3573
3574 Returns 0 if operation was successful and -1 in case of error. */
3575
3576 int
__gnat_copy_attribs(char * from ATTRIBUTE_UNUSED,char * to ATTRIBUTE_UNUSED,int mode ATTRIBUTE_UNUSED)3577 __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED, char *to ATTRIBUTE_UNUSED,
3578 int mode ATTRIBUTE_UNUSED)
3579 {
3580 #if defined (VMS) || (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) || \
3581 defined (__nucleus__)
3582 return -1;
3583
3584 #elif defined (_WIN32) && !defined (RTX)
3585 TCHAR wfrom [GNAT_MAX_PATH_LEN + 2];
3586 TCHAR wto [GNAT_MAX_PATH_LEN + 2];
3587 BOOL res;
3588 FILETIME fct, flat, flwt;
3589 HANDLE hfrom, hto;
3590
3591 S2WSC (wfrom, from, GNAT_MAX_PATH_LEN + 2);
3592 S2WSC (wto, to, GNAT_MAX_PATH_LEN + 2);
3593
3594 /* retrieve from times */
3595
3596 hfrom = CreateFile
3597 (wfrom, GENERIC_READ, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
3598
3599 if (hfrom == INVALID_HANDLE_VALUE)
3600 return -1;
3601
3602 res = GetFileTime (hfrom, &fct, &flat, &flwt);
3603
3604 CloseHandle (hfrom);
3605
3606 if (res == 0)
3607 return -1;
3608
3609 /* retrieve from times */
3610
3611 hto = CreateFile
3612 (wto, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
3613
3614 if (hto == INVALID_HANDLE_VALUE)
3615 return -1;
3616
3617 res = SetFileTime (hto, NULL, &flat, &flwt);
3618
3619 CloseHandle (hto);
3620
3621 if (res == 0)
3622 return -1;
3623
3624 /* Set file attributes in full mode. */
3625
3626 if (mode == 1)
3627 {
3628 DWORD attribs = GetFileAttributes (wfrom);
3629
3630 if (attribs == INVALID_FILE_ATTRIBUTES)
3631 return -1;
3632
3633 res = SetFileAttributes (wto, attribs);
3634 if (res == 0)
3635 return -1;
3636 }
3637
3638 return 0;
3639
3640 #else
3641 GNAT_STRUCT_STAT fbuf;
3642 struct utimbuf tbuf;
3643
3644 if (GNAT_STAT (from, &fbuf) == -1)
3645 {
3646 return -1;
3647 }
3648
3649 tbuf.actime = fbuf.st_atime;
3650 tbuf.modtime = fbuf.st_mtime;
3651
3652 if (utime (to, &tbuf) == -1)
3653 {
3654 return -1;
3655 }
3656
3657 if (mode == 1)
3658 {
3659 if (chmod (to, fbuf.st_mode) == -1)
3660 {
3661 return -1;
3662 }
3663 }
3664
3665 return 0;
3666 #endif
3667 }
3668
3669 int
__gnat_lseek(int fd,long offset,int whence)3670 __gnat_lseek (int fd, long offset, int whence)
3671 {
3672 return (int) lseek (fd, offset, whence);
3673 }
3674
3675 /* This function returns the major version number of GCC being used. */
3676 int
get_gcc_version(void)3677 get_gcc_version (void)
3678 {
3679 #ifdef IN_RTS
3680 return __GNUC__;
3681 #else
3682 return (int) (version_string[0] - '0');
3683 #endif
3684 }
3685
3686 int
__gnat_set_close_on_exec(int fd ATTRIBUTE_UNUSED,int close_on_exec_p ATTRIBUTE_UNUSED)3687 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED,
3688 int close_on_exec_p ATTRIBUTE_UNUSED)
3689 {
3690 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
3691 int flags = fcntl (fd, F_GETFD, 0);
3692 if (flags < 0)
3693 return flags;
3694 if (close_on_exec_p)
3695 flags |= FD_CLOEXEC;
3696 else
3697 flags &= ~FD_CLOEXEC;
3698 return fcntl (fd, F_SETFD, flags | FD_CLOEXEC);
3699 #elif defined(_WIN32)
3700 HANDLE h = (HANDLE) _get_osfhandle (fd);
3701 if (h == (HANDLE) -1)
3702 return -1;
3703 if (close_on_exec_p)
3704 return ! SetHandleInformation (h, HANDLE_FLAG_INHERIT, 0);
3705 return ! SetHandleInformation (h, HANDLE_FLAG_INHERIT,
3706 HANDLE_FLAG_INHERIT);
3707 #else
3708 /* TODO: Unimplemented. */
3709 return -1;
3710 #endif
3711 }
3712
3713 /* Indicates if platforms supports automatic initialization through the
3714 constructor mechanism */
3715 int
__gnat_binder_supports_auto_init(void)3716 __gnat_binder_supports_auto_init (void)
3717 {
3718 #ifdef VMS
3719 return 0;
3720 #else
3721 return 1;
3722 #endif
3723 }
3724
3725 /* Indicates that Stand-Alone Libraries are automatically initialized through
3726 the constructor mechanism */
3727 int
__gnat_sals_init_using_constructors(void)3728 __gnat_sals_init_using_constructors (void)
3729 {
3730 #if defined (__vxworks) || defined (__Lynx__) || defined (VMS)
3731 return 0;
3732 #else
3733 return 1;
3734 #endif
3735 }
3736
3737 #ifdef RTX
3738
3739 /* In RTX mode, the procedure to get the time (as file time) is different
3740 in RTSS mode and Win32 mode. In order to avoid duplicating an Ada file,
3741 we introduce an intermediate procedure to link against the corresponding
3742 one in each situation. */
3743
3744 extern void GetTimeAsFileTime(LPFILETIME pTime);
3745
GetTimeAsFileTime(LPFILETIME pTime)3746 void GetTimeAsFileTime(LPFILETIME pTime)
3747 {
3748 #ifdef RTSS
3749 RtGetRtssTimeAsFileTime (pTime); /* RTSS interface */
3750 #else
3751 GetSystemTimeAsFileTime (pTime); /* w32 interface */
3752 #endif
3753 }
3754
3755 #ifdef RTSS
3756 /* Add symbol that is required to link. It would otherwise be taken from
3757 libgcc.a and it would try to use the gcc constructors that are not
3758 supported by Microsoft linker. */
3759
3760 extern void __main (void);
3761
__main(void)3762 void __main (void) {}
3763 #endif
3764 #endif
3765
3766 #if defined (__ANDROID__)
3767
3768 #include <pthread.h>
3769
__gnat_lwp_self(void)3770 void *__gnat_lwp_self (void)
3771 {
3772 return (void *) pthread_self ();
3773 }
3774
3775 #elif defined (linux)
3776 /* There is no function in the glibc to retrieve the LWP of the current
3777 thread. We need to do a system call in order to retrieve this
3778 information. */
3779 #include <sys/syscall.h>
__gnat_lwp_self(void)3780 void *__gnat_lwp_self (void)
3781 {
3782 return (void *) syscall (__NR_gettid);
3783 }
3784
3785 #include <sched.h>
3786
3787 /* glibc versions earlier than 2.7 do not define the routines to handle
3788 dynamically allocated CPU sets. For these targets, we use the static
3789 versions. */
3790
3791 #ifdef CPU_ALLOC
3792
3793 /* Dynamic cpu sets */
3794
__gnat_cpu_alloc(size_t count)3795 cpu_set_t *__gnat_cpu_alloc (size_t count)
3796 {
3797 return CPU_ALLOC (count);
3798 }
3799
__gnat_cpu_alloc_size(size_t count)3800 size_t __gnat_cpu_alloc_size (size_t count)
3801 {
3802 return CPU_ALLOC_SIZE (count);
3803 }
3804
__gnat_cpu_free(cpu_set_t * set)3805 void __gnat_cpu_free (cpu_set_t *set)
3806 {
3807 CPU_FREE (set);
3808 }
3809
__gnat_cpu_zero(size_t count,cpu_set_t * set)3810 void __gnat_cpu_zero (size_t count, cpu_set_t *set)
3811 {
3812 CPU_ZERO_S (count, set);
3813 }
3814
__gnat_cpu_set(int cpu,size_t count,cpu_set_t * set)3815 void __gnat_cpu_set (int cpu, size_t count, cpu_set_t *set)
3816 {
3817 /* Ada handles CPU numbers starting from 1, while C identifies the first
3818 CPU by a 0, so we need to adjust. */
3819 CPU_SET_S (cpu - 1, count, set);
3820 }
3821
3822 #else
3823
3824 /* Static cpu sets */
3825
__gnat_cpu_alloc(size_t count ATTRIBUTE_UNUSED)3826 cpu_set_t *__gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED)
3827 {
3828 return (cpu_set_t *) xmalloc (sizeof (cpu_set_t));
3829 }
3830
__gnat_cpu_alloc_size(size_t count ATTRIBUTE_UNUSED)3831 size_t __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED)
3832 {
3833 return sizeof (cpu_set_t);
3834 }
3835
__gnat_cpu_free(cpu_set_t * set)3836 void __gnat_cpu_free (cpu_set_t *set)
3837 {
3838 free (set);
3839 }
3840
__gnat_cpu_zero(size_t count ATTRIBUTE_UNUSED,cpu_set_t * set)3841 void __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
3842 {
3843 CPU_ZERO (set);
3844 }
3845
__gnat_cpu_set(int cpu,size_t count ATTRIBUTE_UNUSED,cpu_set_t * set)3846 void __gnat_cpu_set (int cpu, size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
3847 {
3848 /* Ada handles CPU numbers starting from 1, while C identifies the first
3849 CPU by a 0, so we need to adjust. */
3850 CPU_SET (cpu - 1, set);
3851 }
3852 #endif
3853 #endif
3854
3855 #ifdef __cplusplus
3856 }
3857 #endif
3858