1 /****************************************************************************
3 * GNAT COMPILER COMPONENTS *
7 * C Implementation File *
9 * Copyright (C) 1992-2011, Free Software Foundation, Inc. *
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. *
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. *
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/>. *
27 * GNAT was originally developed by the GNAT team at New York University. *
28 * Extensive contributions were provided by Ada Core Technologies Inc. *
30 ****************************************************************************/
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. */
43 /* No need to redefine exit here. */
46 /* We want to use the POSIX variants of include files. */
50 #if defined (__mips_vxworks)
52 #endif /* __mips_vxworks */
54 /* If SMP, access vxCpuConfiguredGet */
55 #ifdef _WRS_CONFIG_SMP
57 #endif /* _WRS_CONFIG_SMP */
59 /* We need to know the VxWorks version because some file operations
60 (such as chmod) are only available on VxWorks 6. */
65 #if (defined (__mips) && defined (__sgi)) || defined (__APPLE__)
69 #if defined (__hpux__)
70 #include <sys/param.h>
71 #include <sys/pstat.h>
76 #define HOST_EXECUTABLE_SUFFIX ".exe"
77 #define HOST_OBJECT_SUFFIX ".obj"
92 /* S_IREAD and S_IWRITE are not defined in VxWorks */
94 #define S_IREAD (S_IRUSR | S_IRGRP | S_IROTH)
98 #define S_IWRITE (S_IWUSR)
102 /* We don't have libiberty, so use malloc. */
103 #define xmalloc(S) malloc (S)
104 #define xrealloc(V,S) realloc (V,S)
111 #if defined (__MINGW32__)
119 /* Current code page to use, set in initialize.c. */
120 UINT CurrentCodePage;
123 #include <sys/utime.h>
125 /* For isalpha-like tests in the compiler, we're expected to resort to
126 safe-ctype.h/ISALPHA. This isn't available for the runtime library
127 build, so we fallback on ctype.h/isalpha there. */
131 #define ISALPHA isalpha
134 #elif defined (__Lynx__)
136 /* Lynx utime.h only defines the entities of interest to us if
137 defined (VMOS_DEV), so ... */
146 /* wait.h processing */
149 #include <sys/wait.h>
151 #elif defined (__vxworks) && defined (__RTP__)
153 #elif defined (__Lynx__)
154 /* ??? We really need wait.h and it includes resource.h on Lynx. GCC
155 has a resource.h header as well, included instead of the lynx
156 version in our setup, causing lots of errors. We don't really need
157 the lynx contents of this file, so just workaround the issue by
158 preventing the inclusion of the GCC header from doing anything. */
159 #define GCC_RESOURCE_H
160 #include <sys/wait.h>
161 #elif defined (__nucleus__)
162 /* No wait() or waitpid() calls available */
165 #include <sys/wait.h>
171 /* Header files and definitions for __gnat_set_file_time_name. */
173 #define __NEW_STARLET 1
175 #include <vms/atrdef.h>
176 #include <vms/fibdef.h>
177 #include <vms/stsdef.h>
178 #include <vms/iodef.h>
180 #include <vms/descrip.h>
184 /* Use native 64-bit arithmetic. */
185 #define unix_time_to_vms(X,Y) \
186 { unsigned long long reftime, tmptime = (X); \
187 $DESCRIPTOR (unixtime,"1-JAN-1970 0:00:00.00"); \
188 SYS$BINTIM (&unixtime, &reftime); \
189 Y = tmptime * 10000000 + reftime; }
191 /* descrip.h doesn't have everything ... */
192 typedef struct fibdef* __fibdef_ptr32 __attribute__ (( mode (SI) ));
193 struct dsc$descriptor_fib
195 unsigned int fib$l_len;
196 __fibdef_ptr32 fib$l_addr;
199 /* I/O Status Block. */
202 unsigned short status, count;
206 static char *tryfile;
208 /* Variable length string. */
212 char string[NAM$C_MAXRSS+1];
215 #define SYI$_ACTIVECPU_CNT 0x111e
216 extern int LIB$GETSYI (int *, unsigned int *);
233 #define DIR_SEPARATOR '\\'
238 /* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
239 defined in the current system. On DOS-like systems these flags control
240 whether the file is opened/created in text-translation mode (CR/LF in
241 external file mapped to LF in internal file), but in Unix-like systems,
242 no text translation is required, so these flags have no effect. */
252 #ifndef HOST_EXECUTABLE_SUFFIX
253 #define HOST_EXECUTABLE_SUFFIX ""
256 #ifndef HOST_OBJECT_SUFFIX
257 #define HOST_OBJECT_SUFFIX ".o"
260 #ifndef PATH_SEPARATOR
261 #define PATH_SEPARATOR ':'
264 #ifndef DIR_SEPARATOR
265 #define DIR_SEPARATOR '/'
268 /* Check for cross-compilation */
269 #if defined (CROSS_COMPILE) || defined (CROSS_DIRECTORY_STRUCTURE)
271 int __gnat_is_cross_compiler = 1;
274 int __gnat_is_cross_compiler = 0;
277 char __gnat_dir_separator = DIR_SEPARATOR;
279 char __gnat_path_separator = PATH_SEPARATOR;
281 /* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
282 the base filenames that libraries specified with -lsomelib options
283 may have. This is used by GNATMAKE to check whether an executable
284 is up-to-date or not. The syntax is
286 library_template ::= { pattern ; } pattern NUL
287 pattern ::= [ prefix ] * [ postfix ]
289 These should only specify names of static libraries as it makes
290 no sense to determine at link time if dynamic-link libraries are
291 up to date or not. Any libraries that are not found are supposed
294 * if they are needed but not present, the link
297 * otherwise they are libraries in the system paths and so
298 they are considered part of the system and not checked
301 ??? This should be part of a GNAT host-specific compiler
302 file instead of being included in all user applications
303 as well. This is only a temporary work-around for 3.11b. */
305 #ifndef GNAT_LIBRARY_TEMPLATE
307 #define GNAT_LIBRARY_TEMPLATE "*.olb"
309 #define GNAT_LIBRARY_TEMPLATE "lib*.a"
313 const char *__gnat_library_template = GNAT_LIBRARY_TEMPLATE;
315 /* This variable is used in hostparm.ads to say whether the host is a VMS
324 #define GNAT_MAX_PATH_LEN 256 /* PATH_MAX */
326 #elif defined (__vxworks) || defined (__OPENNT) || defined(__nucleus__)
327 #define GNAT_MAX_PATH_LEN PATH_MAX
331 #if defined (__MINGW32__)
335 #include <sys/param.h>
339 #include <sys/param.h>
343 #define GNAT_MAX_PATH_LEN MAXPATHLEN
345 #define GNAT_MAX_PATH_LEN 256
350 /* Used for Ada bindings */
351 int __gnat_size_of_file_attributes = sizeof (struct file_attributes);
353 /* Reset the file attributes as if no system call had been performed */
354 void __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr);
356 /* The __gnat_max_path_len variable is used to export the maximum
357 length of a path name to Ada code. max_path_len is also provided
358 for compatibility with older GNAT versions, please do not use
361 int __gnat_max_path_len = GNAT_MAX_PATH_LEN;
362 int max_path_len = GNAT_MAX_PATH_LEN;
364 /* Control whether we can use ACL on Windows. */
366 int __gnat_use_acl = 1;
368 /* The following macro HAVE_READDIR_R should be defined if the
369 system provides the routine readdir_r. */
370 #undef HAVE_READDIR_R
372 #if defined(VMS) && defined (__LONG_POINTERS)
374 /* Return a 32 bit pointer to an array of 32 bit pointers
375 given a 64 bit pointer to an array of 64 bit pointers */
377 typedef __char_ptr32 *__char_ptr_char_ptr32 __attribute__ ((mode (SI)));
379 static __char_ptr_char_ptr32
380 to_ptr32 (char **ptr64)
383 __char_ptr_char_ptr32 short_argv;
385 for (argc=0; ptr64[argc]; argc++);
387 /* Reallocate argv with 32 bit pointers. */
388 short_argv = (__char_ptr_char_ptr32) decc$malloc
389 (sizeof (__char_ptr32) * (argc + 1));
391 for (argc=0; ptr64[argc]; argc++)
392 short_argv[argc] = (__char_ptr32) decc$strdup (ptr64[argc]);
394 short_argv[argc] = (__char_ptr32) 0;
398 #define MAYBE_TO_PTR32(argv) to_ptr32 (argv)
400 #define MAYBE_TO_PTR32(argv) argv
403 static const char ATTR_UNSET = 127;
406 __gnat_reset_attributes
407 (struct file_attributes* attr)
409 attr->exists = ATTR_UNSET;
411 attr->writable = ATTR_UNSET;
412 attr->readable = ATTR_UNSET;
413 attr->executable = ATTR_UNSET;
415 attr->regular = ATTR_UNSET;
416 attr->symbolic_link = ATTR_UNSET;
417 attr->directory = ATTR_UNSET;
419 attr->timestamp = (OS_Time)-2;
420 attr->file_length = -1;
427 time_t res = time (NULL);
428 return (OS_Time) res;
431 /* Return the current local time as a string in the ISO 8601 format of
432 "YYYY-MM-DD HH:MM:SS.SS". The returned string is 22 + 1 (NULL) characters
436 __gnat_current_time_string
439 const char *format = "%Y-%m-%d %H:%M:%S";
440 /* Format string necessary to describe the ISO 8601 format */
442 const time_t t_val = time (NULL);
444 strftime (result, 22, format, localtime (&t_val));
445 /* Convert the local time into a string following the ISO format, copying
446 at most 22 characters into the result string. */
451 /* The sub-seconds are manually set to zero since type time_t lacks the
452 precision necessary for nanoseconds. */
466 time_t time = (time_t) *p_time;
469 /* On Windows systems, the time is sometimes rounded up to the nearest
470 even second, so if the number of seconds is odd, increment it. */
476 res = localtime (&time);
478 res = gmtime (&time);
483 *p_year = res->tm_year;
484 *p_month = res->tm_mon;
485 *p_day = res->tm_mday;
486 *p_hours = res->tm_hour;
487 *p_mins = res->tm_min;
488 *p_secs = res->tm_sec;
491 *p_year = *p_month = *p_day = *p_hours = *p_mins = *p_secs = 0;
494 /* Place the contents of the symbolic link named PATH in the buffer BUF,
495 which has size BUFSIZ. If PATH is a symbolic link, then return the number
496 of characters of its content in BUF. Otherwise, return -1.
497 For systems not supporting symbolic links, always return -1. */
500 __gnat_readlink (char *path ATTRIBUTE_UNUSED,
501 char *buf ATTRIBUTE_UNUSED,
502 size_t bufsiz ATTRIBUTE_UNUSED)
504 #if defined (_WIN32) || defined (VMS) \
505 || defined(__vxworks) || defined (__nucleus__)
508 return readlink (path, buf, bufsiz);
512 /* Creates a symbolic link named NEWPATH which contains the string OLDPATH.
513 If NEWPATH exists it will NOT be overwritten.
514 For systems not supporting symbolic links, always return -1. */
517 __gnat_symlink (char *oldpath ATTRIBUTE_UNUSED,
518 char *newpath ATTRIBUTE_UNUSED)
520 #if defined (_WIN32) || defined (VMS) \
521 || defined(__vxworks) || defined (__nucleus__)
524 return symlink (oldpath, newpath);
528 /* Try to lock a file, return 1 if success. */
530 #if defined (__vxworks) || defined (__nucleus__) \
531 || defined (_WIN32) || defined (VMS)
533 /* Version that does not use link. */
536 __gnat_try_lock (char *dir, char *file)
540 TCHAR wfull_path[GNAT_MAX_PATH_LEN];
541 TCHAR wfile[GNAT_MAX_PATH_LEN];
542 TCHAR wdir[GNAT_MAX_PATH_LEN];
544 S2WSC (wdir, dir, GNAT_MAX_PATH_LEN);
545 S2WSC (wfile, file, GNAT_MAX_PATH_LEN);
547 _stprintf (wfull_path, _T("%s%c%s"), wdir, _T(DIR_SEPARATOR), wfile);
548 fd = _topen (wfull_path, O_CREAT | O_EXCL, 0600);
552 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
553 fd = open (full_path, O_CREAT | O_EXCL, 0600);
565 /* Version using link(), more secure over NFS. */
566 /* See TN 6913-016 for discussion ??? */
569 __gnat_try_lock (char *dir, char *file)
573 GNAT_STRUCT_STAT stat_result;
576 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
577 sprintf (temp_file, "%s%cTMP-%ld-%ld",
578 dir, DIR_SEPARATOR, (long)getpid(), (long)getppid ());
580 /* Create the temporary file and write the process number. */
581 fd = open (temp_file, O_CREAT | O_WRONLY, 0600);
587 /* Link it with the new file. */
588 link (temp_file, full_path);
590 /* Count the references on the old one. If we have a count of two, then
591 the link did succeed. Remove the temporary file before returning. */
592 __gnat_stat (temp_file, &stat_result);
594 return stat_result.st_nlink == 2;
598 /* Return the maximum file name length. */
601 __gnat_get_maximum_file_name_length (void)
604 if (getenv ("GNAT$EXTENDED_FILE_SPECIFICATIONS"))
613 /* Return nonzero if file names are case sensitive. */
615 static int file_names_case_sensitive_cache = -1;
618 __gnat_get_file_names_case_sensitive (void)
620 if (file_names_case_sensitive_cache == -1)
622 const char *sensitive = getenv ("GNAT_FILE_NAME_CASE_SENSITIVE");
624 if (sensitive != NULL
625 && (sensitive[0] == '0' || sensitive[0] == '1')
626 && sensitive[1] == '\0')
627 file_names_case_sensitive_cache = sensitive[0] - '0';
629 #if defined (VMS) || defined (WINNT) || defined (__APPLE__)
630 file_names_case_sensitive_cache = 0;
632 file_names_case_sensitive_cache = 1;
635 return file_names_case_sensitive_cache;
638 /* Return nonzero if environment variables are case sensitive. */
641 __gnat_get_env_vars_case_sensitive (void)
643 #if defined (VMS) || defined (WINNT)
651 __gnat_get_default_identifier_character_set (void)
656 /* Return the current working directory. */
659 __gnat_get_current_dir (char *dir, int *length)
661 #if defined (__MINGW32__)
662 TCHAR wdir[GNAT_MAX_PATH_LEN];
664 _tgetcwd (wdir, *length);
666 WS2SC (dir, wdir, GNAT_MAX_PATH_LEN);
669 /* Force Unix style, which is what GNAT uses internally. */
670 getcwd (dir, *length, 0);
672 getcwd (dir, *length);
675 *length = strlen (dir);
677 if (dir [*length - 1] != DIR_SEPARATOR)
679 dir [*length] = DIR_SEPARATOR;
685 /* Return the suffix for object files. */
688 __gnat_get_object_suffix_ptr (int *len, const char **value)
690 *value = HOST_OBJECT_SUFFIX;
695 *len = strlen (*value);
700 /* Return the suffix for executable files. */
703 __gnat_get_executable_suffix_ptr (int *len, const char **value)
705 *value = HOST_EXECUTABLE_SUFFIX;
709 *len = strlen (*value);
714 /* Return the suffix for debuggable files. Usually this is the same as the
715 executable extension. */
718 __gnat_get_debuggable_suffix_ptr (int *len, const char **value)
720 *value = HOST_EXECUTABLE_SUFFIX;
725 *len = strlen (*value);
730 /* Returns the OS filename and corresponding encoding. */
733 __gnat_os_filename (char *filename ATTRIBUTE_UNUSED,
734 char *w_filename ATTRIBUTE_UNUSED,
735 char *os_name, int *o_length,
736 char *encoding ATTRIBUTE_UNUSED, int *e_length)
738 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
739 WS2SC (os_name, (TCHAR *)w_filename, (DWORD)*o_length);
740 *o_length = strlen (os_name);
741 strcpy (encoding, "encoding=utf8");
742 *e_length = strlen (encoding);
744 strcpy (os_name, filename);
745 *o_length = strlen (filename);
753 __gnat_unlink (char *path)
755 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
757 TCHAR wpath[GNAT_MAX_PATH_LEN];
759 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
760 return _tunlink (wpath);
763 return unlink (path);
770 __gnat_rename (char *from, char *to)
772 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
774 TCHAR wfrom[GNAT_MAX_PATH_LEN], wto[GNAT_MAX_PATH_LEN];
776 S2WSC (wfrom, from, GNAT_MAX_PATH_LEN);
777 S2WSC (wto, to, GNAT_MAX_PATH_LEN);
778 return _trename (wfrom, wto);
781 return rename (from, to);
785 /* Changing directory. */
788 __gnat_chdir (char *path)
790 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
792 TCHAR wpath[GNAT_MAX_PATH_LEN];
794 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
795 return _tchdir (wpath);
802 /* Removing a directory. */
805 __gnat_rmdir (char *path)
807 #if defined (__MINGW32__) && ! defined (__vxworks) && ! defined (IS_CROSS)
809 TCHAR wpath[GNAT_MAX_PATH_LEN];
811 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
812 return _trmdir (wpath);
814 #elif defined (VTHREADS)
815 /* rmdir not available */
823 __gnat_fopen (char *path, char *mode, int encoding ATTRIBUTE_UNUSED)
825 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
826 TCHAR wpath[GNAT_MAX_PATH_LEN];
829 S2WS (wmode, mode, 10);
831 if (encoding == Encoding_Unspecified)
832 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
833 else if (encoding == Encoding_UTF8)
834 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
836 S2WS (wpath, path, GNAT_MAX_PATH_LEN);
838 return _tfopen (wpath, wmode);
840 return decc$fopen (path, mode);
842 return GNAT_FOPEN (path, mode);
847 __gnat_freopen (char *path,
850 int encoding ATTRIBUTE_UNUSED)
852 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
853 TCHAR wpath[GNAT_MAX_PATH_LEN];
856 S2WS (wmode, mode, 10);
858 if (encoding == Encoding_Unspecified)
859 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
860 else if (encoding == Encoding_UTF8)
861 S2WSU (wpath, path, GNAT_MAX_PATH_LEN);
863 S2WS (wpath, path, GNAT_MAX_PATH_LEN);
865 return _tfreopen (wpath, wmode, stream);
867 return decc$freopen (path, mode, stream);
869 return freopen (path, mode, stream);
874 __gnat_open_read (char *path, int fmode)
877 int o_fmode = O_BINARY;
883 /* Optional arguments mbc,deq,fop increase read performance. */
884 fd = open (path, O_RDONLY | o_fmode, 0444,
885 "mbc=16", "deq=64", "fop=tef");
886 #elif defined (__vxworks)
887 fd = open (path, O_RDONLY | o_fmode, 0444);
888 #elif defined (__MINGW32__)
890 TCHAR wpath[GNAT_MAX_PATH_LEN];
892 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
893 fd = _topen (wpath, O_RDONLY | o_fmode, 0444);
896 fd = open (path, O_RDONLY | o_fmode);
899 return fd < 0 ? -1 : fd;
902 #if defined (__MINGW32__)
903 #define PERM (S_IREAD | S_IWRITE)
905 /* Excerpt from DECC C RTL Reference Manual:
906 To create files with OpenVMS RMS default protections using the UNIX
907 system-call functions umask, mkdir, creat, and open, call mkdir, creat,
908 and open with a file-protection mode argument of 0777 in a program
909 that never specifically calls umask. These default protections include
910 correctly establishing protections based on ACLs, previous versions of
914 #define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
918 __gnat_open_rw (char *path, int fmode)
921 int o_fmode = O_BINARY;
927 fd = open (path, O_RDWR | o_fmode, PERM,
928 "mbc=16", "deq=64", "fop=tef");
929 #elif defined (__MINGW32__)
931 TCHAR wpath[GNAT_MAX_PATH_LEN];
933 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
934 fd = _topen (wpath, O_RDWR | o_fmode, PERM);
937 fd = open (path, O_RDWR | o_fmode, PERM);
940 return fd < 0 ? -1 : fd;
944 __gnat_open_create (char *path, int fmode)
947 int o_fmode = O_BINARY;
953 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM,
954 "mbc=16", "deq=64", "fop=tef");
955 #elif defined (__MINGW32__)
957 TCHAR wpath[GNAT_MAX_PATH_LEN];
959 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
960 fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
963 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
966 return fd < 0 ? -1 : fd;
970 __gnat_create_output_file (char *path)
974 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM,
975 "rfm=stmlf", "ctx=rec", "rat=none", "rop=nlk",
976 "shr=del,get,put,upd");
977 #elif defined (__MINGW32__)
979 TCHAR wpath[GNAT_MAX_PATH_LEN];
981 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
982 fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
985 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT, PERM);
988 return fd < 0 ? -1 : fd;
992 __gnat_create_output_file_new (char *path)
996 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM,
997 "rfm=stmlf", "ctx=rec", "rat=none", "rop=nlk",
998 "shr=del,get,put,upd");
999 #elif defined (__MINGW32__)
1001 TCHAR wpath[GNAT_MAX_PATH_LEN];
1003 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
1004 fd = _topen (wpath, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM);
1007 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | O_TEXT | O_EXCL, PERM);
1010 return fd < 0 ? -1 : fd;
1014 __gnat_open_append (char *path, int fmode)
1017 int o_fmode = O_BINARY;
1023 fd = open (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM,
1024 "mbc=16", "deq=64", "fop=tef");
1025 #elif defined (__MINGW32__)
1027 TCHAR wpath[GNAT_MAX_PATH_LEN];
1029 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
1030 fd = _topen (wpath, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
1033 fd = open (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
1036 return fd < 0 ? -1 : fd;
1039 /* Open a new file. Return error (-1) if the file already exists. */
1042 __gnat_open_new (char *path, int fmode)
1045 int o_fmode = O_BINARY;
1051 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM,
1052 "mbc=16", "deq=64", "fop=tef");
1053 #elif defined (__MINGW32__)
1055 TCHAR wpath[GNAT_MAX_PATH_LEN];
1057 S2WSC (wpath, path, GNAT_MAX_PATH_LEN);
1058 fd = _topen (wpath, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
1061 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
1064 return fd < 0 ? -1 : fd;
1067 /* Open a new temp file. Return error (-1) if the file already exists.
1068 Special options for VMS allow the file to be shared between parent and child
1069 processes, however they really slow down output. Used in gnatchop. */
1072 __gnat_open_new_temp (char *path, int fmode)
1075 int o_fmode = O_BINARY;
1077 strcpy (path, "GNAT-XXXXXX");
1079 #if (defined (__FreeBSD__) || defined (__NetBSD__) || defined (__OpenBSD__) \
1080 || defined (linux) || defined(__GLIBC__)) && !defined (__vxworks)
1081 return mkstemp (path);
1082 #elif defined (__Lynx__)
1084 #elif defined (__nucleus__)
1087 if (mktemp (path) == NULL)
1095 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM,
1096 "rfm=stmlf", "ctx=rec", "rat=none", "shr=del,get,put,upd",
1097 "mbc=16", "deq=64", "fop=tef");
1099 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
1102 return fd < 0 ? -1 : fd;
1105 /****************************************************************
1106 ** Perform a call to GNAT_STAT or GNAT_FSTAT, and extract as much information
1107 ** as possible from it, storing the result in a cache for later reuse
1108 ****************************************************************/
1111 __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr)
1113 GNAT_STRUCT_STAT statbuf;
1117 ret = GNAT_FSTAT (fd, &statbuf);
1119 ret = __gnat_stat (name, &statbuf);
1121 attr->regular = (!ret && S_ISREG (statbuf.st_mode));
1122 attr->directory = (!ret && S_ISDIR (statbuf.st_mode));
1125 attr->file_length = 0;
1127 /* st_size may be 32 bits, or 64 bits which is converted to long. We
1128 don't return a useful value for files larger than 2 gigabytes in
1130 attr->file_length = statbuf.st_size; /* all systems */
1132 attr->exists = !ret;
1134 #if !defined (_WIN32) || defined (RTX)
1135 /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
1136 attr->readable = (!ret && (statbuf.st_mode & S_IRUSR));
1137 attr->writable = (!ret && (statbuf.st_mode & S_IWUSR));
1138 attr->executable = (!ret && (statbuf.st_mode & S_IXUSR));
1142 attr->timestamp = (OS_Time)-1;
1145 /* VMS has file versioning. */
1146 attr->timestamp = (OS_Time)statbuf.st_ctime;
1148 attr->timestamp = (OS_Time)statbuf.st_mtime;
1153 /****************************************************************
1154 ** Return the number of bytes in the specified file
1155 ****************************************************************/
1158 __gnat_file_length_attr (int fd, char* name, struct file_attributes* attr)
1160 if (attr->file_length == -1) {
1161 __gnat_stat_to_attr (fd, name, attr);
1164 return attr->file_length;
1168 __gnat_file_length (int fd)
1170 struct file_attributes attr;
1171 __gnat_reset_attributes (&attr);
1172 return __gnat_file_length_attr (fd, NULL, &attr);
1176 __gnat_named_file_length (char *name)
1178 struct file_attributes attr;
1179 __gnat_reset_attributes (&attr);
1180 return __gnat_file_length_attr (-1, name, &attr);
1183 /* Create a temporary filename and put it in string pointed to by
1187 __gnat_tmp_name (char *tmp_filename)
1190 /* Variable used to create a series of unique names */
1191 static int counter = 0;
1193 /* RTX in RTSS mode does not support tempnam nor tmpnam so we emulate it */
1194 strcpy (tmp_filename, "c:\\WINDOWS\\Temp\\gnat-");
1195 sprintf (&tmp_filename[strlen (tmp_filename)], "%d\0", counter++);
1197 #elif defined (__MINGW32__)
1202 /* tempnam tries to create a temporary file in directory pointed to by
1203 TMP environment variable, in c:\temp if TMP is not set, and in
1204 directory specified by P_tmpdir in stdio.h if c:\temp does not
1205 exist. The filename will be created with the prefix "gnat-". */
1207 sprintf (prefix, "gnat-%d-", (int)getpid());
1208 pname = (char *) _tempnam ("c:\\temp", prefix);
1210 /* if pname is NULL, the file was not created properly, the disk is full
1211 or there is no more free temporary files */
1214 *tmp_filename = '\0';
1216 /* If pname start with a back slash and not path information it means that
1217 the filename is valid for the current working directory. */
1219 else if (pname[0] == '\\')
1221 strcpy (tmp_filename, ".\\");
1222 strcat (tmp_filename, pname+1);
1225 strcpy (tmp_filename, pname);
1230 #elif defined (linux) || defined (__FreeBSD__) || defined (__NetBSD__) \
1231 || defined (__OpenBSD__) || defined(__GLIBC__)
1232 #define MAX_SAFE_PATH 1000
1233 char *tmpdir = getenv ("TMPDIR");
1235 /* If tmpdir is longer than MAX_SAFE_PATH, revert to default value to avoid
1236 a buffer overflow. */
1237 if (tmpdir == NULL || strlen (tmpdir) > MAX_SAFE_PATH)
1238 strcpy (tmp_filename, "/tmp/gnat-XXXXXX");
1240 sprintf (tmp_filename, "%s/gnat-XXXXXX", tmpdir);
1242 close (mkstemp(tmp_filename));
1243 #elif defined (__vxworks) && !(defined (__RTP__) || defined (VTHREADS))
1247 static ushort_t seed = 0; /* used to generate unique name */
1249 /* generate unique name */
1250 strcpy (tmp_filename, "tmp");
1252 /* fill up the name buffer from the last position */
1254 pos = tmp_filename + strlen (tmp_filename) + index;
1258 for (t = seed; 0 <= --index; t >>= 3)
1259 *--pos = '0' + (t & 07);
1261 tmpnam (tmp_filename);
1265 /* Open directory and returns a DIR pointer. */
1267 DIR* __gnat_opendir (char *name)
1270 /* Not supported in RTX */
1274 #elif defined (__MINGW32__)
1275 TCHAR wname[GNAT_MAX_PATH_LEN];
1277 S2WSC (wname, name, GNAT_MAX_PATH_LEN);
1278 return (DIR*)_topendir (wname);
1281 return opendir (name);
1285 /* Read the next entry in a directory. The returned string points somewhere
1289 __gnat_readdir (DIR *dirp, char *buffer, int *len)
1292 /* Not supported in RTX */
1296 #elif defined (__MINGW32__)
1297 struct _tdirent *dirent = _treaddir ((_TDIR*)dirp);
1301 WS2SC (buffer, dirent->d_name, GNAT_MAX_PATH_LEN);
1302 *len = strlen (buffer);
1309 #elif defined (HAVE_READDIR_R)
1310 /* If possible, try to use the thread-safe version. */
1311 if (readdir_r (dirp, buffer) != NULL)
1313 *len = strlen (((struct dirent*) buffer)->d_name);
1314 return ((struct dirent*) buffer)->d_name;
1320 struct dirent *dirent = (struct dirent *) readdir (dirp);
1324 strcpy (buffer, dirent->d_name);
1325 *len = strlen (buffer);
1334 /* Close a directory entry. */
1336 int __gnat_closedir (DIR *dirp)
1339 /* Not supported in RTX */
1343 #elif defined (__MINGW32__)
1344 return _tclosedir ((_TDIR*)dirp);
1347 return closedir (dirp);
1351 /* Returns 1 if readdir is thread safe, 0 otherwise. */
1354 __gnat_readdir_is_thread_safe (void)
1356 #ifdef HAVE_READDIR_R
1363 #if defined (_WIN32) && !defined (RTX)
1364 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970>. */
1365 static const unsigned long long w32_epoch_offset = 11644473600ULL;
1367 /* Returns the file modification timestamp using Win32 routines which are
1368 immune against daylight saving time change. It is in fact not possible to
1369 use fstat for this purpose as the DST modify the st_mtime field of the
1373 win32_filetime (HANDLE h)
1378 unsigned long long ull_time;
1381 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
1382 since <Jan 1st 1601>. This function must return the number of seconds
1383 since <Jan 1st 1970>. */
1385 if (GetFileTime (h, NULL, NULL, &t_write.ft_time))
1386 return (time_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
1390 /* As above but starting from a FILETIME. */
1392 f2t (const FILETIME *ft, time_t *t)
1397 unsigned long long ull_time;
1400 t_write.ft_time = *ft;
1401 *t = (time_t) (t_write.ull_time / 10000000ULL - w32_epoch_offset);
1405 /* Return a GNAT time stamp given a file name. */
1408 __gnat_file_time_name_attr (char* name, struct file_attributes* attr)
1410 if (attr->timestamp == (OS_Time)-2) {
1411 #if defined (_WIN32) && !defined (RTX)
1413 WIN32_FILE_ATTRIBUTE_DATA fad;
1415 TCHAR wname[GNAT_MAX_PATH_LEN];
1416 S2WSC (wname, name, GNAT_MAX_PATH_LEN);
1418 if ((res = GetFileAttributesEx (wname, GetFileExInfoStandard, &fad)))
1419 f2t (&fad.ftLastWriteTime, &ret);
1420 attr->timestamp = (OS_Time) ret;
1422 __gnat_stat_to_attr (-1, name, attr);
1425 return attr->timestamp;
1429 __gnat_file_time_name (char *name)
1431 struct file_attributes attr;
1432 __gnat_reset_attributes (&attr);
1433 return __gnat_file_time_name_attr (name, &attr);
1436 /* Return a GNAT time stamp given a file descriptor. */
1439 __gnat_file_time_fd_attr (int fd, struct file_attributes* attr)
1441 if (attr->timestamp == (OS_Time)-2) {
1442 #if defined (_WIN32) && !defined (RTX)
1443 HANDLE h = (HANDLE) _get_osfhandle (fd);
1444 time_t ret = win32_filetime (h);
1445 attr->timestamp = (OS_Time) ret;
1448 __gnat_stat_to_attr (fd, NULL, attr);
1452 return attr->timestamp;
1456 __gnat_file_time_fd (int fd)
1458 struct file_attributes attr;
1459 __gnat_reset_attributes (&attr);
1460 return __gnat_file_time_fd_attr (fd, &attr);
1463 /* Set the file time stamp. */
1466 __gnat_set_file_time_name (char *name, time_t time_stamp)
1468 #if defined (__vxworks)
1470 /* Code to implement __gnat_set_file_time_name for these systems. */
1472 #elif defined (_WIN32) && !defined (RTX)
1476 unsigned long long ull_time;
1478 TCHAR wname[GNAT_MAX_PATH_LEN];
1480 S2WSC (wname, name, GNAT_MAX_PATH_LEN);
1482 HANDLE h = CreateFile
1483 (wname, GENERIC_WRITE, FILE_SHARE_WRITE, NULL,
1484 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS,
1486 if (h == INVALID_HANDLE_VALUE)
1488 /* Add number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
1489 t_write.ull_time = ((unsigned long long)time_stamp + w32_epoch_offset);
1490 /* Convert to 100 nanosecond units */
1491 t_write.ull_time *= 10000000ULL;
1493 SetFileTime(h, NULL, NULL, &t_write.ft_time);
1503 unsigned long long backup, create, expire, revise;
1507 unsigned short value;
1510 unsigned system : 4;
1516 } Fat = { 0, 0, 0, 0, 0, { 0 }};
1520 { ATR$S_CREDATE, ATR$C_CREDATE, &Fat.create },
1521 { ATR$S_REVDATE, ATR$C_REVDATE, &Fat.revise },
1522 { ATR$S_EXPDATE, ATR$C_EXPDATE, &Fat.expire },
1523 { ATR$S_BAKDATE, ATR$C_BAKDATE, &Fat.backup },
1524 { ATR$S_FPRO, ATR$C_FPRO, &Fat.prot },
1525 { ATR$S_UIC, ATR$C_UIC, &Fat.uic },
1530 struct dsc$descriptor_fib fibdsc = {sizeof (fib), (void *) &fib};
1534 unsigned long long newtime;
1535 unsigned long long revtime;
1539 struct vstring file;
1540 struct dsc$descriptor_s filedsc
1541 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) file.string};
1542 struct vstring device;
1543 struct dsc$descriptor_s devicedsc
1544 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) device.string};
1545 struct vstring timev;
1546 struct dsc$descriptor_s timedsc
1547 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) timev.string};
1548 struct vstring result;
1549 struct dsc$descriptor_s resultdsc
1550 = {NAM$C_MAXRSS, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, (void *) result.string};
1552 /* Convert parameter name (a file spec) to host file form. Note that this
1553 is needed on VMS to prepare for subsequent calls to VMS RMS library
1554 routines. Note that it would not work to call __gnat_to_host_dir_spec
1555 as was done in a previous version, since this fails silently unless
1556 the feature logical DECC$EFS_CHARSET is enabled, in which case a DNF
1557 (directory not found) condition is signalled. */
1558 tryfile = (char *) __gnat_to_host_file_spec (name);
1560 /* Allocate and initialize a FAB and NAM structures. */
1564 nam.nam$l_esa = file.string;
1565 nam.nam$b_ess = NAM$C_MAXRSS;
1566 nam.nam$l_rsa = result.string;
1567 nam.nam$b_rss = NAM$C_MAXRSS;
1568 fab.fab$l_fna = tryfile;
1569 fab.fab$b_fns = strlen (tryfile);
1570 fab.fab$l_nam = &nam;
1572 /* Validate filespec syntax and device existence. */
1573 status = SYS$PARSE (&fab, 0, 0);
1574 if ((status & 1) != 1)
1575 LIB$SIGNAL (status);
1577 file.string[nam.nam$b_esl] = 0;
1579 /* Find matching filespec. */
1580 status = SYS$SEARCH (&fab, 0, 0);
1581 if ((status & 1) != 1)
1582 LIB$SIGNAL (status);
1584 file.string[nam.nam$b_esl] = 0;
1585 result.string[result.length=nam.nam$b_rsl] = 0;
1587 /* Get the device name and assign an IO channel. */
1588 strncpy (device.string, nam.nam$l_dev, nam.nam$b_dev);
1589 devicedsc.dsc$w_length = nam.nam$b_dev;
1591 status = SYS$ASSIGN (&devicedsc, &chan, 0, 0, 0);
1592 if ((status & 1) != 1)
1593 LIB$SIGNAL (status);
1595 /* Initialize the FIB and fill in the directory id field. */
1596 memset (&fib, 0, sizeof (fib));
1597 fib.fib$w_did[0] = nam.nam$w_did[0];
1598 fib.fib$w_did[1] = nam.nam$w_did[1];
1599 fib.fib$w_did[2] = nam.nam$w_did[2];
1600 fib.fib$l_acctl = 0;
1602 strcpy (file.string, (strrchr (result.string, ']') + 1));
1603 filedsc.dsc$w_length = strlen (file.string);
1604 result.string[result.length = 0] = 0;
1606 /* Open and close the file to fill in the attributes. */
1608 = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
1609 &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
1610 if ((status & 1) != 1)
1611 LIB$SIGNAL (status);
1612 if ((iosb.status & 1) != 1)
1613 LIB$SIGNAL (iosb.status);
1615 result.string[result.length] = 0;
1616 status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0, &fibdsc, 0, 0, 0,
1618 if ((status & 1) != 1)
1619 LIB$SIGNAL (status);
1620 if ((iosb.status & 1) != 1)
1621 LIB$SIGNAL (iosb.status);
1626 /* Set creation time to requested time. */
1627 unix_time_to_vms (time_stamp, newtime);
1629 t = time ((time_t) 0);
1631 /* Set revision time to now in local time. */
1632 unix_time_to_vms (t, revtime);
1635 /* Reopen the file, modify the times and then close. */
1636 fib.fib$l_acctl = FIB$M_WRITE;
1638 = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
1639 &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
1640 if ((status & 1) != 1)
1641 LIB$SIGNAL (status);
1642 if ((iosb.status & 1) != 1)
1643 LIB$SIGNAL (iosb.status);
1645 Fat.create = newtime;
1646 Fat.revise = revtime;
1648 status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0,
1649 &fibdsc, 0, 0, 0, &atrlst, 0);
1650 if ((status & 1) != 1)
1651 LIB$SIGNAL (status);
1652 if ((iosb.status & 1) != 1)
1653 LIB$SIGNAL (iosb.status);
1655 /* Deassign the channel and exit. */
1656 status = SYS$DASSGN (chan);
1657 if ((status & 1) != 1)
1658 LIB$SIGNAL (status);
1660 struct utimbuf utimbuf;
1663 /* Set modification time to requested time. */
1664 utimbuf.modtime = time_stamp;
1666 /* Set access time to now in local time. */
1667 t = time ((time_t) 0);
1668 utimbuf.actime = mktime (localtime (&t));
1670 utime (name, &utimbuf);
1674 /* Get the list of installed standard libraries from the
1675 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1679 __gnat_get_libraries_from_registry (void)
1681 char *result = (char *) xmalloc (1);
1685 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS) \
1689 DWORD name_size, value_size;
1696 /* First open the key. */
1697 res = RegOpenKeyExA (HKEY_LOCAL_MACHINE, "SOFTWARE", 0, KEY_READ, ®_key);
1699 if (res == ERROR_SUCCESS)
1700 res = RegOpenKeyExA (reg_key, "Ada Core Technologies", 0,
1701 KEY_READ, ®_key);
1703 if (res == ERROR_SUCCESS)
1704 res = RegOpenKeyExA (reg_key, "GNAT", 0, KEY_READ, ®_key);
1706 if (res == ERROR_SUCCESS)
1707 res = RegOpenKeyExA (reg_key, "Standard Libraries", 0, KEY_READ, ®_key);
1709 /* If the key exists, read out all the values in it and concatenate them
1711 for (index = 0; res == ERROR_SUCCESS; index++)
1713 value_size = name_size = 256;
1714 res = RegEnumValueA (reg_key, index, name, &name_size, 0,
1715 &type, (LPBYTE)value, &value_size);
1717 if (res == ERROR_SUCCESS && type == REG_SZ)
1719 char *old_result = result;
1721 result = (char *) xmalloc (strlen (old_result) + value_size + 2);
1722 strcpy (result, old_result);
1723 strcat (result, value);
1724 strcat (result, ";");
1729 /* Remove the trailing ";". */
1731 result[strlen (result) - 1] = 0;
1738 __gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf)
1741 WIN32_FILE_ATTRIBUTE_DATA fad;
1742 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
1747 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
1748 name_len = _tcslen (wname);
1750 if (name_len > GNAT_MAX_PATH_LEN)
1753 ZeroMemory (statbuf, sizeof(GNAT_STRUCT_STAT));
1755 res = GetFileAttributesEx (wname, GetFileExInfoStandard, &fad);
1758 error = GetLastError();
1760 /* Check file existence using GetFileAttributes() which does not fail on
1761 special Windows files like con:, aux:, nul: etc... */
1763 if (GetFileAttributes(wname) != INVALID_FILE_ATTRIBUTES) {
1764 /* Just pretend that it is a regular and readable file */
1765 statbuf->st_mode = S_IFREG | S_IREAD | S_IWRITE;
1770 case ERROR_ACCESS_DENIED:
1771 case ERROR_SHARING_VIOLATION:
1772 case ERROR_LOCK_VIOLATION:
1773 case ERROR_SHARING_BUFFER_EXCEEDED:
1775 case ERROR_BUFFER_OVERFLOW:
1776 return ENAMETOOLONG;
1777 case ERROR_NOT_ENOUGH_MEMORY:
1784 f2t (&fad.ftCreationTime, &statbuf->st_ctime);
1785 f2t (&fad.ftLastWriteTime, &statbuf->st_mtime);
1786 f2t (&fad.ftLastAccessTime, &statbuf->st_atime);
1788 statbuf->st_size = (off_t)fad.nFileSizeLow;
1790 /* We do not have the S_IEXEC attribute, but this is not used on GNAT. */
1791 statbuf->st_mode = S_IREAD;
1793 if (fad.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY)
1794 statbuf->st_mode |= S_IFDIR;
1796 statbuf->st_mode |= S_IFREG;
1798 if (!(fad.dwFileAttributes & FILE_ATTRIBUTE_READONLY))
1799 statbuf->st_mode |= S_IWRITE;
1804 return GNAT_STAT (name, statbuf);
1808 /*************************************************************************
1809 ** Check whether a file exists
1810 *************************************************************************/
1813 __gnat_file_exists_attr (char* name, struct file_attributes* attr)
1815 if (attr->exists == ATTR_UNSET) {
1816 __gnat_stat_to_attr (-1, name, attr);
1819 return attr->exists;
1823 __gnat_file_exists (char *name)
1825 struct file_attributes attr;
1826 __gnat_reset_attributes (&attr);
1827 return __gnat_file_exists_attr (name, &attr);
1830 /**********************************************************************
1831 ** Whether name is an absolute path
1832 **********************************************************************/
1835 __gnat_is_absolute_path (char *name, int length)
1838 /* On VxWorks systems, an absolute path can be represented (depending on
1839 the host platform) as either /dir/file, or device:/dir/file, or
1840 device:drive_letter:/dir/file. */
1847 for (index = 0; index < length; index++)
1849 if (name[index] == ':' &&
1850 ((name[index + 1] == '/') ||
1851 (isalpha (name[index + 1]) && index + 2 <= length &&
1852 name[index + 2] == '/')))
1855 else if (name[index] == '/')
1860 return (length != 0) &&
1861 (*name == '/' || *name == DIR_SEPARATOR
1863 || (length > 1 && ISALPHA (name[0]) && name[1] == ':')
1870 __gnat_is_regular_file_attr (char* name, struct file_attributes* attr)
1872 if (attr->regular == ATTR_UNSET) {
1873 __gnat_stat_to_attr (-1, name, attr);
1876 return attr->regular;
1880 __gnat_is_regular_file (char *name)
1882 struct file_attributes attr;
1883 __gnat_reset_attributes (&attr);
1884 return __gnat_is_regular_file_attr (name, &attr);
1888 __gnat_is_directory_attr (char* name, struct file_attributes* attr)
1890 if (attr->directory == ATTR_UNSET) {
1891 __gnat_stat_to_attr (-1, name, attr);
1894 return attr->directory;
1898 __gnat_is_directory (char *name)
1900 struct file_attributes attr;
1901 __gnat_reset_attributes (&attr);
1902 return __gnat_is_directory_attr (name, &attr);
1905 #if defined (_WIN32) && !defined (RTX)
1907 /* Returns the same constant as GetDriveType but takes a pathname as
1911 GetDriveTypeFromPath (TCHAR *wfullpath)
1913 TCHAR wdrv[MAX_PATH];
1914 TCHAR wpath[MAX_PATH];
1915 TCHAR wfilename[MAX_PATH];
1916 TCHAR wext[MAX_PATH];
1918 _tsplitpath (wfullpath, wdrv, wpath, wfilename, wext);
1920 if (_tcslen (wdrv) != 0)
1922 /* we have a drive specified. */
1923 _tcscat (wdrv, _T("\\"));
1924 return GetDriveType (wdrv);
1928 /* No drive specified. */
1930 /* Is this a relative path, if so get current drive type. */
1931 if (wpath[0] != _T('\\') ||
1932 (_tcslen (wpath) > 2 && wpath[0] == _T('\\') && wpath[1] != _T('\\')))
1933 return GetDriveType (NULL);
1935 UINT result = GetDriveType (wpath);
1937 /* Cannot guess the drive type, is this \\.\ ? */
1939 if (result == DRIVE_NO_ROOT_DIR &&
1940 _tcslen (wpath) >= 4 && wpath[0] == _T('\\') && wpath[1] == _T('\\')
1941 && wpath[2] == _T('.') && wpath[3] == _T('\\'))
1943 if (_tcslen (wpath) == 4)
1944 _tcscat (wpath, wfilename);
1946 LPTSTR p = &wpath[4];
1947 LPTSTR b = _tcschr (p, _T('\\'));
1950 { /* logical drive \\.\c\dir\file */
1956 _tcscat (p, _T(":\\"));
1958 return GetDriveType (p);
1965 /* This MingW section contains code to work with ACL. */
1967 __gnat_check_OWNER_ACL
1969 DWORD CheckAccessDesired,
1970 GENERIC_MAPPING CheckGenericMapping)
1972 DWORD dwAccessDesired, dwAccessAllowed;
1973 PRIVILEGE_SET PrivilegeSet;
1974 DWORD dwPrivSetSize = sizeof (PRIVILEGE_SET);
1975 BOOL fAccessGranted = FALSE;
1976 HANDLE hToken = NULL;
1978 SECURITY_DESCRIPTOR* pSD = NULL;
1981 (wname, OWNER_SECURITY_INFORMATION |
1982 GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION,
1985 if ((pSD = (PSECURITY_DESCRIPTOR) HeapAlloc
1986 (GetProcessHeap (), HEAP_ZERO_MEMORY, nLength)) == NULL)
1989 /* Obtain the security descriptor. */
1991 if (!GetFileSecurity
1992 (wname, OWNER_SECURITY_INFORMATION |
1993 GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION,
1994 pSD, nLength, &nLength))
1997 if (!ImpersonateSelf (SecurityImpersonation))
2000 if (!OpenThreadToken
2001 (GetCurrentThread(), TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken))
2004 /* Undoes the effect of ImpersonateSelf. */
2008 /* We want to test for write permissions. */
2010 dwAccessDesired = CheckAccessDesired;
2012 MapGenericMask (&dwAccessDesired, &CheckGenericMapping);
2015 (pSD , /* security descriptor to check */
2016 hToken, /* impersonation token */
2017 dwAccessDesired, /* requested access rights */
2018 &CheckGenericMapping, /* pointer to GENERIC_MAPPING */
2019 &PrivilegeSet, /* receives privileges used in check */
2020 &dwPrivSetSize, /* size of PrivilegeSet buffer */
2021 &dwAccessAllowed, /* receives mask of allowed access rights */
2025 CloseHandle (hToken);
2026 HeapFree (GetProcessHeap (), 0, pSD);
2027 return fAccessGranted;
2031 CloseHandle (hToken);
2032 HeapFree (GetProcessHeap (), 0, pSD);
2037 __gnat_set_OWNER_ACL
2040 DWORD AccessPermissions)
2042 PACL pOldDACL = NULL;
2043 PACL pNewDACL = NULL;
2044 PSECURITY_DESCRIPTOR pSD = NULL;
2046 TCHAR username [100];
2049 /* Get current user, he will act as the owner */
2051 if (!GetUserName (username, &unsize))
2054 if (GetNamedSecurityInfo
2057 DACL_SECURITY_INFORMATION,
2058 NULL, NULL, &pOldDACL, NULL, &pSD) != ERROR_SUCCESS)
2061 BuildExplicitAccessWithName
2062 (&ea, username, AccessPermissions, AccessMode, NO_INHERITANCE);
2064 if (AccessMode == SET_ACCESS)
2066 /* SET_ACCESS, we want to set an explicte set of permissions, do not
2067 merge with current DACL. */
2068 if (SetEntriesInAcl (1, &ea, NULL, &pNewDACL) != ERROR_SUCCESS)
2072 if (SetEntriesInAcl (1, &ea, pOldDACL, &pNewDACL) != ERROR_SUCCESS)
2075 if (SetNamedSecurityInfo
2076 (wname, SE_FILE_OBJECT,
2077 DACL_SECURITY_INFORMATION, NULL, NULL, pNewDACL, NULL) != ERROR_SUCCESS)
2081 LocalFree (pNewDACL);
2084 /* Check if it is possible to use ACL for wname, the file must not be on a
2088 __gnat_can_use_acl (TCHAR *wname)
2090 return __gnat_use_acl && GetDriveTypeFromPath (wname) != DRIVE_REMOTE;
2093 #endif /* defined (_WIN32) && !defined (RTX) */
2096 __gnat_is_readable_file_attr (char* name, struct file_attributes* attr)
2098 if (attr->readable == ATTR_UNSET) {
2099 #if defined (_WIN32) && !defined (RTX)
2100 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2101 GENERIC_MAPPING GenericMapping;
2103 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2105 if (__gnat_can_use_acl (wname))
2107 ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
2108 GenericMapping.GenericRead = GENERIC_READ;
2110 __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping);
2113 attr->readable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
2115 __gnat_stat_to_attr (-1, name, attr);
2119 return attr->readable;
2123 __gnat_is_readable_file (char *name)
2125 struct file_attributes attr;
2126 __gnat_reset_attributes (&attr);
2127 return __gnat_is_readable_file_attr (name, &attr);
2131 __gnat_is_writable_file_attr (char* name, struct file_attributes* attr)
2133 if (attr->writable == ATTR_UNSET) {
2134 #if defined (_WIN32) && !defined (RTX)
2135 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2136 GENERIC_MAPPING GenericMapping;
2138 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2140 if (__gnat_can_use_acl (wname))
2142 ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
2143 GenericMapping.GenericWrite = GENERIC_WRITE;
2145 attr->writable = __gnat_check_OWNER_ACL
2146 (wname, FILE_WRITE_DATA | FILE_APPEND_DATA, GenericMapping)
2147 && !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
2150 attr->writable = !(GetFileAttributes (wname) & FILE_ATTRIBUTE_READONLY);
2153 __gnat_stat_to_attr (-1, name, attr);
2157 return attr->writable;
2161 __gnat_is_writable_file (char *name)
2163 struct file_attributes attr;
2164 __gnat_reset_attributes (&attr);
2165 return __gnat_is_writable_file_attr (name, &attr);
2169 __gnat_is_executable_file_attr (char* name, struct file_attributes* attr)
2171 if (attr->executable == ATTR_UNSET) {
2172 #if defined (_WIN32) && !defined (RTX)
2173 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2174 GENERIC_MAPPING GenericMapping;
2176 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2178 if (__gnat_can_use_acl (wname))
2180 ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
2181 GenericMapping.GenericExecute = GENERIC_EXECUTE;
2184 __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
2188 TCHAR *l, *last = _tcsstr(wname, _T(".exe"));
2190 /* look for last .exe */
2192 while (l = _tcsstr(last+1, _T(".exe"))) last = l;
2194 attr->executable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
2195 && last - wname == (int) (_tcslen (wname) - 4);
2198 __gnat_stat_to_attr (-1, name, attr);
2202 return attr->executable;
2206 __gnat_is_executable_file (char *name)
2208 struct file_attributes attr;
2209 __gnat_reset_attributes (&attr);
2210 return __gnat_is_executable_file_attr (name, &attr);
2214 __gnat_set_writable (char *name)
2216 #if defined (_WIN32) && !defined (RTX)
2217 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2219 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2221 if (__gnat_can_use_acl (wname))
2222 __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_WRITE);
2225 (wname, GetFileAttributes (wname) & ~FILE_ATTRIBUTE_READONLY);
2226 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2227 ! defined(__nucleus__)
2228 GNAT_STRUCT_STAT statbuf;
2230 if (GNAT_STAT (name, &statbuf) == 0)
2232 statbuf.st_mode = statbuf.st_mode | S_IWUSR;
2233 chmod (name, statbuf.st_mode);
2239 __gnat_set_executable (char *name)
2241 #if defined (_WIN32) && !defined (RTX)
2242 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2244 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2246 if (__gnat_can_use_acl (wname))
2247 __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_EXECUTE);
2249 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2250 ! defined(__nucleus__)
2251 GNAT_STRUCT_STAT statbuf;
2253 if (GNAT_STAT (name, &statbuf) == 0)
2255 statbuf.st_mode = statbuf.st_mode | S_IXUSR;
2256 chmod (name, statbuf.st_mode);
2262 __gnat_set_non_writable (char *name)
2264 #if defined (_WIN32) && !defined (RTX)
2265 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2267 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2269 if (__gnat_can_use_acl (wname))
2270 __gnat_set_OWNER_ACL
2271 (wname, DENY_ACCESS,
2272 FILE_WRITE_DATA | FILE_APPEND_DATA |
2273 FILE_WRITE_EA | FILE_WRITE_ATTRIBUTES);
2276 (wname, GetFileAttributes (wname) | FILE_ATTRIBUTE_READONLY);
2277 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2278 ! defined(__nucleus__)
2279 GNAT_STRUCT_STAT statbuf;
2281 if (GNAT_STAT (name, &statbuf) == 0)
2283 statbuf.st_mode = statbuf.st_mode & 07577;
2284 chmod (name, statbuf.st_mode);
2290 __gnat_set_readable (char *name)
2292 #if defined (_WIN32) && !defined (RTX)
2293 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2295 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2297 if (__gnat_can_use_acl (wname))
2298 __gnat_set_OWNER_ACL (wname, GRANT_ACCESS, FILE_GENERIC_READ);
2300 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2301 ! defined(__nucleus__)
2302 GNAT_STRUCT_STAT statbuf;
2304 if (GNAT_STAT (name, &statbuf) == 0)
2306 chmod (name, statbuf.st_mode | S_IREAD);
2312 __gnat_set_non_readable (char *name)
2314 #if defined (_WIN32) && !defined (RTX)
2315 TCHAR wname [GNAT_MAX_PATH_LEN + 2];
2317 S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
2319 if (__gnat_can_use_acl (wname))
2320 __gnat_set_OWNER_ACL (wname, DENY_ACCESS, FILE_GENERIC_READ);
2322 #elif ! (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) && \
2323 ! defined(__nucleus__)
2324 GNAT_STRUCT_STAT statbuf;
2326 if (GNAT_STAT (name, &statbuf) == 0)
2328 chmod (name, statbuf.st_mode & (~S_IREAD));
2334 __gnat_is_symbolic_link_attr (char* name ATTRIBUTE_UNUSED,
2335 struct file_attributes* attr)
2337 if (attr->symbolic_link == ATTR_UNSET) {
2338 #if defined (__vxworks) || defined (__nucleus__)
2339 attr->symbolic_link = 0;
2341 #elif defined (_AIX) || defined (__APPLE__) || defined (__unix__)
2343 GNAT_STRUCT_STAT statbuf;
2344 ret = GNAT_LSTAT (name, &statbuf);
2345 attr->symbolic_link = (!ret && S_ISLNK (statbuf.st_mode));
2347 attr->symbolic_link = 0;
2350 return attr->symbolic_link;
2354 __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
2356 struct file_attributes attr;
2357 __gnat_reset_attributes (&attr);
2358 return __gnat_is_symbolic_link_attr (name, &attr);
2362 #if defined (sun) && defined (__SVR4)
2363 /* Using fork on Solaris will duplicate all the threads. fork1, which
2364 duplicates only the active thread, must be used instead, or spawning
2365 subprocess from a program with tasking will lead into numerous problems. */
2370 __gnat_portable_spawn (char *args[])
2373 int finished ATTRIBUTE_UNUSED;
2374 int pid ATTRIBUTE_UNUSED;
2376 #if defined (__vxworks) || defined(__nucleus__) || defined(RTX)
2379 #elif defined (_WIN32)
2380 /* args[0] must be quotes as it could contain a full pathname with spaces */
2381 char *args_0 = args[0];
2382 args[0] = (char *)xmalloc (strlen (args_0) + 3);
2383 strcpy (args[0], "\"");
2384 strcat (args[0], args_0);
2385 strcat (args[0], "\"");
2387 status = spawnvp (P_WAIT, args_0, (const char* const*)args);
2389 /* restore previous value */
2391 args[0] = (char *)args_0;
2407 if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
2409 return -1; /* execv is in parent context on VMS. */
2416 finished = waitpid (pid, &status, 0);
2418 if (finished != pid || WIFEXITED (status) == 0)
2421 return WEXITSTATUS (status);
2427 /* Create a copy of the given file descriptor.
2428 Return -1 if an error occurred. */
2431 __gnat_dup (int oldfd)
2433 #if defined (__vxworks) && !defined (__RTP__)
2434 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2442 /* Make newfd be the copy of oldfd, closing newfd first if necessary.
2443 Return -1 if an error occurred. */
2446 __gnat_dup2 (int oldfd, int newfd)
2448 #if defined (__vxworks) && !defined (__RTP__)
2449 /* Not supported on VxWorks 5.x, but supported on VxWorks 6.0 when using
2453 return dup2 (oldfd, newfd);
2458 __gnat_number_of_cpus (void)
2462 #if defined (linux) || defined (sun) || defined (AIX) \
2463 || (defined (__alpha__) && defined (_osf_)) || defined (__APPLE__)
2464 cores = (int) sysconf (_SC_NPROCESSORS_ONLN);
2466 #elif (defined (__mips) && defined (__sgi))
2467 cores = (int) sysconf (_SC_NPROC_ONLN);
2469 #elif defined (__hpux__)
2470 struct pst_dynamic psd;
2471 if (pstat_getdynamic (&psd, sizeof (psd), 1, 0) != -1)
2472 cores = (int) psd.psd_proc_cnt;
2474 #elif defined (_WIN32)
2475 SYSTEM_INFO sysinfo;
2476 GetSystemInfo (&sysinfo);
2477 cores = (int) sysinfo.dwNumberOfProcessors;
2480 int code = SYI$_ACTIVECPU_CNT;
2484 status = LIB$GETSYI (&code, &res);
2485 if ((status & 1) != 0)
2488 #elif defined (_WRS_CONFIG_SMP)
2489 unsigned int vxCpuConfiguredGet (void);
2491 cores = vxCpuConfiguredGet ();
2498 /* WIN32 code to implement a wait call that wait for any child process. */
2500 #if defined (_WIN32) && !defined (RTX)
2502 /* Synchronization code, to be thread safe. */
2506 /* For the Cert run times on native Windows we use dummy functions
2507 for locking and unlocking tasks since we do not support multiple
2508 threads on this configuration (Cert run time on native Windows). */
2510 void dummy (void) {}
2512 void (*Lock_Task) () = &dummy;
2513 void (*Unlock_Task) () = &dummy;
2517 #define Lock_Task system__soft_links__lock_task
2518 extern void (*Lock_Task) (void);
2520 #define Unlock_Task system__soft_links__unlock_task
2521 extern void (*Unlock_Task) (void);
2525 static HANDLE *HANDLES_LIST = NULL;
2526 static int *PID_LIST = NULL, plist_length = 0, plist_max_length = 0;
2529 add_handle (HANDLE h, int pid)
2532 /* -------------------- critical section -------------------- */
2535 if (plist_length == plist_max_length)
2537 plist_max_length += 1000;
2539 xrealloc (HANDLES_LIST, sizeof (HANDLE) * plist_max_length);
2541 xrealloc (PID_LIST, sizeof (int) * plist_max_length);
2544 HANDLES_LIST[plist_length] = h;
2545 PID_LIST[plist_length] = pid;
2549 /* -------------------- critical section -------------------- */
2553 __gnat_win32_remove_handle (HANDLE h, int pid)
2557 /* -------------------- critical section -------------------- */
2560 for (j = 0; j < plist_length; j++)
2562 if ((HANDLES_LIST[j] == h) || (PID_LIST[j] == pid))
2566 HANDLES_LIST[j] = HANDLES_LIST[plist_length];
2567 PID_LIST[j] = PID_LIST[plist_length];
2573 /* -------------------- critical section -------------------- */
2577 win32_no_block_spawn (char *command, char *args[], HANDLE *h, int *pid)
2581 PROCESS_INFORMATION PI;
2582 SECURITY_ATTRIBUTES SA;
2587 /* compute the total command line length */
2591 csize += strlen (args[k]) + 1;
2595 full_command = (char *) xmalloc (csize);
2598 SI.cb = sizeof (STARTUPINFO);
2599 SI.lpReserved = NULL;
2600 SI.lpReserved2 = NULL;
2601 SI.lpDesktop = NULL;
2605 SI.wShowWindow = SW_HIDE;
2607 /* Security attributes. */
2608 SA.nLength = sizeof (SECURITY_ATTRIBUTES);
2609 SA.bInheritHandle = TRUE;
2610 SA.lpSecurityDescriptor = NULL;
2612 /* Prepare the command string. */
2613 strcpy (full_command, command);
2614 strcat (full_command, " ");
2619 strcat (full_command, args[k]);
2620 strcat (full_command, " ");
2625 int wsize = csize * 2;
2626 TCHAR *wcommand = (TCHAR *) xmalloc (wsize);
2628 S2WSC (wcommand, full_command, wsize);
2630 free (full_command);
2632 result = CreateProcess
2633 (NULL, wcommand, &SA, NULL, TRUE,
2634 GetPriorityClass (GetCurrentProcess()), NULL, NULL, &SI, &PI);
2641 CloseHandle (PI.hThread);
2643 *pid = PI.dwProcessId;
2653 win32_wait (int *status)
2655 DWORD exitcode, pid;
2662 if (plist_length == 0)
2670 /* -------------------- critical section -------------------- */
2673 hl_len = plist_length;
2675 hl = (HANDLE *) xmalloc (sizeof (HANDLE) * hl_len);
2677 memmove (hl, HANDLES_LIST, sizeof (HANDLE) * hl_len);
2680 /* -------------------- critical section -------------------- */
2682 res = WaitForMultipleObjects (hl_len, hl, FALSE, INFINITE);
2683 h = hl[res - WAIT_OBJECT_0];
2685 GetExitCodeProcess (h, &exitcode);
2686 pid = PID_LIST [res - WAIT_OBJECT_0];
2687 __gnat_win32_remove_handle (h, -1);
2691 *status = (int) exitcode;
2698 __gnat_portable_no_block_spawn (char *args[])
2701 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX)
2704 #elif defined (_WIN32)
2709 win32_no_block_spawn (args[0], args, &h, &pid);
2712 add_handle (h, pid);
2725 if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
2727 return -1; /* execv is in parent context on VMS. */
2739 __gnat_portable_wait (int *process_status)
2744 #if defined (__vxworks) || defined (__nucleus__) || defined (RTX)
2745 /* Not sure what to do here, so do nothing but return zero. */
2747 #elif defined (_WIN32)
2749 pid = win32_wait (&status);
2753 pid = waitpid (-1, &status, 0);
2754 status = status & 0xffff;
2757 *process_status = status;
2762 __gnat_os_exit (int status)
2767 /* Locate file on path, that matches a predicate */
2770 __gnat_locate_file_with_predicate
2771 (char *file_name, char *path_val, int (*predicate)(char*))
2774 char *file_path = (char *) alloca (strlen (file_name) + 1);
2777 /* Return immediately if file_name is empty */
2779 if (*file_name == '\0')
2782 /* Remove quotes around file_name if present */
2788 strcpy (file_path, ptr);
2790 ptr = file_path + strlen (file_path) - 1;
2795 /* Handle absolute pathnames. */
2797 absolute = __gnat_is_absolute_path (file_path, strlen (file_name));
2801 if (predicate (file_path))
2802 return xstrdup (file_path);
2807 /* If file_name include directory separator(s), try it first as
2808 a path name relative to the current directory */
2809 for (ptr = file_name; *ptr && *ptr != '/' && *ptr != DIR_SEPARATOR; ptr++)
2814 if (predicate (file_name))
2815 return xstrdup (file_name);
2822 /* The result has to be smaller than path_val + file_name. */
2824 (char *) alloca (strlen (path_val) + strlen (file_name) + 2);
2828 /* Skip the starting quote */
2830 if (*path_val == '"')
2833 for (ptr = file_path; *path_val && *path_val != PATH_SEPARATOR; )
2834 *ptr++ = *path_val++;
2836 /* If directory is empty, it is the current directory*/
2838 if (ptr == file_path)
2845 /* Skip the ending quote */
2850 if (*ptr != '/' && *ptr != DIR_SEPARATOR)
2851 *++ptr = DIR_SEPARATOR;
2853 strcpy (++ptr, file_name);
2855 if (predicate (file_path))
2856 return xstrdup (file_path);
2861 /* Skip path separator */
2870 /* Locate an executable file, give a Path value. */
2873 __gnat_locate_executable_file (char *file_name, char *path_val)
2875 return __gnat_locate_file_with_predicate
2876 (file_name, path_val, &__gnat_is_executable_file);
2879 /* Locate a regular file, give a Path value. */
2882 __gnat_locate_regular_file (char *file_name, char *path_val)
2884 return __gnat_locate_file_with_predicate
2885 (file_name, path_val, &__gnat_is_regular_file);
2888 /* Locate an executable given a Path argument. This routine is only used by
2889 gnatbl and should not be used otherwise. Use locate_exec_on_path
2893 __gnat_locate_exec (char *exec_name, char *path_val)
2896 if (!strstr (exec_name, HOST_EXECUTABLE_SUFFIX))
2898 char *full_exec_name =
2900 (strlen (exec_name) + strlen (HOST_EXECUTABLE_SUFFIX) + 1);
2902 strcpy (full_exec_name, exec_name);
2903 strcat (full_exec_name, HOST_EXECUTABLE_SUFFIX);
2904 ptr = __gnat_locate_executable_file (full_exec_name, path_val);
2907 return __gnat_locate_executable_file (exec_name, path_val);
2911 return __gnat_locate_executable_file (exec_name, path_val);
2914 /* Locate an executable using the Systems default PATH. */
2917 __gnat_locate_exec_on_path (char *exec_name)
2921 #if defined (_WIN32) && !defined (RTX)
2922 TCHAR *wpath_val = _tgetenv (_T("PATH"));
2924 /* In Win32 systems we expand the PATH as for XP environment
2925 variables are not automatically expanded. We also prepend the
2926 ".;" to the path to match normal NT path search semantics */
2928 #define EXPAND_BUFFER_SIZE 32767
2930 wapath_val = alloca (EXPAND_BUFFER_SIZE);
2932 wapath_val [0] = '.';
2933 wapath_val [1] = ';';
2935 DWORD res = ExpandEnvironmentStrings
2936 (wpath_val, &wapath_val[2], EXPAND_BUFFER_SIZE - 2);
2938 if (!res) wapath_val [0] = _T('\0');
2940 apath_val = alloca (EXPAND_BUFFER_SIZE);
2942 WS2SC (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
2943 return __gnat_locate_exec (exec_name, apath_val);
2948 char *path_val = "/VAXC$PATH";
2950 char *path_val = getenv ("PATH");
2952 if (path_val == NULL) return NULL;
2953 apath_val = (char *) alloca (strlen (path_val) + 1);
2954 strcpy (apath_val, path_val);
2955 return __gnat_locate_exec (exec_name, apath_val);
2961 /* These functions are used to translate to and from VMS and Unix syntax
2962 file, directory and path specifications. */
2965 #define MAXNAMES 256
2966 #define NEW_CANONICAL_FILELIST_INCREMENT 64
2968 static char new_canonical_dirspec [MAXPATH];
2969 static char new_canonical_filespec [MAXPATH];
2970 static char new_canonical_pathspec [MAXNAMES*MAXPATH];
2971 static unsigned new_canonical_filelist_index;
2972 static unsigned new_canonical_filelist_in_use;
2973 static unsigned new_canonical_filelist_allocated;
2974 static char **new_canonical_filelist;
2975 static char new_host_pathspec [MAXNAMES*MAXPATH];
2976 static char new_host_dirspec [MAXPATH];
2977 static char new_host_filespec [MAXPATH];
2979 /* Routine is called repeatedly by decc$from_vms via
2980 __gnat_to_canonical_file_list_init until it returns 0 or the expansion
2984 wildcard_translate_unix (char *name)
2987 char buff [MAXPATH];
2989 strncpy (buff, name, MAXPATH);
2990 buff [MAXPATH - 1] = (char) 0;
2991 ver = strrchr (buff, '.');
2993 /* Chop off the version. */
2997 /* Dynamically extend the allocation by the increment. */
2998 if (new_canonical_filelist_in_use == new_canonical_filelist_allocated)
3000 new_canonical_filelist_allocated += NEW_CANONICAL_FILELIST_INCREMENT;
3001 new_canonical_filelist = (char **) xrealloc
3002 (new_canonical_filelist,
3003 new_canonical_filelist_allocated * sizeof (char *));
3006 new_canonical_filelist[new_canonical_filelist_in_use++] = xstrdup (buff);
3011 /* Translate a wildcard VMS file spec into a list of Unix file specs. First do
3012 full translation and copy the results into a list (_init), then return them
3013 one at a time (_next). If onlydirs set, only expand directory files. */
3016 __gnat_to_canonical_file_list_init (char *filespec, int onlydirs)
3019 char buff [MAXPATH];
3021 len = strlen (filespec);
3022 strncpy (buff, filespec, MAXPATH);
3024 /* Only look for directories */
3025 if (onlydirs && !strstr (&buff [len-5], "*.dir"))
3026 strncat (buff, "*.dir", MAXPATH);
3028 buff [MAXPATH - 1] = (char) 0;
3030 decc$from_vms (buff, wildcard_translate_unix, 1);
3032 /* Remove the .dir extension. */
3038 for (i = 0; i < new_canonical_filelist_in_use; i++)
3040 ext = strstr (new_canonical_filelist[i], ".dir");
3046 return new_canonical_filelist_in_use;
3049 /* Return the next filespec in the list. */
3052 __gnat_to_canonical_file_list_next ()
3054 return new_canonical_filelist[new_canonical_filelist_index++];
3057 /* Free storage used in the wildcard expansion. */
3060 __gnat_to_canonical_file_list_free ()
3064 for (i = 0; i < new_canonical_filelist_in_use; i++)
3065 free (new_canonical_filelist[i]);
3067 free (new_canonical_filelist);
3069 new_canonical_filelist_in_use = 0;
3070 new_canonical_filelist_allocated = 0;
3071 new_canonical_filelist_index = 0;
3072 new_canonical_filelist = 0;
3075 /* The functional equivalent of decc$translate_vms routine.
3076 Designed to produce the same output, but is protected against
3077 malformed paths (original version ACCVIOs in this case) and
3078 does not require VMS-specific DECC RTL */
3080 #define NAM$C_MAXRSS 1024
3083 __gnat_translate_vms (char *src)
3085 static char retbuf [NAM$C_MAXRSS+1];
3086 char *srcendpos, *pos1, *pos2, *retpos;
3087 int disp, path_present = 0;
3089 if (!src) return NULL;
3091 srcendpos = strchr (src, '\0');
3094 /* Look for the node and/or device in front of the path */
3096 pos2 = strchr (pos1, ':');
3098 if (pos2 && (pos2 < srcendpos) && (*(pos2 + 1) == ':')) {
3099 /* There is a node name. "node_name::" becomes "node_name!" */
3101 strncpy (retbuf, pos1, disp);
3102 retpos [disp] = '!';
3103 retpos = retpos + disp + 1;
3105 pos2 = strchr (pos1, ':');
3109 /* There is a device name. "dev_name:" becomes "/dev_name/" */
3112 strncpy (retpos, pos1, disp);
3113 retpos = retpos + disp;
3118 /* No explicit device; we must look ahead and prepend /sys$disk/ if
3119 the path is absolute */
3120 if ((*pos1 == '[' || *pos1 == '<') && (pos1 < srcendpos)
3121 && !strchr (".-]>", *(pos1 + 1))) {
3122 strncpy (retpos, "/sys$disk/", 10);
3126 /* Process the path part */
3127 while (*pos1 == '[' || *pos1 == '<') {
3130 if (*pos1 == ']' || *pos1 == '>') {
3131 /* Special case, [] translates to '.' */
3136 /* '[000000' means root dir. It can be present in the middle of
3137 the path due to expansion of logical devices, in which case
3139 if (!strncmp (pos1, "000000", 6) && path_present > 1 &&
3140 (*(pos1 + 6) == ']' || *(pos1 + 6) == '>' || *(pos1 + 6) == '.')) {
3142 if (*pos1 == '.') pos1++;
3144 else if (*pos1 == '.') {
3149 /* There is a qualified path */
3150 while (*pos1 && *pos1 != ']' && *pos1 != '>') {
3153 /* '.' is used to separate directories. Replace it with '/' but
3154 only if there isn't already '/' just before */
3155 if (*(retpos - 1) != '/') *(retpos++) = '/';
3157 if (pos1 + 1 < srcendpos && *pos1 == '.' && *(pos1 + 1) == '.') {
3158 /* ellipsis refers to entire subtree; replace with '**' */
3159 *(retpos++) = '*'; *(retpos++) = '*'; *(retpos++) = '/';
3164 /* When after '.' '[' '<' is equivalent to Unix ".." but there
3165 may be several in a row */
3166 if (*(pos1 - 1) == '.' || *(pos1 - 1) == '[' ||
3167 *(pos1 - 1) == '<') {
3168 while (*pos1 == '-') {
3170 *(retpos++) = '.'; *(retpos++) = '.'; *(retpos++) = '/';
3175 /* otherwise fall through to default */
3177 *(retpos++) = *(pos1++);
3184 if (pos1 < srcendpos) {
3185 /* Now add the actual file name, until the version suffix if any */
3186 if (path_present) *(retpos++) = '/';
3187 pos2 = strchr (pos1, ';');
3188 disp = pos2? (pos2 - pos1) : (srcendpos - pos1);
3189 strncpy (retpos, pos1, disp);
3191 if (pos2 && pos2 < srcendpos) {
3192 /* There is a non-empty version suffix. ";<ver>" becomes ".<ver>" */
3194 disp = srcendpos - pos2 - 1;
3195 strncpy (retpos, pos2 + 1, disp);
3206 /* Translate a VMS syntax directory specification in to Unix syntax. If
3207 PREFIXFLAG is set, append an underscore "/". If no indicators of VMS syntax
3208 found, return input string. Also translate a dirname that contains no
3209 slashes, in case it's a logical name. */
3212 __gnat_to_canonical_dir_spec (char *dirspec, int prefixflag)
3216 strcpy (new_canonical_dirspec, "");
3217 if (strlen (dirspec))
3221 if (strchr (dirspec, ']') || strchr (dirspec, ':'))
3223 strncpy (new_canonical_dirspec,
3224 __gnat_translate_vms (dirspec),
3227 else if (!strchr (dirspec, '/') && (dirspec1 = getenv (dirspec)) != 0)
3229 strncpy (new_canonical_dirspec,
3230 __gnat_translate_vms (dirspec1),
3235 strncpy (new_canonical_dirspec, dirspec, MAXPATH);
3239 len = strlen (new_canonical_dirspec);
3240 if (prefixflag && new_canonical_dirspec [len-1] != '/')
3241 strncat (new_canonical_dirspec, "/", MAXPATH);
3243 new_canonical_dirspec [MAXPATH - 1] = (char) 0;
3245 return new_canonical_dirspec;
3249 /* Translate a VMS syntax file specification into Unix syntax.
3250 If no indicators of VMS syntax found, check if it's an uppercase
3251 alphanumeric_ name and if so try it out as an environment
3252 variable (logical name). If all else fails return the
3256 __gnat_to_canonical_file_spec (char *filespec)
3260 strncpy (new_canonical_filespec, "", MAXPATH);
3262 if (strchr (filespec, ']') || strchr (filespec, ':'))
3264 char *tspec = (char *) __gnat_translate_vms (filespec);
3266 if (tspec != (char *) -1)
3267 strncpy (new_canonical_filespec, tspec, MAXPATH);
3269 else if ((strlen (filespec) == strspn (filespec,
3270 "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"))
3271 && (filespec1 = getenv (filespec)))
3273 char *tspec = (char *) __gnat_translate_vms (filespec1);
3275 if (tspec != (char *) -1)
3276 strncpy (new_canonical_filespec, tspec, MAXPATH);
3280 strncpy (new_canonical_filespec, filespec, MAXPATH);
3283 new_canonical_filespec [MAXPATH - 1] = (char) 0;
3285 return new_canonical_filespec;
3288 /* Translate a VMS syntax path specification into Unix syntax.
3289 If no indicators of VMS syntax found, return input string. */
3292 __gnat_to_canonical_path_spec (char *pathspec)
3294 char *curr, *next, buff [MAXPATH];
3299 /* If there are /'s, assume it's a Unix path spec and return. */
3300 if (strchr (pathspec, '/'))
3303 new_canonical_pathspec[0] = 0;
3308 next = strchr (curr, ',');
3310 next = strchr (curr, 0);
3312 strncpy (buff, curr, next - curr);
3313 buff[next - curr] = 0;
3315 /* Check for wildcards and expand if present. */
3316 if (strchr (buff, '*') || strchr (buff, '%') || strstr (buff, "..."))
3320 dirs = __gnat_to_canonical_file_list_init (buff, 1);
3321 for (i = 0; i < dirs; i++)
3325 next_dir = __gnat_to_canonical_file_list_next ();
3326 strncat (new_canonical_pathspec, next_dir, MAXPATH);
3328 /* Don't append the separator after the last expansion. */
3330 strncat (new_canonical_pathspec, ":", MAXPATH);
3333 __gnat_to_canonical_file_list_free ();
3336 strncat (new_canonical_pathspec,
3337 __gnat_to_canonical_dir_spec (buff, 0), MAXPATH);
3342 strncat (new_canonical_pathspec, ":", MAXPATH);
3346 new_canonical_pathspec [MAXPATH - 1] = (char) 0;
3348 return new_canonical_pathspec;
3351 static char filename_buff [MAXPATH];
3354 translate_unix (char *name, int type)
3356 strncpy (filename_buff, name, MAXPATH);
3357 filename_buff [MAXPATH - 1] = (char) 0;
3361 /* Translate a Unix syntax path spec into a VMS style (comma separated list of
3365 to_host_path_spec (char *pathspec)
3367 char *curr, *next, buff [MAXPATH];
3372 /* Can't very well test for colons, since that's the Unix separator! */
3373 if (strchr (pathspec, ']') || strchr (pathspec, ','))
3376 new_host_pathspec[0] = 0;
3381 next = strchr (curr, ':');
3383 next = strchr (curr, 0);
3385 strncpy (buff, curr, next - curr);
3386 buff[next - curr] = 0;
3388 strncat (new_host_pathspec, __gnat_to_host_dir_spec (buff, 0), MAXPATH);
3391 strncat (new_host_pathspec, ",", MAXPATH);
3395 new_host_pathspec [MAXPATH - 1] = (char) 0;
3397 return new_host_pathspec;
3400 /* Translate a Unix syntax directory specification into VMS syntax. The
3401 PREFIXFLAG has no effect, but is kept for symmetry with
3402 to_canonical_dir_spec. If indicators of VMS syntax found, return input
3406 __gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
3408 int len = strlen (dirspec);
3410 strncpy (new_host_dirspec, dirspec, MAXPATH);
3411 new_host_dirspec [MAXPATH - 1] = (char) 0;
3413 if (strchr (new_host_dirspec, ']') || strchr (new_host_dirspec, ':'))
3414 return new_host_dirspec;
3416 while (len > 1 && new_host_dirspec[len - 1] == '/')
3418 new_host_dirspec[len - 1] = 0;
3422 decc$to_vms (new_host_dirspec, translate_unix, 1, 2);
3423 strncpy (new_host_dirspec, filename_buff, MAXPATH);
3424 new_host_dirspec [MAXPATH - 1] = (char) 0;
3426 return new_host_dirspec;
3429 /* Translate a Unix syntax file specification into VMS syntax.
3430 If indicators of VMS syntax found, return input string. */
3433 __gnat_to_host_file_spec (char *filespec)
3435 strncpy (new_host_filespec, "", MAXPATH);
3436 if (strchr (filespec, ']') || strchr (filespec, ':'))
3438 strncpy (new_host_filespec, filespec, MAXPATH);
3442 decc$to_vms (filespec, translate_unix, 1, 1);
3443 strncpy (new_host_filespec, filename_buff, MAXPATH);
3446 new_host_filespec [MAXPATH - 1] = (char) 0;
3448 return new_host_filespec;
3452 __gnat_adjust_os_resource_limits ()
3454 SYS$ADJWSL (131072, 0);
3459 /* Dummy functions for Osint import for non-VMS systems. */
3462 __gnat_to_canonical_file_list_init
3463 (char *dirspec ATTRIBUTE_UNUSED, int onlydirs ATTRIBUTE_UNUSED)
3469 __gnat_to_canonical_file_list_next (void)
3471 static char empty[] = "";
3476 __gnat_to_canonical_file_list_free (void)
3481 __gnat_to_canonical_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
3487 __gnat_to_canonical_file_spec (char *filespec)
3493 __gnat_to_canonical_path_spec (char *pathspec)
3499 __gnat_to_host_dir_spec (char *dirspec, int prefixflag ATTRIBUTE_UNUSED)
3505 __gnat_to_host_file_spec (char *filespec)
3511 __gnat_adjust_os_resource_limits (void)
3517 #if defined (__mips_vxworks)
3521 CACHE_USER_FLUSH (0, ENTIRE_CACHE);
3525 #if defined (IS_CROSS) \
3526 || (! ((defined (sparc) || defined (i386)) && defined (sun) \
3527 && defined (__SVR4)) \
3528 && ! (defined (linux) && (defined (i386) || defined (__x86_64__))) \
3529 && ! (defined (linux) && defined (__ia64__)) \
3530 && ! (defined (linux) && defined (powerpc)) \
3531 && ! defined (__FreeBSD__) \
3532 && ! defined (__Lynx__) \
3533 && ! defined (__hpux__) \
3534 && ! defined (__APPLE__) \
3535 && ! defined (_AIX) \
3536 && ! (defined (__alpha__) && defined (__osf__)) \
3537 && ! defined (VMS) \
3538 && ! defined (__MINGW32__) \
3539 && ! (defined (__mips) && defined (__sgi)))
3541 /* Dummy function to satisfy g-trasym.o. See the preprocessor conditional
3542 just above for a list of native platforms that provide a non-dummy
3543 version of this procedure in libaddr2line.a. */
3546 convert_addresses (const char *file_name ATTRIBUTE_UNUSED,
3547 void *addrs ATTRIBUTE_UNUSED,
3548 int n_addr ATTRIBUTE_UNUSED,
3549 void *buf ATTRIBUTE_UNUSED,
3550 int *len ATTRIBUTE_UNUSED)
3556 #if defined (_WIN32)
3557 int __gnat_argument_needs_quote = 1;
3559 int __gnat_argument_needs_quote = 0;
3562 /* This option is used to enable/disable object files handling from the
3563 binder file by the GNAT Project module. For example, this is disabled on
3564 Windows (prior to GCC 3.4) as it is already done by the mdll module.
3565 Stating with GCC 3.4 the shared libraries are not based on mdll
3566 anymore as it uses the GCC's -shared option */
3567 #if defined (_WIN32) \
3568 && ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ < 4)))
3569 int __gnat_prj_add_obj_files = 0;
3571 int __gnat_prj_add_obj_files = 1;
3574 /* char used as prefix/suffix for environment variables */
3575 #if defined (_WIN32)
3576 char __gnat_environment_char = '%';
3578 char __gnat_environment_char = '$';
3581 /* This functions copy the file attributes from a source file to a
3584 mode = 0 : In this mode copy only the file time stamps (last access and
3585 last modification time stamps).
3587 mode = 1 : In this mode, time stamps and read/write/execute attributes are
3590 Returns 0 if operation was successful and -1 in case of error. */
3593 __gnat_copy_attribs (char *from, char *to, int mode)
3595 #if defined (VMS) || (defined (__vxworks) && _WRS_VXWORKS_MAJOR < 6) || \
3596 defined (__nucleus__)
3599 #elif defined (_WIN32) && !defined (RTX)
3600 TCHAR wfrom [GNAT_MAX_PATH_LEN + 2];
3601 TCHAR wto [GNAT_MAX_PATH_LEN + 2];
3603 FILETIME fct, flat, flwt;
3606 S2WSC (wfrom, from, GNAT_MAX_PATH_LEN + 2);
3607 S2WSC (wto, to, GNAT_MAX_PATH_LEN + 2);
3609 /* retrieve from times */
3612 (wfrom, GENERIC_READ, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
3614 if (hfrom == INVALID_HANDLE_VALUE)
3617 res = GetFileTime (hfrom, &fct, &flat, &flwt);
3619 CloseHandle (hfrom);
3624 /* retrieve from times */
3627 (wto, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
3629 if (hto == INVALID_HANDLE_VALUE)
3632 res = SetFileTime (hto, NULL, &flat, &flwt);
3639 /* Set file attributes in full mode. */
3643 DWORD attribs = GetFileAttributes (wfrom);
3645 if (attribs == INVALID_FILE_ATTRIBUTES)
3648 res = SetFileAttributes (wto, attribs);
3656 GNAT_STRUCT_STAT fbuf;
3657 struct utimbuf tbuf;
3659 if (GNAT_STAT (from, &fbuf) == -1)
3664 tbuf.actime = fbuf.st_atime;
3665 tbuf.modtime = fbuf.st_mtime;
3667 if (utime (to, &tbuf) == -1)
3674 if (chmod (to, fbuf.st_mode) == -1)
3685 __gnat_lseek (int fd, long offset, int whence)
3687 return (int) lseek (fd, offset, whence);
3690 /* This function returns the major version number of GCC being used. */
3692 get_gcc_version (void)
3697 return (int) (version_string[0] - '0');
3702 __gnat_set_close_on_exec (int fd ATTRIBUTE_UNUSED,
3703 int close_on_exec_p ATTRIBUTE_UNUSED)
3705 #if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
3706 int flags = fcntl (fd, F_GETFD, 0);
3709 if (close_on_exec_p)
3710 flags |= FD_CLOEXEC;
3712 flags &= ~FD_CLOEXEC;
3713 return fcntl (fd, F_SETFD, flags | FD_CLOEXEC);
3714 #elif defined(_WIN32)
3715 HANDLE h = (HANDLE) _get_osfhandle (fd);
3716 if (h == (HANDLE) -1)
3718 if (close_on_exec_p)
3719 return ! SetHandleInformation (h, HANDLE_FLAG_INHERIT, 0);
3720 return ! SetHandleInformation (h, HANDLE_FLAG_INHERIT,
3721 HANDLE_FLAG_INHERIT);
3723 /* TODO: Unimplemented. */
3728 /* Indicates if platforms supports automatic initialization through the
3729 constructor mechanism */
3731 __gnat_binder_supports_auto_init (void)
3740 /* Indicates that Stand-Alone Libraries are automatically initialized through
3741 the constructor mechanism */
3743 __gnat_sals_init_using_constructors (void)
3745 #if defined (__vxworks) || defined (__Lynx__) || defined (VMS)
3754 /* In RTX mode, the procedure to get the time (as file time) is different
3755 in RTSS mode and Win32 mode. In order to avoid duplicating an Ada file,
3756 we introduce an intermediate procedure to link against the corresponding
3757 one in each situation. */
3759 extern void GetTimeAsFileTime(LPFILETIME pTime);
3761 void GetTimeAsFileTime(LPFILETIME pTime)
3764 RtGetRtssTimeAsFileTime (pTime); /* RTSS interface */
3766 GetSystemTimeAsFileTime (pTime); /* w32 interface */
3771 /* Add symbol that is required to link. It would otherwise be taken from
3772 libgcc.a and it would try to use the gcc constructors that are not
3773 supported by Microsoft linker. */
3775 extern void __main (void);
3777 void __main (void) {}
3782 /* There is no function in the glibc to retrieve the LWP of the current
3783 thread. We need to do a system call in order to retrieve this
3785 #include <sys/syscall.h>
3786 void *__gnat_lwp_self (void)
3788 return (void *) syscall (__NR_gettid);
3793 /* glibc versions earlier than 2.7 do not define the routines to handle
3794 dynamically allocated CPU sets. For these targets, we use the static
3799 /* Dynamic cpu sets */
3801 cpu_set_t *__gnat_cpu_alloc (size_t count)
3803 return CPU_ALLOC (count);
3806 size_t __gnat_cpu_alloc_size (size_t count)
3808 return CPU_ALLOC_SIZE (count);
3811 void __gnat_cpu_free (cpu_set_t *set)
3816 void __gnat_cpu_zero (size_t count, cpu_set_t *set)
3818 CPU_ZERO_S (count, set);
3821 void __gnat_cpu_set (int cpu, size_t count, cpu_set_t *set)
3823 /* Ada handles CPU numbers starting from 1, while C identifies the first
3824 CPU by a 0, so we need to adjust. */
3825 CPU_SET_S (cpu - 1, count, set);
3830 /* Static cpu sets */
3832 cpu_set_t *__gnat_cpu_alloc (size_t count ATTRIBUTE_UNUSED)
3834 return (cpu_set_t *) xmalloc (sizeof (cpu_set_t));
3837 size_t __gnat_cpu_alloc_size (size_t count ATTRIBUTE_UNUSED)
3839 return sizeof (cpu_set_t);
3842 void __gnat_cpu_free (cpu_set_t *set)
3847 void __gnat_cpu_zero (size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
3852 void __gnat_cpu_set (int cpu, size_t count ATTRIBUTE_UNUSED, cpu_set_t *set)
3854 /* Ada handles CPU numbers starting from 1, while C identifies the first
3855 CPU by a 0, so we need to adjust. */
3856 CPU_SET (cpu - 1, set);