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