]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/ada/adaint.c
projects / thirdparty / gcc.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
* adaint.c: Do not use utime.h on vxworks.
[thirdparty/gcc.git] / gcc / ada / adaint.c
CommitLineData
1fac938e 1/****************************************************************************
2 * *
3 * GNAT COMPILER COMPONENTS *
4 * *
5 * A D A I N T *
6 * *
f9c9d5d3 7 * $Revision$
1fac938e 8 * *
9 * C Implementation File *
10 * *
11 * Copyright (C) 1992-2001, Free Software Foundation, Inc. *
12 * *
13 * GNAT is free software; you can redistribute it and/or modify it under *
14 * terms of the GNU General Public License as published by the Free Soft- *
15 * ware Foundation; either version 2, or (at your option) any later ver- *
16 * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
17 * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
18 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
19 * for more details. You should have received a copy of the GNU General *
20 * Public License distributed with GNAT; see file COPYING. If not, write *
21 * to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, *
22 * MA 02111-1307, USA. *
23 * *
24 * As a special exception, if you link this file with other files to *
25 * produce an executable, this file does not by itself cause the resulting *
26 * executable to be covered by the GNU General Public License. This except- *
27 * ion does not however invalidate any other reasons why the executable *
28 * file might be covered by the GNU Public License. *
29 * *
30 * GNAT was originally developed by the GNAT team at New York University. *
31 * It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). *
32 * *
33 ****************************************************************************/
34
35/* This file contains those routines named by Import pragmas in packages */
36/* in the GNAT hierarchy (especially GNAT.OS_Lib) and in package Osint. */
37/* Many of the subprograms in OS_Lib import standard library calls */
38/* directly. This file contains all other routines. */
39
40#ifdef __vxworks
41/* No need to redefine exit here */
42#ifdef exit
43#undef exit
44#endif
45/* We want to use the POSIX variants of include files. */
46#define POSIX
47#include "vxWorks.h"
48
49#if defined (__mips_vxworks)
50#include "cacheLib.h"
51#endif /* __mips_vxworks */
52
53#endif /* VxWorks */
54
55#ifdef IN_RTS
56#include "tconfig.h"
57#include "tsystem.h"
58#include <sys/stat.h>
59#include <fcntl.h>
60#include <time.h>
61
62/* We don't have libiberty, so us malloc. */
63#define xmalloc(S) malloc (S)
64#else
65#include "config.h"
66#include "system.h"
67#endif
68#include <sys/wait.h>
69
d8dd2062 70#if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
71#elif defined (VMS)
72#include <rms.h>
73#include <atrdef.h>
74#include <fibdef.h>
75#include <stsdef.h>
76#include <iodef.h>
77#include <errno.h>
78#include <descrip.h>
79#include <string.h>
80#include <unixlib.h>
81
82struct utimbuf
83{
84 time_t actime;
85 time_t modtime;
86};
87
88#define NOREAD 0x01
89#define NOWRITE 0x02
90#define NOEXECUTE 0x04
91#define NODELETE 0x08
92
93/* use native 64-bit arithmetic */
94#define unix_time_to_vms(X,Y) \
95 { unsigned long long reftime, tmptime = (X); \
96 $DESCRIPTOR (unixtime,"1-JAN-1970 0:00:00.00"); \
97 SYS$BINTIM (&unixtime, &reftime); \
98 Y = tmptime * 10000000 + reftime; }
99
100/* descrip.h doesn't have everything ... */
101struct dsc$descriptor_fib
102{
103 unsigned long fib$l_len;
104 struct fibdef *fib$l_addr;
105};
106
107struct IOSB
108{
109 unsigned short status, count;
110 unsigned long devdep;
111};
112
113static char *tryfile;
114
115struct vstring
116{
117 short length;
118 char string [NAM$C_MAXRSS+1];
119};
120
121
122#else
123#include <utime.h>
124#endif
125
1fac938e 126#if defined (__EMX__) || defined (MSDOS) || defined (_WIN32)
127#include <process.h>
128#endif
129
130#if defined (_WIN32)
131#include <dir.h>
132#include <windows.h>
133#endif
134
135#include "adaint.h"
136
137/* Define symbols O_BINARY and O_TEXT as harmless zeroes if they are not
138 defined in the current system. On DOS-like systems these flags control
139 whether the file is opened/created in text-translation mode (CR/LF in
140 external file mapped to LF in internal file), but in Unix-like systems,
141 no text translation is required, so these flags have no effect. */
142
143#if defined (__EMX__)
144#include <os2.h>
145#endif
146
147#if defined (MSDOS)
148#include <dos.h>
149#endif
150
151#ifndef O_BINARY
152#define O_BINARY 0
153#endif
154
155#ifndef O_TEXT
156#define O_TEXT 0
157#endif
158
159#ifndef HOST_EXECUTABLE_SUFFIX
160#define HOST_EXECUTABLE_SUFFIX ""
161#endif
162
163#ifndef HOST_OBJECT_SUFFIX
164#define HOST_OBJECT_SUFFIX ".o"
165#endif
166
167#ifndef PATH_SEPARATOR
168#define PATH_SEPARATOR ':'
169#endif
170
171#ifndef DIR_SEPARATOR
172#define DIR_SEPARATOR '/'
173#endif
174
175char __gnat_dir_separator = DIR_SEPARATOR;
176
177char __gnat_path_separator = PATH_SEPARATOR;
178
179/* The GNAT_LIBRARY_TEMPLATE contains a list of expressions that define
180 the base filenames that libraries specified with -lsomelib options
181 may have. This is used by GNATMAKE to check whether an executable
182 is up-to-date or not. The syntax is
183
184 library_template ::= { pattern ; } pattern NUL
185 pattern ::= [ prefix ] * [ postfix ]
186
187 These should only specify names of static libraries as it makes
188 no sense to determine at link time if dynamic-link libraries are
189 up to date or not. Any libraries that are not found are supposed
190 to be up-to-date:
191
192 * if they are needed but not present, the link
193 will fail,
194
195 * otherwise they are libraries in the system paths and so
196 they are considered part of the system and not checked
197 for that reason.
198
199 ??? This should be part of a GNAT host-specific compiler
200 file instead of being included in all user applications
201 as well. This is only a temporary work-around for 3.11b. */
202
203#ifndef GNAT_LIBRARY_TEMPLATE
204#if defined(__EMX__)
205#define GNAT_LIBRARY_TEMPLATE "*.a"
206#elif defined(VMS)
207#define GNAT_LIBRARY_TEMPLATE "*.olb"
208#else
209#define GNAT_LIBRARY_TEMPLATE "lib*.a"
210#endif
211#endif
212
213const char *__gnat_library_template = GNAT_LIBRARY_TEMPLATE;
214
215/* The following macro HAVE_READDIR_R should be defined if the
216 system provides the routine readdir_r */
217#undef HAVE_READDIR_R
218\f
219void
220__gnat_to_gm_time (p_time, p_year, p_month, p_day, p_hours, p_mins, p_secs)
221 time_t *p_time;
222 int *p_year, *p_month, *p_day, *p_hours, *p_mins, *p_secs;
223{
224 struct tm *res;
225 time_t time = *p_time;
226
227#ifdef _WIN32
228 /* On Windows systems, the time is sometimes rounded up to the nearest
229 even second, so if the number of seconds is odd, increment it. */
230 if (time & 1)
231 time++;
232#endif
233
234 res = gmtime (&time);
235
236 if (res)
237 {
238 *p_year = res->tm_year;
239 *p_month = res->tm_mon;
240 *p_day = res->tm_mday;
241 *p_hours = res->tm_hour;
242 *p_mins = res->tm_min;
243 *p_secs = res->tm_sec;
244 }
245 else
246 *p_year = *p_month = *p_day = *p_hours = *p_mins = *p_secs = 0;
247}
248
249/* Place the contents of the symbolic link named PATH in the buffer BUF,
250 which has size BUFSIZ. If PATH is a symbolic link, then return the number
251 of characters of its content in BUF. Otherwise, return -1. For Windows,
252 OS/2 and vxworks, always return -1. */
253
254int
255__gnat_readlink (path, buf, bufsiz)
256 char *path;
257 char *buf;
258 size_t bufsiz;
259{
260#if defined (MSDOS) || defined (_WIN32) || defined (__EMX__)
261 return -1;
262#elif defined (__INTERIX) || defined (VMS)
263 return -1;
264#elif defined (__vxworks)
265 return -1;
266#else
267 return readlink (path, buf, bufsiz);
268#endif
269}
270
271/* Creates a symbolic link named newpath
272 which contains the string oldpath.
273 If newpath exists it will NOT be overwritten.
274 For Windows, OS/2, vxworks, Interix and VMS, always retur -1. */
275
276int
277__gnat_symlink (oldpath, newpath)
278 char *oldpath;
279 char *newpath;
280{
281#if defined (MSDOS) || defined (_WIN32) || defined (__EMX__)
282 return -1;
283#elif defined (__INTERIX) || defined (VMS)
284 return -1;
285#elif defined (__vxworks)
286 return -1;
287#else
288 return symlink (oldpath, newpath);
289#endif
290}
291
292/* Try to lock a file, return 1 if success */
293
294#if defined (__vxworks) || defined (MSDOS) || defined (_WIN32)
295
296/* Version that does not use link. */
297
298int
299__gnat_try_lock (dir, file)
300 char *dir;
301 char *file;
302{
303 char full_path [256];
304 int fd;
305
306 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
307 fd = open (full_path, O_CREAT | O_EXCL, 0600);
308 if (fd < 0) {
309 return 0;
310 }
311 close (fd);
312 return 1;
313}
314
315#elif defined (__EMX__) || defined (VMS)
316
317/* More cases that do not use link; identical code, to solve too long
318 line problem ??? */
319
320int
321__gnat_try_lock (dir, file)
322 char *dir;
323 char *file;
324{
325 char full_path [256];
326 int fd;
327
328 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
329 fd = open (full_path, O_CREAT | O_EXCL, 0600);
330 if (fd < 0)
331 return 0;
332
333 close (fd);
334 return 1;
335}
336
337#else
338/* Version using link(), more secure over NFS. */
339
340int
341__gnat_try_lock (dir, file)
342 char *dir;
343 char *file;
344{
345 char full_path [256];
346 char temp_file [256];
347 struct stat stat_result;
348 int fd;
349
350 sprintf (full_path, "%s%c%s", dir, DIR_SEPARATOR, file);
351 sprintf (temp_file, "%s-%d-%d", dir, getpid(), getppid ());
352
353 /* Create the temporary file and write the process number */
354 fd = open (temp_file, O_CREAT | O_WRONLY, 0600);
355 if (fd < 0)
356 return 0;
357
358 close (fd);
359
360 /* Link it with the new file */
361 link (temp_file, full_path);
362
363 /* Count the references on the old one. If we have a count of two, then
364 the link did succeed. Remove the temporary file before returning. */
365 __gnat_stat (temp_file, &stat_result);
366 unlink (temp_file);
367 return stat_result.st_nlink == 2;
368}
369#endif
370
371/* Return the maximum file name length. */
372
373int
374__gnat_get_maximum_file_name_length ()
375{
376#if defined(MSDOS)
377 return 8;
378#elif defined (VMS)
379 if (getenv ("GNAT$EXTENDED_FILE_SPECIFICATIONS"))
380 return -1;
381 else
382 return 39;
383#else
384 return -1;
385#endif
386}
387
388/* Return the default switch character. */
389
390char
391__gnat_get_switch_character ()
392{
393 /* Under MSDOS, the switch character is not normally a hyphen, but this is
394 the convention DJGPP uses. Similarly under OS2, the switch character is
395 not normally a hypen, but this is the convention EMX uses. */
396
397 return '-';
398}
399
400/* Return nonzero if file names are case sensitive. */
401
402int
403__gnat_get_file_names_case_sensitive ()
404{
405#if defined (__EMX__) || defined (MSDOS) || defined (VMS) || defined(WINNT)
406 return 0;
407#else
408 return 1;
409#endif
410}
411
412char
413__gnat_get_default_identifier_character_set ()
414{
415#if defined (__EMX__) || defined (MSDOS)
416 return 'p';
417#else
418 return '1';
419#endif
420}
421
422/* Return the current working directory */
423
424void
425__gnat_get_current_dir (dir, length)
426 char *dir;
427 int *length;
428{
429#ifdef VMS
430 /* Force Unix style, which is what GNAT uses internally. */
431 getcwd (dir, *length, 0);
432#else
433 getcwd (dir, *length);
434#endif
435
436 *length = strlen (dir);
437
438 dir [*length] = DIR_SEPARATOR;
439 ++(*length);
440 dir [*length] = '\0';
441}
442
443/* Return the suffix for object files. */
444
445void
446__gnat_get_object_suffix_ptr (len, value)
447 int *len;
448 const char **value;
449{
450 *value = HOST_OBJECT_SUFFIX;
451
452 if (*value == 0)
453 *len = 0;
454 else
455 *len = strlen (*value);
456
457 return;
458}
459
460/* Return the suffix for executable files */
461
462void
463__gnat_get_executable_suffix_ptr (len, value)
464 int *len;
465 const char **value;
466{
467 *value = HOST_EXECUTABLE_SUFFIX;
468 if (!*value)
469 *len = 0;
470 else
471 *len = strlen (*value);
472
473 return;
474}
475
476/* Return the suffix for debuggable files. Usually this is the same as the
477 executable extension. */
478
479void
480__gnat_get_debuggable_suffix_ptr (len, value)
481 int *len;
482 const char **value;
483{
484#ifndef MSDOS
485 *value = HOST_EXECUTABLE_SUFFIX;
486#else
487 /* On DOS, the extensionless COFF file is what gdb likes. */
488 *value = "";
489#endif
490
491 if (*value == 0)
492 *len = 0;
493 else
494 *len = strlen (*value);
495
496 return;
497}
498
499int
500__gnat_open_read (path, fmode)
501 char *path;
502 int fmode;
503{
504 int fd;
505 int o_fmode = O_BINARY;
506
507 if (fmode)
508 o_fmode = O_TEXT;
509
510#if defined(VMS)
511 /* Optional arguments mbc,deq,fop increase read performance */
512 fd = open (path, O_RDONLY | o_fmode, 0444,
513 "mbc=16", "deq=64", "fop=tef");
514#elif defined(__vxworks)
515 fd = open (path, O_RDONLY | o_fmode, 0444);
516#else
517 fd = open (path, O_RDONLY | o_fmode);
518#endif
519 return fd < 0 ? -1 : fd;
520}
521
522#if defined (__EMX__)
523#define PERM (S_IREAD | S_IWRITE)
524#else
525#define PERM (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH)
526#endif
527
528int
529__gnat_open_rw (path, fmode)
530 char *path;
531 int fmode;
532{
533 int fd;
534 int o_fmode = O_BINARY;
535
536 if (fmode)
537 o_fmode = O_TEXT;
538
539#if defined(VMS)
540 fd = open (path, O_RDWR | o_fmode, PERM,
541 "mbc=16", "deq=64", "fop=tef");
542#else
543 fd = open (path, O_RDWR | o_fmode, PERM);
544#endif
545
546 return fd < 0 ? -1 : fd;
547}
548
549int
550__gnat_open_create (path, fmode)
551 char *path;
552 int fmode;
553{
554 int fd;
555 int o_fmode = O_BINARY;
556
557 if (fmode)
558 o_fmode = O_TEXT;
559
560#if defined(VMS)
561 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM,
562 "mbc=16", "deq=64", "fop=tef");
563#else
564 fd = open (path, O_WRONLY | O_CREAT | O_TRUNC | o_fmode, PERM);
565#endif
566
567 return fd < 0 ? -1 : fd;
568}
569
570int
571__gnat_open_append (path, fmode)
572 char *path;
573 int fmode;
574{
575 int fd;
576 int o_fmode = O_BINARY;
577
578 if (fmode)
579 o_fmode = O_TEXT;
580
581#if defined(VMS)
582 fd = open (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM,
583 "mbc=16", "deq=64", "fop=tef");
584#else
585 fd = open (path, O_WRONLY | O_CREAT | O_APPEND | o_fmode, PERM);
586#endif
587
588 return fd < 0 ? -1 : fd;
589}
590
591/* Open a new file. Return error (-1) if the file already exists. */
592
593int
594__gnat_open_new (path, fmode)
595 char *path;
596 int fmode;
597{
598 int fd;
599 int o_fmode = O_BINARY;
600
601 if (fmode)
602 o_fmode = O_TEXT;
603
604#if defined(VMS)
605 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM,
606 "mbc=16", "deq=64", "fop=tef");
607#else
608 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
609#endif
610
611 return fd < 0 ? -1 : fd;
612}
613
614/* Open a new temp file. Return error (-1) if the file already exists.
615 Special options for VMS allow the file to be shared between parent and
616 child processes, however they really slow down output. Used in
617 gnatchop. */
618
619int
620__gnat_open_new_temp (path, fmode)
621 char *path;
622 int fmode;
623{
624 int fd;
625 int o_fmode = O_BINARY;
626
627 strcpy (path, "GNAT-XXXXXX");
628
629#if defined (linux) && !defined (__vxworks)
630 return mkstemp (path);
631
632#else
633 if (mktemp (path) == NULL)
634 return -1;
635#endif
636
637 if (fmode)
638 o_fmode = O_TEXT;
639
640#if defined(VMS)
641 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM,
642 "rfm=stmlf", "ctx=rec", "rat=none", "shr=del,get,put,upd",
643 "mbc=16", "deq=64", "fop=tef");
644#else
645 fd = open (path, O_WRONLY | O_CREAT | O_EXCL | o_fmode, PERM);
646#endif
647
648 return fd < 0 ? -1 : fd;
649}
650
651int
652__gnat_mkdir (dir_name)
653 char *dir_name;
654{
655 /* On some systems, mkdir has two args and on some it has one. If we
656 are being built as part of the compiler, autoconf has figured that out
657 for us. Otherwise, we have to do it ourselves. */
658#ifndef IN_RTS
659 return mkdir (dir_name, S_IRWXU | S_IRWXG | S_IRWXO);
660#else
661#if defined (_WIN32) || defined (__vxworks)
662 return mkdir (dir_name);
663#else
664 return mkdir (dir_name, S_IRWXU | S_IRWXG | S_IRWXO);
665#endif
666#endif
667}
668
669/* Return the number of bytes in the specified file. */
670
671long
672__gnat_file_length (fd)
673 int fd;
674{
675 int ret;
676 struct stat statbuf;
677
678 ret = fstat (fd, &statbuf);
679 if (ret || !S_ISREG (statbuf.st_mode))
680 return 0;
681
682 return (statbuf.st_size);
683}
684
685/* Create a temporary filename and put it in string pointed to by
686 tmp_filename */
687
688void
689__gnat_tmp_name (tmp_filename)
690 char *tmp_filename;
691{
692#ifdef __MINGW32__
693 {
694 char *pname;
695
696 /* tempnam tries to create a temporary file in directory pointed to by
697 TMP environment variable, in c:\temp if TMP is not set, and in
698 directory specified by P_tmpdir in stdio.h if c:\temp does not
699 exist. The filename will be created with the prefix "gnat-". */
700
701 pname = (char *) tempnam ("c:\\temp", "gnat-");
702
703 /* if pname start with a back slash and not path information it means that
704 the filename is valid for the current working directory */
705
706 if (pname[0] == '\\')
707 {
708 strcpy (tmp_filename, ".\\");
709 strcat (tmp_filename, pname+1);
710 }
711 else
712 strcpy (tmp_filename, pname);
713
714 free (pname);
715 }
716#elif defined (linux)
717 char *tmpdir = getenv ("TMPDIR");
718
719 if (tmpdir == NULL)
720 strcpy (tmp_filename, "/tmp/gnat-XXXXXX");
721 else
722 sprintf (tmp_filename, "%s/gnat-XXXXXX", tmpdir);
723
724 close (mkstemp(tmp_filename));
725#else
726 tmpnam (tmp_filename);
727#endif
728}
729
730/* Read the next entry in a directory. The returned string points somewhere
731 in the buffer. */
732
733char *
734__gnat_readdir (dirp, buffer)
735 DIR *dirp;
736 char* buffer;
737{
738 /* If possible, try to use the thread-safe version. */
739#ifdef HAVE_READDIR_R
740 if (readdir_r (dirp, buffer) != NULL)
741 return ((struct dirent*) buffer)->d_name;
742 else
743 return NULL;
744
745#else
746 struct dirent *dirent = readdir (dirp);
747
748 if (dirent != NULL)
749 {
750 strcpy (buffer, dirent->d_name);
751 return buffer;
752 }
753 else
754 return NULL;
755
756#endif
757}
758
759/* Returns 1 if readdir is thread safe, 0 otherwise. */
760
761int
762__gnat_readdir_is_thread_safe ()
763{
764#ifdef HAVE_READDIR_R
765 return 1;
766#else
767 return 0;
768#endif
769}
770
771#ifdef _WIN32
772
773/* Returns the file modification timestamp using Win32 routines which are
774 immune against daylight saving time change. It is in fact not possible to
775 use fstat for this purpose as the DST modify the st_mtime field of the
776 stat structure. */
777
778static time_t
779win32_filetime (h)
780 HANDLE h;
781{
782 BOOL res;
783 FILETIME t_create;
784 FILETIME t_access;
785 FILETIME t_write;
786 unsigned long long timestamp;
787
788 /* Number of seconds between <Jan 1st 1601> and <Jan 1st 1970> */
789 unsigned long long offset = 11644473600;
790
791 /* GetFileTime returns FILETIME data which are the number of 100 nanosecs
792 since <Jan 1st 1601>. This function must return the number of seconds
793 since <Jan 1st 1970>. */
794
795 res = GetFileTime (h, &t_create, &t_access, &t_write);
796
797 timestamp = (((long long) t_write.dwHighDateTime << 32)
798 + t_write.dwLowDateTime);
799
800 timestamp = timestamp / 10000000 - offset;
801
802 return (time_t) timestamp;
803}
804#endif
805
806/* Return a GNAT time stamp given a file name. */
807
808time_t
809__gnat_file_time_name (name)
810 char *name;
811{
812 struct stat statbuf;
813
814#if defined (__EMX__) || defined (MSDOS)
815 int fd = open (name, O_RDONLY | O_BINARY);
816 time_t ret = __gnat_file_time_fd (fd);
817 close (fd);
818 return ret;
819
820#elif defined (_WIN32)
821 HANDLE h = CreateFile (name, GENERIC_READ, FILE_SHARE_READ, 0,
822 OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
823 time_t ret = win32_filetime (h);
824 CloseHandle (h);
825 return ret;
826#else
827
828 (void) __gnat_stat (name, &statbuf);
829#ifdef VMS
830 /* VMS has file versioning */
831 return statbuf.st_ctime;
832#else
833 return statbuf.st_mtime;
834#endif
835#endif
836}
837
838/* Return a GNAT time stamp given a file descriptor. */
839
840time_t
841__gnat_file_time_fd (fd)
842 int fd;
843{
844 /* The following workaround code is due to the fact that under EMX and
845 DJGPP fstat attempts to convert time values to GMT rather than keep the
846 actual OS timestamp of the file. By using the OS2/DOS functions directly
847 the GNAT timestamp are independent of this behavior, which is desired to
848 facilitate the distribution of GNAT compiled libraries. */
849
850#if defined (__EMX__) || defined (MSDOS)
851#ifdef __EMX__
852
853 FILESTATUS fs;
854 int ret = DosQueryFileInfo (fd, 1, (unsigned char *) &fs,
855 sizeof (FILESTATUS));
856
857 unsigned file_year = fs.fdateLastWrite.year;
858 unsigned file_month = fs.fdateLastWrite.month;
859 unsigned file_day = fs.fdateLastWrite.day;
860 unsigned file_hour = fs.ftimeLastWrite.hours;
861 unsigned file_min = fs.ftimeLastWrite.minutes;
862 unsigned file_tsec = fs.ftimeLastWrite.twosecs;
863
864#else
865 struct ftime fs;
866 int ret = getftime (fd, &fs);
867
868 unsigned file_year = fs.ft_year;
869 unsigned file_month = fs.ft_month;
870 unsigned file_day = fs.ft_day;
871 unsigned file_hour = fs.ft_hour;
872 unsigned file_min = fs.ft_min;
873 unsigned file_tsec = fs.ft_tsec;
874#endif
875
876 /* Calculate the seconds since epoch from the time components. First count
877 the whole days passed. The value for years returned by the DOS and OS2
878 functions count years from 1980, so to compensate for the UNIX epoch which
879 begins in 1970 start with 10 years worth of days and add days for each
880 four year period since then. */
881
882 time_t tot_secs;
883 int cum_days [12] = {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334};
884 int days_passed = 3652 + (file_year / 4) * 1461;
885 int years_since_leap = file_year % 4;
886
887 if (years_since_leap == 1)
888 days_passed += 366;
889 else if (years_since_leap == 2)
890 days_passed += 731;
891 else if (years_since_leap == 3)
892 days_passed += 1096;
893
894 if (file_year > 20)
895 days_passed -= 1;
896
897 days_passed += cum_days [file_month - 1];
898 if (years_since_leap == 0 && file_year != 20 && file_month > 2)
899 days_passed++;
900
901 days_passed += file_day - 1;
902
903 /* OK - have whole days. Multiply -- then add in other parts. */
904
905 tot_secs = days_passed * 86400;
906 tot_secs += file_hour * 3600;
907 tot_secs += file_min * 60;
908 tot_secs += file_tsec * 2;
909 return tot_secs;
910
911#elif defined (_WIN32)
912 HANDLE h = (HANDLE) _get_osfhandle (fd);
913 time_t ret = win32_filetime (h);
914 CloseHandle (h);
915 return ret;
916
917#else
918 struct stat statbuf;
919
920 (void) fstat (fd, &statbuf);
921
922#ifdef VMS
923 /* VMS has file versioning */
924 return statbuf.st_ctime;
925#else
926 return statbuf.st_mtime;
927#endif
928#endif
929}
930
d8dd2062 931/* Set the file time stamp */
932
933void
934__gnat_set_file_time_name (name, time_stamp)
935 char *name;
936 time_t time_stamp;
937{
9d9321ec 938#if defined (__EMX__) || defined (MSDOS) || defined (_WIN32) \
939 || defined (__vxworks)
d8dd2062 940#elif defined (VMS)
941 struct FAB fab;
942 struct NAM nam;
943
944 struct
945 {
946 unsigned long long backup, create, expire, revise;
947 unsigned long uic;
948 union
949 {
950 unsigned short value;
951 struct
952 {
953 unsigned system : 4;
954 unsigned owner : 4;
955 unsigned group : 4;
956 unsigned world : 4;
957 } bits;
958 } prot;
959 } Fat = { 0 };
960
961 ATRDEF atrlst []
962 = {
963 { ATR$S_CREDATE, ATR$C_CREDATE, &Fat.create },
964 { ATR$S_REVDATE, ATR$C_REVDATE, &Fat.revise },
965 { ATR$S_EXPDATE, ATR$C_EXPDATE, &Fat.expire },
966 { ATR$S_BAKDATE, ATR$C_BAKDATE, &Fat.backup },
967 n{ ATR$S_FPRO, ATR$C_FPRO, &Fat.prot },
968 { ATR$S_UIC, ATR$C_UIC, &Fat.uic },
969 { 0, 0, 0}
970 };
971
972 FIBDEF fib;
973 struct dsc$descriptor_fib fibdsc = {sizeof (fib), (void *) &fib};
974
975 struct IOSB iosb;
976
977 unsigned long long newtime;
978 unsigned long long revtime;
979 long status;
980 short chan;
981
982 struct vstring file;
983 struct dsc$descriptor_s filedsc
984 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) file.string};
985 struct vstring device;
986 struct dsc$descriptor_s devicedsc
987 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) device.string};
988 struct vstring timev;
989 struct dsc$descriptor_s timedsc
990 = {NAM$C_MAXRSS, DSC$K_DTYPE_T, DSC$K_CLASS_S, (void *) timev.string};
991 struct vstring result;
992 struct dsc$descriptor_s resultdsc
993 = {NAM$C_MAXRSS, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, (void *) result.string};
994
995 tryfile = (char *) __gnat_to_host_dir_spec (name, 0);
996
997 /* Allocate and initialize a fab and nam structures. */
998 fab = cc$rms_fab;
999 nam = cc$rms_nam;
1000
1001 nam.nam$l_esa = file.string;
1002 nam.nam$b_ess = NAM$C_MAXRSS;
1003 nam.nam$l_rsa = result.string;
1004 nam.nam$b_rss = NAM$C_MAXRSS;
1005 fab.fab$l_fna = tryfile;
1006 fab.fab$b_fns = strlen (tryfile);
1007 fab.fab$l_nam = &nam;
1008
1009 /*Validate filespec syntax and device existence. */
1010 status = SYS$PARSE (&fab, 0, 0);
1011 if ((status & 1) != 1)
1012 LIB$SIGNAL (status);
1013
1014 file.string [nam.nam$b_esl] = 0;
1015
1016 /* Find matching filespec. */
1017 status = SYS$SEARCH (&fab, 0, 0);
1018 if ((status & 1) != 1)
1019 LIB$SIGNAL (status);
1020
1021 file.string [nam.nam$b_esl] = 0;
1022 result.string [result.length=nam.nam$b_rsl] = 0;
1023
1024 /* Get the device name and assign an IO channel. */
1025 strncpy (device.string, nam.nam$l_dev, nam.nam$b_dev);
1026 devicedsc.dsc$w_length = nam.nam$b_dev;
1027 chan = 0;
1028 status = SYS$ASSIGN (&devicedsc, &chan, 0, 0, 0);
1029 if ((status & 1) != 1)
1030 LIB$SIGNAL (status);
1031
1032 /* Initialize the FIB and fill in the directory id field. */
1033 bzero (&fib, sizeof (fib));
1034 fib.fib$w_did [0] = nam.nam$w_did [0];
1035 fib.fib$w_did [1] = nam.nam$w_did [1];
1036 fib.fib$w_did [2] = nam.nam$w_did [2];
1037 fib.fib$l_acctl = 0;
1038 fib.fib$l_wcc = 0;
1039 strcpy (file.string, (strrchr (result.string, ']') + 1));
1040 filedsc.dsc$w_length = strlen (file.string);
1041 result.string [result.length = 0] = 0;
1042
1043 /* Open and close the file to fill in the attributes. */
1044 status
1045 = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
1046 &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
1047 if ((status & 1) != 1)
1048 LIB$SIGNAL (status);
1049 if ((iosb.status & 1) != 1)
1050 LIB$SIGNAL (iosb.status);
1051
1052 result.string [result.length] = 0;
1053 status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0,
1054 &fibdsc, 0, 0, 0, &atrlst, 0);
1055 if ((status & 1) != 1)
1056 LIB$SIGNAL (status);
1057 if ((iosb.status & 1) != 1)
1058 LIB$SIGNAL (iosb.status);
1059
1060 /* Set creation time to requested time */
1061 unix_time_to_vms (time_stamp, newtime);
1062
1063 {
1064 time_t t;
1065 struct tm *ts;
1066
1067 t = time ((time_t) 0);
1068 ts = localtime (&t);
1069
1070 /* Set revision time to now in local time. */
1071 unix_time_to_vms (t + ts->tm_gmtoff, revtime);
1072 }
1073
1074 /* Reopen the file, modify the times and then close. */
1075 fib.fib$l_acctl = FIB$M_WRITE;
1076 status
1077 = SYS$QIOW (0, chan, IO$_ACCESS|IO$M_ACCESS, &iosb, 0, 0,
1078 &fibdsc, &filedsc, &result.length, &resultdsc, &atrlst, 0);
1079 if ((status & 1) != 1)
1080 LIB$SIGNAL (status);
1081 if ((iosb.status & 1) != 1)
1082 LIB$SIGNAL (iosb.status);
1083
1084 Fat.create = newtime;
1085 Fat.revise = revtime;
1086
1087 status = SYS$QIOW (0, chan, IO$_DEACCESS, &iosb, 0, 0,
1088 &fibdsc, 0, 0, 0, &atrlst, 0);
1089 if ((status & 1) != 1)
1090 LIB$SIGNAL (status);
1091 if ((iosb.status & 1) != 1)
1092 LIB$SIGNAL (iosb.status);
1093
1094 /* Deassign the channel and exit. */
1095 status = SYS$DASSGN (chan);
1096 if ((status & 1) != 1)
1097 LIB$SIGNAL (status);
1098#else
1099 struct utimbuf utimbuf;
1100 time_t t;
1101
1102 /* Set modification time to requested time */
1103 utimbuf.modtime = time_stamp;
1104
1105 /* Set access time to now in local time */
1106 t = time ((time_t) 0);
1107 utimbuf.actime = mktime (localtime (&t));
1108
1109 utime (name, &utimbuf);
1110#endif
1111}
1112
1fac938e 1113void
1114__gnat_get_env_value_ptr (name, len, value)
1115 char *name;
1116 int *len;
1117 char **value;
1118{
1119 *value = getenv (name);
1120 if (!*value)
1121 *len = 0;
1122 else
1123 *len = strlen (*value);
1124
1125 return;
1126}
1127
1128/* VMS specific declarations for set_env_value. */
1129
1130#ifdef VMS
1131
1132static char *to_host_path_spec PROTO ((char *));
1133
1134struct descriptor_s
1135{
1136 unsigned short len, mbz;
1137 char *adr;
1138};
1139
1140typedef struct _ile3
1141{
1142 unsigned short len, code;
1143 char *adr;
1144 unsigned short *retlen_adr;
1145} ile_s;
1146
1147#endif
1148
1149void
1150__gnat_set_env_value (name, value)
1151 char *name;
1152 char *value;
1153{
1154#ifdef MSDOS
1155
1156#elif defined (VMS)
1157 struct descriptor_s name_desc;
1158 /* Put in JOB table for now, so that the project stuff at least works */
1159 struct descriptor_s table_desc = {7, 0, "LNM$JOB"};
1160 char *host_pathspec = to_host_path_spec (value);
1161 char *copy_pathspec;
1162 int num_dirs_in_pathspec = 1;
1163 char *ptr;
1164
1165 if (*host_pathspec == 0)
1166 return;
1167
1168 name_desc.len = strlen (name);
1169 name_desc.mbz = 0;
1170 name_desc.adr = name;
1171
1172 ptr = host_pathspec;
1173 while (*ptr++)
1174 if (*ptr == ',')
1175 num_dirs_in_pathspec++;
1176
1177 {
1178 int i, status;
1179 ile_s *ile_array = alloca (sizeof (ile_s) * (num_dirs_in_pathspec + 1));
1180 char *copy_pathspec = alloca (strlen (host_pathspec) + 1);
1181 char *curr, *next;
1182
1183 strcpy (copy_pathspec, host_pathspec);
1184 curr = copy_pathspec;
1185 for (i = 0; i < num_dirs_in_pathspec; i++)
1186 {
1187 next = strchr (curr, ',');
1188 if (next == 0)
1189 next = strchr (curr, 0);
1190
1191 *next = 0;
1192 ile_array [i].len = strlen (curr);
1193
1194 /* Code 2 from lnmdef.h means its a string */
1195 ile_array [i].code = 2;
1196 ile_array [i].adr = curr;
1197
1198 /* retlen_adr is ignored */
1199 ile_array [i].retlen_adr = 0;
1200 curr = next + 1;
1201 }
1202
1203 /* Terminating item must be zero */
1204 ile_array [i].len = 0;
1205 ile_array [i].code = 0;
1206 ile_array [i].adr = 0;
1207 ile_array [i].retlen_adr = 0;
1208
1209 status = LIB$SET_LOGICAL (&name_desc, 0, &table_desc, 0, ile_array);
1210 if ((status & 1) != 1)
1211 LIB$SIGNAL (status);
1212 }
1213
1214#else
1215 int size = strlen (name) + strlen (value) + 2;
1216 char *expression;
1217
1218 expression = (char *) xmalloc (size * sizeof (char));
1219
1220 sprintf (expression, "%s=%s", name, value);
1221 putenv (expression);
1222#endif
1223}
1224
1225#ifdef _WIN32
1226#include <windows.h>
1227#endif
1228
1229/* Get the list of installed standard libraries from the
1230 HKEY_LOCAL_MACHINE\SOFTWARE\Ada Core Technologies\GNAT\Standard Libraries
1231 key. */
1232
1233char *
1234__gnat_get_libraries_from_registry ()
1235{
1236 char *result = (char *) "";
1237
1238#if defined (_WIN32) && ! defined (__vxworks) && ! defined (CROSS_COMPILE)
1239
1240 HKEY reg_key;
1241 DWORD name_size, value_size;
1242 char name[256];
1243 char value[256];
1244 DWORD type;
1245 DWORD index;
1246 LONG res;
1247
1248 /* First open the key. */
1249 res = RegOpenKeyExA (HKEY_LOCAL_MACHINE, "SOFTWARE", 0, KEY_READ, &reg_key);
1250
1251 if (res == ERROR_SUCCESS)
1252 res = RegOpenKeyExA (reg_key, "Ada Core Technologies", 0,
1253 KEY_READ, &reg_key);
1254
1255 if (res == ERROR_SUCCESS)
1256 res = RegOpenKeyExA (reg_key, "GNAT", 0, KEY_READ, &reg_key);
1257
1258 if (res == ERROR_SUCCESS)
1259 res = RegOpenKeyExA (reg_key, "Standard Libraries", 0, KEY_READ, &reg_key);
1260
1261 /* If the key exists, read out all the values in it and concatenate them
1262 into a path. */
1263 for (index = 0; res == ERROR_SUCCESS; index++)
1264 {
1265 value_size = name_size = 256;
1266 res = RegEnumValue (reg_key, index, name, &name_size, 0,
1267 &type, value, &value_size);
1268
1269 if (res == ERROR_SUCCESS && type == REG_SZ)
1270 {
1271 char *old_result = result;
1272
1273 result = (char *) xmalloc (strlen (old_result) + value_size + 2);
1274 strcpy (result, old_result);
1275 strcat (result, value);
1276 strcat (result, ";");
1277 }
1278 }
1279
1280 /* Remove the trailing ";". */
1281 if (result[0] != 0)
1282 result[strlen (result) - 1] = 0;
1283
1284#endif
1285 return result;
1286}
1287
1288int
1289__gnat_stat (name, statbuf)
1290 char *name;
1291 struct stat *statbuf;
1292{
1293#ifdef _WIN32
1294 /* Under Windows the directory name for the stat function must not be
1295 terminated by a directory separator except if just after a drive name. */
1296 int name_len = strlen (name);
1297 char last_char = name [name_len - 1];
1298 char win32_name [4096];
1299
1300 strcpy (win32_name, name);
1301
1302 while (name_len > 1 && (last_char == '\\' || last_char == '/'))
1303 {
1304 win32_name [name_len - 1] = '\0';
1305 name_len--;
1306 last_char = win32_name[name_len - 1];
1307 }
1308
1309 if (name_len == 2 && win32_name [1] == ':')
1310 strcat (win32_name, "\\");
1311
1312 return stat (win32_name, statbuf);
1313
1314#else
1315 return stat (name, statbuf);
1316#endif
1317}
1318
1319int
1320__gnat_file_exists (name)
1321 char *name;
1322{
1323 struct stat statbuf;
1324
1325 return !__gnat_stat (name, &statbuf);
1326}
1327
1328int
1329__gnat_is_absolute_path (name)
1330 char *name;
1331{
1332 return (*name == '/' || *name == DIR_SEPARATOR
1333#if defined(__EMX__) || defined(MSDOS) || defined(WINNT)
1334 || strlen (name) > 1 && isalpha (name [0]) && name [1] == ':'
1335#endif
1336 );
1337}
1338
1339int
1340__gnat_is_regular_file (name)
1341 char *name;
1342{
1343 int ret;
1344 struct stat statbuf;
1345
1346 ret = __gnat_stat (name, &statbuf);
1347 return (!ret && S_ISREG (statbuf.st_mode));
1348}
1349
1350int
1351__gnat_is_directory (name)
1352 char *name;
1353{
1354 int ret;
1355 struct stat statbuf;
1356
1357 ret = __gnat_stat (name, &statbuf);
1358 return (!ret && S_ISDIR (statbuf.st_mode));
1359}
1360
1361int
1362__gnat_is_writable_file (name)
1363 char *name;
1364{
1365 int ret;
1366 int mode;
1367 struct stat statbuf;
1368
1369 ret = __gnat_stat (name, &statbuf);
1370 mode = statbuf.st_mode & S_IWUSR;
1371 return (!ret && mode);
1372}
1373
1374#ifdef VMS
1375/* Defined in VMS header files */
1376#define fork() (decc$$alloc_vfork_blocks() >= 0 ? \
1377 LIB$GET_CURRENT_INVO_CONTEXT (decc$$get_vfork_jmpbuf()) : -1)
1378#endif
1379
1380#if defined (sun) && defined (__SVR4)
1381/* Using fork on Solaris will duplicate all the threads. fork1, which
1382 duplicates only the active thread, must be used instead, or spawning
1383 subprocess from a program with tasking will lead into numerous problems. */
1384#define fork fork1
1385#endif
1386
1387int
1388__gnat_portable_spawn (args)
1389 char *args[];
1390{
1391 int status = 0;
1392 int finished;
1393 int pid;
1394
1395#if defined (MSDOS) || defined (_WIN32)
1396 status = spawnvp (P_WAIT, args [0], args);
1397 if (status < 0)
1398 return 4;
1399 else
1400 return status;
1401
1402#elif defined(__vxworks) /* Mods for VxWorks */
1403 pid = sp (args[0], args); /* Spawn process and save pid */
1404 if (pid == -1)
1405 return (4);
1406
1407 while (taskIdVerify(pid) >= 0)
1408 /* Wait until spawned task is complete then continue. */
1409 ;
1410#else
1411
1412#ifdef __EMX__
1413 pid = spawnvp (P_NOWAIT, args [0], args);
1414 if (pid == -1)
1415 return (4);
1416#else
1417 pid = fork ();
1418 if (pid == -1)
1419 return (4);
1420
1421 if (pid == 0 && execv (args [0], args) != 0)
1422 _exit (1);
1423#endif
1424
1425 /* The parent */
1426 finished = waitpid (pid, &status, 0);
1427
1428 if (finished != pid || WIFEXITED (status) == 0)
1429 return 4;
1430
1431 return WEXITSTATUS (status);
1432#endif
1433 return 0;
1434}
1435
1436/* WIN32 code to implement a wait call that wait for any child process */
1437#ifdef _WIN32
1438
1439/* Synchronization code, to be thread safe. */
1440
1441static CRITICAL_SECTION plist_cs;
1442
1443void
1444__gnat_plist_init ()
1445{
1446 InitializeCriticalSection (&plist_cs);
1447}
1448
1449static void
1450plist_enter ()
1451{
1452 EnterCriticalSection (&plist_cs);
1453}
1454
1455void
1456plist_leave ()
1457{
1458 LeaveCriticalSection (&plist_cs);
1459}
1460
1461typedef struct _process_list
1462{
1463 HANDLE h;
1464 struct _process_list *next;
1465} Process_List;
1466
1467static Process_List *PLIST = NULL;
1468
1469static int plist_length = 0;
1470
1471static void
1472add_handle (h)
1473 HANDLE h;
1474{
1475 Process_List *pl;
1476
1477 pl = (Process_List *) xmalloc (sizeof (Process_List));
1478
1479 plist_enter();
1480
1481 /* -------------------- critical section -------------------- */
1482 pl->h = h;
1483 pl->next = PLIST;
1484 PLIST = pl;
1485 ++plist_length;
1486 /* -------------------- critical section -------------------- */
1487
1488 plist_leave();
1489}
1490
1491void remove_handle (h)
1492 HANDLE h;
1493{
1494 Process_List *pl, *prev;
1495
1496 plist_enter();
1497
1498 /* -------------------- critical section -------------------- */
1499 pl = PLIST;
1500 while (pl)
1501 {
1502 if (pl->h == h)
1503 {
1504 if (pl == PLIST)
1505 PLIST = pl->next;
1506 else
1507 prev->next = pl->next;
1508 free (pl);
1509 break;
1510 }
1511 else
1512 {
1513 prev = pl;
1514 pl = pl->next;
1515 }
1516 }
1517
1518 --plist_length;
1519 /* -------------------- critical section -------------------- */
1520
1521 plist_leave();
1522}
1523
1524static int
1525win32_no_block_spawn (command, args)
1526 char *command;
1527 char *args[];
1528{
1529 BOOL result;
1530 STARTUPINFO SI;
1531 PROCESS_INFORMATION PI;
1532 SECURITY_ATTRIBUTES SA;
1533
1534 char full_command [2000];
1535 int k;
1536
1537 /* Startup info. */
1538 SI.cb = sizeof (STARTUPINFO);
1539 SI.lpReserved = NULL;
1540 SI.lpReserved2 = NULL;
1541 SI.lpDesktop = NULL;
1542 SI.cbReserved2 = 0;
1543 SI.lpTitle = NULL;
1544 SI.dwFlags = 0;
1545 SI.wShowWindow = SW_HIDE;
1546
1547 /* Security attributes. */
1548 SA.nLength = sizeof (SECURITY_ATTRIBUTES);
1549 SA.bInheritHandle = TRUE;
1550 SA.lpSecurityDescriptor = NULL;
1551
1552 /* Prepare the command string. */
1553 strcpy (full_command, command);
1554 strcat (full_command, " ");
1555
1556 k = 1;
1557 while (args[k])
1558 {
1559 strcat (full_command, args[k]);
1560 strcat (full_command, " ");
1561 k++;
1562 }
1563
1564 result = CreateProcess (NULL, (char *) full_command, &SA, NULL, TRUE,
1565 NORMAL_PRIORITY_CLASS, NULL, NULL, &SI, &PI);
1566
1567 if (result == TRUE)
1568 {
1569 add_handle (PI.hProcess);
1570 CloseHandle (PI.hThread);
1571 return (int) PI.hProcess;
1572 }
1573 else
1574 return -1;
1575}
1576
1577static int
1578win32_wait (status)
1579 int *status;
1580{
1581 DWORD exitcode;
1582 HANDLE *hl;
1583 HANDLE h;
1584 DWORD res;
1585 int k;
1586 Process_List *pl;
1587
1588 if (plist_length == 0)
1589 {
1590 errno = ECHILD;
1591 return -1;
1592 }
1593
1594 hl = (HANDLE *) xmalloc (sizeof (HANDLE) * plist_length);
1595
1596 k = 0;
1597 plist_enter();
1598
1599 /* -------------------- critical section -------------------- */
1600 pl = PLIST;
1601 while (pl)
1602 {
1603 hl[k++] = pl->h;
1604 pl = pl->next;
1605 }
1606 /* -------------------- critical section -------------------- */
1607
1608 plist_leave();
1609
1610 res = WaitForMultipleObjects (plist_length, hl, FALSE, INFINITE);
1611 h = hl [res - WAIT_OBJECT_0];
1612 free (hl);
1613
1614 remove_handle (h);
1615
1616 GetExitCodeProcess (h, &exitcode);
1617 CloseHandle (h);
1618
1619 *status = (int) exitcode;
1620 return (int) h;
1621}
1622
1623#endif
1624
1625int
1626__gnat_portable_no_block_spawn (args)
1627 char *args[];
1628{
1629 int pid = 0;
1630
1631#if defined (__EMX__) || defined (MSDOS)
1632
1633 /* ??? For PC machines I (Franco) don't know the system calls to implement
1634 this routine. So I'll fake it as follows. This routine will behave
1635 exactly like the blocking portable_spawn and will systematically return
1636 a pid of 0 unless the spawned task did not complete successfully, in
1637 which case we return a pid of -1. To synchronize with this the
1638 portable_wait below systematically returns a pid of 0 and reports that
1639 the subprocess terminated successfully. */
1640
1641 if (spawnvp (P_WAIT, args [0], args) != 0)
1642 return -1;
1643
1644#elif defined (_WIN32)
1645
1646 pid = win32_no_block_spawn (args[0], args);
1647 return pid;
1648
1649#elif defined (__vxworks) /* Mods for VxWorks */
1650 pid = sp (args[0], args); /* Spawn task and then return (no waiting) */
1651 if (pid == -1)
1652 return (4);
1653
1654 return pid;
1655
1656#else
1657 pid = fork ();
1658
1659 if (pid == 0 && execv (args [0], args) != 0)
1660 _exit (1);
1661#endif
1662
1663 return pid;
1664}
1665
1666int
1667__gnat_portable_wait (process_status)
1668 int *process_status;
1669{
1670 int status = 0;
1671 int pid = 0;
1672
1673#if defined (_WIN32)
1674
1675 pid = win32_wait (&status);
1676
1677#elif defined (__EMX__) || defined (MSDOS)
1678 /* ??? See corresponding comment in portable_no_block_spawn. */
1679
1680#elif defined (__vxworks)
1681 /* Not sure what to do here, so do same as __EMX__ case, i.e., nothing but
1682 return zero. */
1683#else
1684
1685#ifdef VMS
1686 /* Wait doesn't do the right thing on VMS */
1687 pid = waitpid (-1, &status, 0);
1688#else
1689 pid = wait (&status);
1690#endif
1691 status = status & 0xffff;
1692#endif
1693
1694 *process_status = status;
1695 return pid;
1696}
1697
1698void
1699__gnat_os_exit (status)
1700 int status;
1701{
1702#ifdef VMS
1703 /* Exit without changing 0 to 1 */
1704 __posix_exit (status);
1705#else
1706 exit (status);
1707#endif
1708}
1709
1710/* Locate a regular file, give a Path value */
1711
1712char *
1713__gnat_locate_regular_file (file_name, path_val)
1714 char *file_name;
1715 char *path_val;
1716{
1717 char *ptr;
1718
1719 /* Handle absolute pathnames. */
1720 for (ptr = file_name; *ptr && *ptr != '/' && *ptr != DIR_SEPARATOR; ptr++)
1721 ;
1722
1723 if (*ptr != 0
1724#if defined(__EMX__) || defined(MSDOS) || defined(WINNT)
1725 || isalpha (file_name [0]) && file_name [1] == ':'
1726#endif
1727 )
1728 {
1729 if (__gnat_is_regular_file (file_name))
1730 return xstrdup (file_name);
1731
1732 return 0;
1733 }
1734
1735 if (path_val == 0)
1736 return 0;
1737
1738 {
1739 /* The result has to be smaller than path_val + file_name. */
1740 char *file_path = alloca (strlen (path_val) + strlen (file_name) + 2);
1741
1742 for (;;)
1743 {
1744 for (; *path_val == PATH_SEPARATOR; path_val++)
1745 ;
1746
1747 if (*path_val == 0)
1748 return 0;
1749
1750 for (ptr = file_path; *path_val && *path_val != PATH_SEPARATOR; )
1751 *ptr++ = *path_val++;
1752
1753 ptr--;
1754 if (*ptr != '/' && *ptr != DIR_SEPARATOR)
1755 *++ptr = DIR_SEPARATOR;
1756
1757 strcpy (++ptr, file_name);
1758
1759 if (__gnat_is_regular_file (file_path))
1760 return xstrdup (file_path);
1761 }
1762 }
1763
1764 return 0;
1765}
1766
1767
1768/* Locate an executable given a Path argument. This routine is only used by
1769 gnatbl and should not be used otherwise. Use locate_exec_on_path
1770 instead. */
1771
1772char *
1773__gnat_locate_exec (exec_name, path_val)
1774 char *exec_name;
1775 char *path_val;
1776{
1777 if (!strstr (exec_name, HOST_EXECUTABLE_SUFFIX))
1778 {
1779 char *full_exec_name
1780 = alloca (strlen (exec_name) + strlen (HOST_EXECUTABLE_SUFFIX) + 1);
1781
1782 strcpy (full_exec_name, exec_name);
1783 strcat (full_exec_name, HOST_EXECUTABLE_SUFFIX);
1784 return __gnat_locate_regular_file (full_exec_name, path_val);
1785 }
1786 else
1787 return __gnat_locate_regular_file (exec_name, path_val);
1788}
1789
1790/* Locate an executable using the Systems default PATH */
1791
1792char *
1793__gnat_locate_exec_on_path (exec_name)
1794 char *exec_name;
1795{
1796#ifdef VMS
1797 char *path_val = "/VAXC$PATH";
1798#else
1799 char *path_val = getenv ("PATH");
1800#endif
1801 char *apath_val = alloca (strlen (path_val) + 1);
1802
1803 strcpy (apath_val, path_val);
1804 return __gnat_locate_exec (exec_name, apath_val);
1805}
1806
1807#ifdef VMS
1808
1809/* These functions are used to translate to and from VMS and Unix syntax
1810 file, directory and path specifications. */
1811
1812#define MAXNAMES 256
1813#define NEW_CANONICAL_FILELIST_INCREMENT 64
1814
1815static char new_canonical_dirspec [255];
1816static char new_canonical_filespec [255];
1817static char new_canonical_pathspec [MAXNAMES*255];
1818static unsigned new_canonical_filelist_index;
1819static unsigned new_canonical_filelist_in_use;
1820static unsigned new_canonical_filelist_allocated;
1821static char **new_canonical_filelist;
1822static char new_host_pathspec [MAXNAMES*255];
1823static char new_host_dirspec [255];
1824static char new_host_filespec [255];
1825
1826/* Routine is called repeatedly by decc$from_vms via
1827 __gnat_to_canonical_file_list_init until it returns 0 or the expansion
1828 runs out. */
1829
1830static int
1831wildcard_translate_unix (name)
1832 char *name;
1833{
1834 char *ver;
1835 char buff [256];
1836
1837 strcpy (buff, name);
1838 ver = strrchr (buff, '.');
1839
1840 /* Chop off the version */
1841 if (ver)
1842 *ver = 0;
1843
1844 /* Dynamically extend the allocation by the increment */
1845 if (new_canonical_filelist_in_use == new_canonical_filelist_allocated)
1846 {
1847 new_canonical_filelist_allocated += NEW_CANONICAL_FILELIST_INCREMENT;
1848 new_canonical_filelist = (char **) realloc
1849 (new_canonical_filelist,
1850 new_canonical_filelist_allocated * sizeof (char *));
1851 }
1852
1853 new_canonical_filelist[new_canonical_filelist_in_use++] = xstrdup (buff);
1854
1855 return 1;
1856}
1857
1858/* Translate a wildcard VMS file spec into a list of Unix file
1859 specs. First do full translation and copy the results into a list (_init),
1860 then return them one at a time (_next). If onlydirs set, only expand
1861 directory files. */
1862
1863int
1864__gnat_to_canonical_file_list_init (filespec, onlydirs)
1865 char *filespec;
1866 int onlydirs;
1867{
1868 int len;
1869 char buff [256];
1870
1871 len = strlen (filespec);
1872 strcpy (buff, filespec);
1873
1874 /* Only look for directories */
1875 if (onlydirs && !strstr (&buff [len-5], "*.dir"))
1876 strcat (buff, "*.dir");
1877
1878 decc$from_vms (buff, wildcard_translate_unix, 1);
1879
1880 /* Remove the .dir extension */
1881 if (onlydirs)
1882 {
1883 int i;
1884 char *ext;
1885
1886 for (i = 0; i < new_canonical_filelist_in_use; i++)
1887 {
1888 ext = strstr (new_canonical_filelist [i], ".dir");
1889 if (ext)
1890 *ext = 0;
1891 }
1892 }
1893
1894 return new_canonical_filelist_in_use;
1895}
1896
1897/* Return the next filespec in the list */
1898
1899char *
1900__gnat_to_canonical_file_list_next ()
1901{
1902 return new_canonical_filelist [new_canonical_filelist_index++];
1903}
1904
1905/* Free up storage used in the wildcard expansion */
1906
1907void
1908__gnat_to_canonical_file_list_free ()
1909{
1910 int i;
1911
1912 for (i = 0; i < new_canonical_filelist_in_use; i++)
1913 free (new_canonical_filelist [i]);
1914
1915 free (new_canonical_filelist);
1916
1917 new_canonical_filelist_in_use = 0;
1918 new_canonical_filelist_allocated = 0;
1919 new_canonical_filelist_index = 0;
1920 new_canonical_filelist = 0;
1921}
1922
1923/* Translate a VMS syntax directory specification in to Unix syntax.
1924 If prefixflag is set, append an underscore "/". If no indicators
1925 of VMS syntax found, return input string. Also translate a dirname
1926 that contains no slashes, in case it's a logical name. */
1927
1928char *
1929__gnat_to_canonical_dir_spec (dirspec,prefixflag)
1930 char *dirspec;
1931 int prefixflag;
1932{
1933 int len;
1934
1935 strcpy (new_canonical_dirspec, "");
1936 if (strlen (dirspec))
1937 {
1938 char *dirspec1;
1939
1940 if (strchr (dirspec, ']') || strchr (dirspec, ':'))
1941 strcpy (new_canonical_dirspec, (char *) decc$translate_vms (dirspec));
1942 else if (!strchr (dirspec, '/') && (dirspec1 = getenv (dirspec)) != 0)
1943 strcpy (new_canonical_dirspec, (char *) decc$translate_vms (dirspec1));
1944 else
1945 strcpy (new_canonical_dirspec, dirspec);
1946 }
1947
1948 len = strlen (new_canonical_dirspec);
1949 if (prefixflag && new_canonical_dirspec [len-1] != '/')
1950 strcat (new_canonical_dirspec, "/");
1951
1952 return new_canonical_dirspec;
1953
1954}
1955
1956/* Translate a VMS syntax file specification into Unix syntax.
1957 If no indicators of VMS syntax found, return input string. */
1958
1959char *
1960__gnat_to_canonical_file_spec (filespec)
1961 char *filespec;
1962{
1963 strcpy (new_canonical_filespec, "");
1964 if (strchr (filespec, ']') || strchr (filespec, ':'))
1965 strcpy (new_canonical_filespec, (char *) decc$translate_vms (filespec));
1966 else
1967 strcpy (new_canonical_filespec, filespec);
1968
1969 return new_canonical_filespec;
1970}
1971
1972/* Translate a VMS syntax path specification into Unix syntax.
1973 If no indicators of VMS syntax found, return input string. */
1974
1975char *
1976__gnat_to_canonical_path_spec (pathspec)
1977 char *pathspec;
1978{
1979 char *curr, *next, buff [256];
1980
1981 if (pathspec == 0)
1982 return pathspec;
1983
1984 /* If there are /'s, assume it's a Unix path spec and return */
1985 if (strchr (pathspec, '/'))
1986 return pathspec;
1987
1988 new_canonical_pathspec [0] = 0;
1989 curr = pathspec;
1990
1991 for (;;)
1992 {
1993 next = strchr (curr, ',');
1994 if (next == 0)
1995 next = strchr (curr, 0);
1996
1997 strncpy (buff, curr, next - curr);
1998 buff [next - curr] = 0;
1999
2000 /* Check for wildcards and expand if present */
2001 if (strchr (buff, '*') || strchr (buff, '%') || strstr (buff, "..."))
2002 {
2003 int i, dirs;
2004
2005 dirs = __gnat_to_canonical_file_list_init (buff, 1);
2006 for (i = 0; i < dirs; i++)
2007 {
2008 char *next_dir;
2009
2010 next_dir = __gnat_to_canonical_file_list_next ();
2011 strcat (new_canonical_pathspec, next_dir);
2012
2013 /* Don't append the separator after the last expansion */
2014 if (i+1 < dirs)
2015 strcat (new_canonical_pathspec, ":");
2016 }
2017
2018 __gnat_to_canonical_file_list_free ();
2019 }
2020 else
2021 strcat (new_canonical_pathspec,
2022 __gnat_to_canonical_dir_spec (buff, 0));
2023
2024 if (*next == 0)
2025 break;
2026
2027 strcat (new_canonical_pathspec, ":");
2028 curr = next + 1;
2029 }
2030
2031 return new_canonical_pathspec;
2032}
2033
2034static char filename_buff [256];
2035
2036static int
2037translate_unix (name, type)
2038 char *name;
2039 int type;
2040{
2041 strcpy (filename_buff, name);
2042 return 0;
2043}
2044
2045/* Translate a Unix syntax path spec into a VMS style (comma separated
2046 list of directories. Only used in this file so make it static */
2047
2048static char *
2049to_host_path_spec (pathspec)
2050 char *pathspec;
2051{
2052 char *curr, *next, buff [256];
2053
2054 if (pathspec == 0)
2055 return pathspec;
2056
2057 /* Can't very well test for colons, since that's the Unix separator! */
2058 if (strchr (pathspec, ']') || strchr (pathspec, ','))
2059 return pathspec;
2060
2061 new_host_pathspec [0] = 0;
2062 curr = pathspec;
2063
2064 for (;;)
2065 {
2066 next = strchr (curr, ':');
2067 if (next == 0)
2068 next = strchr (curr, 0);
2069
2070 strncpy (buff, curr, next - curr);
2071 buff [next - curr] = 0;
2072
2073 strcat (new_host_pathspec, __gnat_to_host_dir_spec (buff, 0));
2074 if (*next == 0)
2075 break;
2076 strcat (new_host_pathspec, ",");
2077 curr = next + 1;
2078 }
2079
2080 return new_host_pathspec;
2081}
2082
2083/* Translate a Unix syntax directory specification into VMS syntax.
2084 The prefixflag has no effect, but is kept for symmetry with
2085 to_canonical_dir_spec.
2086 If indicators of VMS syntax found, return input string. */
2087
2088char *
2089__gnat_to_host_dir_spec (dirspec, prefixflag)
2090 char *dirspec;
2091 int prefixflag;
2092{
2093 int len = strlen (dirspec);
2094
2095 strcpy (new_host_dirspec, dirspec);
2096
2097 if (strchr (new_host_dirspec, ']') || strchr (new_host_dirspec, ':'))
2098 return new_host_dirspec;
2099
2100 while (len > 1 && new_host_dirspec [len-1] == '/')
2101 {
2102 new_host_dirspec [len-1] = 0;
2103 len--;
2104 }
2105
2106 decc$to_vms (new_host_dirspec, translate_unix, 1, 2);
2107 strcpy (new_host_dirspec, filename_buff);
2108
2109 return new_host_dirspec;
2110
2111}
2112
2113/* Translate a Unix syntax file specification into VMS syntax.
2114 If indicators of VMS syntax found, return input string. */
2115
2116char *
2117__gnat_to_host_file_spec (filespec)
2118 char *filespec;
2119{
2120 strcpy (new_host_filespec, "");
2121 if (strchr (filespec, ']') || strchr (filespec, ':'))
2122 strcpy (new_host_filespec, filespec);
2123 else
2124 {
2125 decc$to_vms (filespec, translate_unix, 1, 1);
2126 strcpy (new_host_filespec, filename_buff);
2127 }
2128
2129 return new_host_filespec;
2130}
2131
2132void
2133__gnat_adjust_os_resource_limits ()
2134{
2135 SYS$ADJWSL (131072, 0);
2136}
2137
2138#else
2139
2140/* Dummy functions for Osint import for non-VMS systems */
2141
2142int
2143__gnat_to_canonical_file_list_init (dirspec, onlydirs)
2144 char *dirspec ATTRIBUTE_UNUSED;
2145 int onlydirs ATTRIBUTE_UNUSED;
2146{
2147 return 0;
2148}
2149
2150char *
2151__gnat_to_canonical_file_list_next ()
2152{
2153 return (char *) "";
2154}
2155
2156void
2157__gnat_to_canonical_file_list_free ()
2158{
2159}
2160
2161char *
2162__gnat_to_canonical_dir_spec (dirspec, prefixflag)
2163 char *dirspec;
2164 int prefixflag ATTRIBUTE_UNUSED;
2165{
2166 return dirspec;
2167}
2168
2169char *
2170__gnat_to_canonical_file_spec (filespec)
2171 char *filespec;
2172{
2173 return filespec;
2174}
2175
2176char *
2177__gnat_to_canonical_path_spec (pathspec)
2178 char *pathspec;
2179{
2180 return pathspec;
2181}
2182
2183char *
2184__gnat_to_host_dir_spec (dirspec, prefixflag)
2185 char *dirspec;
2186 int prefixflag ATTRIBUTE_UNUSED;
2187{
2188 return dirspec;
2189}
2190
2191char *
2192__gnat_to_host_file_spec (filespec)
2193 char *filespec;
2194{
2195 return filespec;
2196}
2197
2198void
2199__gnat_adjust_os_resource_limits ()
2200{
2201}
2202
2203#endif
2204
2205/* for EMX, we cannot include dummy in libgcc, since it is too difficult
2206 to coordinate this with the EMX distribution. Consequently, we put the
2207 definition of dummy() which is used for exception handling, here */
2208
2209#if defined (__EMX__)
2210void __dummy () {}
2211#endif
2212
2213#if defined (__mips_vxworks)
2214int _flush_cache()
2215{
2216 CACHE_USER_FLUSH (0, ENTIRE_CACHE);
2217}
2218#endif
2219
2220#if defined (CROSS_COMPILE) \
2221 || (! (defined (sparc) && defined (sun) && defined (__SVR4)) \
2222 && ! defined (linux) \
2223 && ! defined (sgi) \
2224 && ! defined (hpux) \
2225 && ! (defined (__alpha__) && defined (__osf__)) \
2226 && ! defined (__MINGW32__))
2227/* Dummy function to satisfy g-trasym.o.
f9c9d5d3 2228 Currently Solaris sparc, HP/UX, IRIX, GNU/Linux, Tru64 & Windows provide a
1fac938e 2229 non-dummy version of this procedure in libaddr2line.a */
2230
2231void
2232convert_addresses (addrs, n_addr, buf, len)
2233 void *addrs ATTRIBUTE_UNUSED;
2234 int n_addr ATTRIBUTE_UNUSED;
2235 void *buf ATTRIBUTE_UNUSED;
2236 int *len;
2237{
2238 *len = 0;
2239}
2240#endif
Mirror of https://gcc.gnu.org/git/gcc.git