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