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