OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

adaint.c, [...] (to_ptr32): New function.

Browse Source 
2005-02-09  Doug Rupp  <rupp@adacore.com>
	    Thomas Quinot  <quinot@adacore.com>

	* adaint.c, adaint.h
	[VMS] (to_ptr32): New function.
	(MAYBE_TO_PTR32): New macro.
	(__gnat_portable_spawn,__gnat_portable_no_block_spawn): Adjust argv
	for pointer size.
	[VMS] (descriptor_s, ile_s): Use __char_ptr32 for adr field.
	[VMS] (#define fork()): Remove since unneccessary.
	(__gnat_set_close_on_exec): New routine to support
	GNAT.OS_Lib.Set_Close_On_Exec.

	* g-expect.adb (Set_Up_Communications): Mark the pipe descriptors for
	the parent side as close-on-exec so that they are not inherited by the
	child.

	* g-os_lib.ads, g-os_lib.adb (Set_Close_On_Exec): New subprogram to
	set or clear the FD_CLOEXEC flag on a file descriptor.

From-SVN: r94811
This commit is contained in:
Doug Rupp 2005-02-10 14:51:58 +01:00 committed by Arnaud Charlet
parent 4e45e7a930
commit cc892b2c91
5 changed files with 326 additions and 240 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
gcc/ada/adaint.c
View File

@ -6,7 +6,7 @@
* * * *
* C Implementation File * * C Implementation File *
* * * *
* Copyright (C) 1992-2004, Free Software Foundation, Inc. * * Copyright (C) 1992-2005, Free Software Foundation, Inc. *
* * * *
* GNAT is free software; you can redistribute it and/or modify it under * * GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- * * terms of the GNU General Public License as published by the Free Soft- *
@ -277,6 +277,37 @@ int max_path_len = GNAT_MAX_PATH_LEN;
system provides the routine readdir_r. */ system provides the routine readdir_r. */
#undef HAVE_READDIR_R #undef HAVE_READDIR_R
#if defined(VMS) && defined (__LONG_POINTERS)
/* Return a 32 bit pointer to an array of 32 bit pointers
given a 64 bit pointer to an array of 64 bit pointers */
typedef __char_ptr32 *__char_ptr_char_ptr32 __attribute__ ((mode (SI)));
static __char_ptr_char_ptr32
to_ptr32 (char **ptr64)
{
int argc;
__char_ptr_char_ptr32 short_argv;
for (argc=0; ptr64[argc]; argc++);
/* Reallocate argv with 32 bit pointers. */
short_argv = (__char_ptr_char_ptr32) decc$malloc
(sizeof (__char_ptr32) * (argc + 1));
for (argc=0; ptr64[argc]; argc++)
short_argv[argc] = (__char_ptr32) decc$strdup (ptr64[argc]);
short_argv[argc] = (__char_ptr32) 0;
return short_argv;
}
#define MAYBE_TO_PTR32(argv) to_ptr32 (argv)
#else
#define MAYBE_TO_PTR32(argv) argv
#endif
void void
__gnat_to_gm_time __gnat_to_gm_time
(OS_Time *p_time, (OS_Time *p_time,
@ -1213,13 +1244,13 @@ static char *to_host_path_spec (char *);
struct descriptor_s struct descriptor_s
{ {
unsigned short len, mbz; unsigned short len, mbz;
char *adr; __char_ptr32 adr;
}; };
typedef struct _ile3 typedef struct _ile3
{ {
unsigned short len, code; unsigned short len, code;
char *adr; __char_ptr32 adr;
unsigned short *retlen_adr; unsigned short *retlen_adr;
} ile_s; } ile_s;
@ -1524,17 +1555,6 @@ __gnat_is_symbolic_link (char *name ATTRIBUTE_UNUSED)
#endif #endif
} }
#ifdef VMS
/* Defined in VMS header files. */
#if defined (__ALPHA)
#define fork() (decc$$alloc_vfork_blocks() >= 0 ? \
LIB$GET_CURRENT_INVO_CONTEXT (decc$$get_vfork_jmpbuf()) : -1)
#elif defined (__IA64)
#define fork() (decc$$alloc_vfork_blocks() >= 0 ? \
LIB$I64_GET_CURR_INVO_CONTEXT(decc$$get_vfork_jmpbuf()) : -1)
#endif
#endif
#if defined (sun) && defined (__SVR4) #if defined (sun) && defined (__SVR4)
/* Using fork on Solaris will duplicate all the threads. fork1, which /* Using fork on Solaris will duplicate all the threads. fork1, which
duplicates only the active thread, must be used instead, or spawning duplicates only the active thread, must be used instead, or spawning
@ -1585,7 +1605,7 @@ __gnat_portable_spawn (char *args[])
if (pid == 0) if (pid == 0)
{ {
/* The child. */ /* The child. */
if (execv (args[0], args) != 0) if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
#if defined (VMS) #if defined (VMS)
return -1; /* execv is in parent context on VMS. */ return -1; /* execv is in parent context on VMS. */
#else #else
@ -1866,7 +1886,7 @@ __gnat_portable_no_block_spawn (char *args[])
if (pid == 0) if (pid == 0)
{ {
/* The child. */ /* The child. */
if (execv (args[0], args) != 0) if (execv (args[0], MAYBE_TO_PTR32 (args)) != 0)
#if defined (VMS) #if defined (VMS)
return -1; /* execv is in parent context on VMS. */ return -1; /* execv is in parent context on VMS. */
#else #else
@ -2593,3 +2613,24 @@ get_gcc_version (void)
{ {
return 3; return 3;
} }
int
__gnat_set_close_on_exec (int fd, int close_on_exec_p)
{
#if defined (F_GETFD) && defined (FD_CLOEXEC) && ! defined (__vxworks)
int flags = fcntl (fd, F_GETFD, 0);
if (flags < 0)
return flags;
if (close_on_exec_p)
flags |= FD_CLOEXEC;
else
flags &= ~FD_CLOEXEC;
return fcntl (fd, F_SETFD, flags | FD_CLOEXEC);
#else
return -1;
/* For the Windows case, we should use SetHandleInformation to remove
the HANDLE_INHERIT property from fd. This is not implemented yet,
but for our purposes (support of GNAT.Expect) this does not matter,
as by default handles are *not* inherited. */
#endif
}

3
gcc/ada/adaint.h
View File

@ -6,7 +6,7 @@
* * * *
* C Header File * * C Header File *
* * * *
* Copyright (C) 1992-2004 Free Software Foundation, Inc. * * Copyright (C) 1992-2005 Free Software Foundation, Inc. *
* * * *
* GNAT is free software; you can redistribute it and/or modify it under * * GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- * * terms of the GNU General Public License as published by the Free Soft- *
@ -149,6 +149,7 @@ extern void __gnat_set_binary_mode (int);
extern void __gnat_set_text_mode (int); extern void __gnat_set_text_mode (int);
extern char *__gnat_ttyname (int); extern char *__gnat_ttyname (int);
extern int __gnat_lseek (int, long, int); extern int __gnat_lseek (int, long, int);
extern int __gnat_set_close_on_exec (int, int);
extern int __gnat_dup (int); extern int __gnat_dup (int);
extern int __gnat_dup2 (int, int); extern int __gnat_dup2 (int, int);

22
gcc/ada/g-expect.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2000-2003 Ada Core Technologies, Inc. -- -- Copyright (C) 2000-2005 Ada Core Technologies, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -1123,6 +1123,8 @@ package body GNAT.Expect is
Pipe2 : access Pipe_Type; Pipe2 : access Pipe_Type;
Pipe3 : access Pipe_Type) Pipe3 : access Pipe_Type)
is is
Status : Boolean;
begin begin
-- Create the pipes -- Create the pipes
@ -1134,18 +1136,36 @@ package body GNAT.Expect is
return; return;
end if; end if;
-- Record the 'parent' end of the two pipes in Pid:
-- Child stdin is connected to the 'write' end of Pipe1;
-- Child stdout is connected to the 'read' end of Pipe2.
-- We do not want these descriptors to remain open in the child
-- process, so we mark them close-on-exec/non-inheritable.
Pid.Input_Fd := Pipe1.Output; Pid.Input_Fd := Pipe1.Output;
Set_Close_On_Exec (Pipe1.Output, True, Status);
Pid.Output_Fd := Pipe2.Input; Pid.Output_Fd := Pipe2.Input;
Set_Close_On_Exec (Pipe2.Input, True, Status);
if Err_To_Out then if Err_To_Out then
-- Reuse the standard output pipe for standard error
Pipe3.all := Pipe2.all; Pipe3.all := Pipe2.all;
else else
-- Create a separate pipe for standard error
if Create_Pipe (Pipe3) /= 0 then if Create_Pipe (Pipe3) /= 0 then
return; return;
end if; end if;
end if; end if;
-- As above, we record the proper fd for the child's
-- standard error stream.
Pid.Error_Fd := Pipe3.Input; Pid.Error_Fd := Pipe3.Input;
Set_Close_On_Exec (Pipe3.Input, True, Status);
end Set_Up_Communications; end Set_Up_Communications;
---------------------------------- ----------------------------------

27
gcc/ada/g-os_lib.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1995-2004 Ada Core Technologies, Inc. -- -- Copyright (C) 1995-2005 Ada Core Technologies, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -1075,7 +1075,7 @@ package body GNAT.OS_Lib is
S : Integer; S : Integer;
begin begin
-- Use the global lock because To_GM_Time is not thread safe. -- Use the global lock because To_GM_Time is not thread safe
Locked_Processing : begin Locked_Processing : begin
SSL.Lock_Task.all; SSL.Lock_Task.all;
@ -1920,7 +1920,7 @@ package body GNAT.OS_Lib is
if Status <= 0 then if Status <= 0 then
Last := Finish + 1; Last := Finish + 1;
-- Replace symbolic link with its value. -- Replace symbolic link with its value
else else
if Is_Absolute_Path (Link_Buffer (1 .. Status)) then if Is_Absolute_Path (Link_Buffer (1 .. Status)) then
@ -2056,6 +2056,23 @@ package body GNAT.OS_Lib is
Rename_File (C_Old_Name'Address, C_New_Name'Address, Success); Rename_File (C_Old_Name'Address, C_New_Name'Address, Success);
end Rename_File; end Rename_File;
-----------------------
-- Set_Close_On_Exec --
-----------------------
procedure Set_Close_On_Exec
(FD : File_Descriptor;
Close_On_Exec : Boolean;
Status : out Boolean)
is
function C_Set_Close_On_Exec
(FD : File_Descriptor; Close_On_Exec : System.CRTL.int)
return System.CRTL.int;
pragma Import (C, C_Set_Close_On_Exec, "__gnat_set_close_on_exec");
begin
Status := C_Set_Close_On_Exec (FD, Boolean'Pos (Close_On_Exec)) = 0;
end Set_Close_On_Exec;
-------------------- --------------------
-- Set_Executable -- -- Set_Executable --
-------------------- --------------------
@ -2186,7 +2203,7 @@ package body GNAT.OS_Lib is
Dup2 (Saved_Error, Standerr); Dup2 (Saved_Error, Standerr);
end if; end if;
-- And close the saved standard output and error file descriptors. -- And close the saved standard output and error file descriptors
Close (Saved_Output); Close (Saved_Output);
@ -2234,7 +2251,7 @@ package body GNAT.OS_Lib is
is is
procedure Spawn (Args : Argument_List); procedure Spawn (Args : Argument_List);
-- Call Spawn. -- Call Spawn with given argument list
N_Args : Argument_List (Args'Range); N_Args : Argument_List (Args'Range);
-- Normalized arguments -- Normalized arguments

433
gcc/ada/g-os_lib.ads
View File

@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1995-2004 Free Software Foundation, Inc. -- -- Copyright (C) 1995-2005 Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -36,15 +36,15 @@
-- This package contains types and procedures for interfacing to the -- This package contains types and procedures for interfacing to the
-- underlying OS. It is used by the GNAT compiler and by tools associated -- underlying OS. It is used by the GNAT compiler and by tools associated
-- with the GNAT compiler, and therefore works for the various operating -- with the GNAT compiler, and therefore works for the various operating
-- systems to which GNAT has been ported. This package will undoubtedly -- systems to which GNAT has been ported. This package will undoubtedly grow
-- grow as new services are needed by various tools. -- as new services are needed by various tools.
-- This package tends to use fairly low-level Ada in order to not bring -- This package tends to use fairly low-level Ada in order to not bring in
-- in large portions of the RTL. For example, functions return access -- large portions of the RTL. For example, functions return access to string
-- to string as part of avoiding functions returning unconstrained types. -- as part of avoiding functions returning unconstrained types.
-- Except where specifically noted, these routines are portable across -- Except where specifically noted, these routines are portable across all
-- all GNAT implementations on all supported operating systems. -- GNAT implementations on all supported operating systems.
with System; with System;
with GNAT.Strings; with GNAT.Strings;
@ -52,20 +52,23 @@ with GNAT.Strings;
package GNAT.OS_Lib is package GNAT.OS_Lib is
pragma Elaborate_Body (OS_Lib); pragma Elaborate_Body (OS_Lib);
-----------------------
-- String Operations --
-----------------------
-- These are reexported from package Strings (which was introduced to
-- avoid different packages declarting different types unnecessarily).
-- See package GNAT.Strings for details.
subtype String_Access is Strings.String_Access; subtype String_Access is Strings.String_Access;
-- General purpose string access type. Some of the functions in this
-- package allocate string results on the heap, and return a value of
-- this type. Note that the caller is responsible for freeing this
-- String to avoid memory leaks.
function "=" (Left, Right : in String_Access) return Boolean function "=" (Left, Right : in String_Access) return Boolean
renames Strings."="; renames Strings."=";
procedure Free (X : in out String_Access) renames Strings.Free; procedure Free (X : in out String_Access) renames Strings.Free;
-- This procedure is provided for freeing returned values of type
-- String_Access
subtype String_List is Strings.String_List; subtype String_List is Strings.String_List;
function "=" (Left, Right : in String_List) return Boolean function "=" (Left, Right : in String_List) return Boolean
renames Strings."="; renames Strings."=";
@ -79,15 +82,12 @@ pragma Elaborate_Body (OS_Lib);
return String_List renames Strings."&"; return String_List renames Strings."&";
subtype String_List_Access is Strings.String_List_Access; subtype String_List_Access is Strings.String_List_Access;
-- General purpose array and pointer for list of string accesses
function "=" (Left, Right : in String_List_Access) return Boolean function "=" (Left, Right : in String_List_Access) return Boolean
renames Strings."="; renames Strings."=";
procedure Free (Arg : in out String_List_Access) procedure Free (Arg : in out String_List_Access)
renames Strings.Free; renames Strings.Free;
-- Frees the given array and all strings that its elements reference,
-- and then sets the argument to null. Provided for freeing returned
-- values of this type (including Argument_List_Access).
--------------------- ---------------------
-- Time/Date Stuff -- -- Time/Date Stuff --
@ -127,9 +127,9 @@ pragma Elaborate_Body (OS_Lib);
function ">" (X, Y : OS_Time) return Boolean; function ">" (X, Y : OS_Time) return Boolean;
function ">=" (X, Y : OS_Time) return Boolean; function ">=" (X, Y : OS_Time) return Boolean;
function "<=" (X, Y : OS_Time) return Boolean; function "<=" (X, Y : OS_Time) return Boolean;
-- Basic comparison operators on OS_Time with obvious meanings. Note -- Basic comparison operators on OS_Time with obvious meanings. Note that
-- that these have Intrinsic convention, so for example it is not -- these have Intrinsic convention, so for example it is not permissible
-- permissible to create accesses to any of these functions. -- to create accesses to any of these functions.
procedure GM_Split procedure GM_Split
(Date : OS_Time; (Date : OS_Time;
@ -146,15 +146,15 @@ pragma Elaborate_Body (OS_Lib);
-- File Stuff -- -- File Stuff --
---------------- ----------------
-- These routines give access to the open/creat/close/read/write level -- These routines give access to the open/creat/close/read/write level of
-- of I/O routines in the typical C library (these functions are not -- I/O routines in the typical C library (these functions are not part of
-- part of the ANSI C standard, but are typically available in all -- the ANSI C standard, but are typically available in all systems). See
-- systems). See also package Interfaces.C_Streams for access to the -- also package Interfaces.C_Streams for access to the stream level
-- stream level routines. -- routines.
-- Note on file names. If a file name is passed as type String in any -- Note on file names. If a file name is passed as type String in any of
-- of the following specifications, then the name is a normal Ada string -- the following specifications, then the name is a normal Ada string and
-- and need not be NUL-terminated. However, a trailing NUL character is -- need not be NUL-terminated. However, a trailing NUL character is
-- permitted, and will be ignored (more accurately, the NUL and any -- permitted, and will be ignored (more accurately, the NUL and any
-- characters that follow it will be ignored). -- characters that follow it will be ignored).
@ -189,9 +189,8 @@ pragma Elaborate_Body (OS_Lib);
function Open_Read_Write function Open_Read_Write
(Name : String; (Name : String;
Fmode : Mode) return File_Descriptor; Fmode : Mode) return File_Descriptor;
-- Open file Name for both reading and writing, returning file -- Open file Name for both reading and writing, returning file descriptor.
-- descriptor. File descriptor returned is Invalid_FD if file cannot be -- File descriptor returned is Invalid_FD if file cannot be opened.
-- opened.
function Create_File function Create_File
(Name : String; (Name : String;
@ -224,29 +223,30 @@ pragma Elaborate_Body (OS_Lib);
Name : out Temp_File_Name); Name : out Temp_File_Name);
-- Create and open for writing a temporary file in the current working -- Create and open for writing a temporary file in the current working
-- directory. The name of the file and the File Descriptor are returned. -- directory. The name of the file and the File Descriptor are returned.
-- The File Descriptor returned is Invalid_FD in the case of failure. -- The File Descriptor returned is Invalid_FD in the case of failure. No
-- No mode parameter is provided. Since this is a temporary file, -- mode parameter is provided. Since this is a temporary file, there is no
-- there is no point in doing text translation on it. -- point in doing text translation on it.
-- On some OSes, the maximum number of temp files that can be --
-- created with this procedure may be limited. When the maximum is -- On some OSes, the maximum number of temp files that can be created with
-- reached, this procedure returns Invalid_FD. On some OSes, there may be -- this procedure may be limited. When the maximum is reached, this
-- a race condition between processes trying to create temp files -- procedure returns Invalid_FD. On some OSes, there may be a race
-- at the same time in the same directory using this procedure. -- condition between processes trying to create temp files at the same
-- time in the same directory using this procedure.
procedure Create_Temp_File procedure Create_Temp_File
(FD : out File_Descriptor; (FD : out File_Descriptor;
Name : out String_Access); Name : out String_Access);
-- Create and open for writing a temporary file in the current working -- Create and open for writing a temporary file in the current working
-- directory. The name of the file and the File Descriptor are returned. -- directory. The name of the file and the File Descriptor are returned.
-- No mode parameter is provided. Since this is a temporary file, -- No mode parameter is provided. Since this is a temporary file, there is
-- there is no point in doing text translation on it. -- no point in doing text translation on it. It is the responsibility of
-- It is the responsibility of the caller to deallocate the access value -- the caller to deallocate the access value returned in Name.
-- returned in Name. --
-- This procedure will always succeed if the current working directory -- This procedure will always succeed if the current working directory is
-- is writable. If the current working directory is not writable, then -- writable. If the current working directory is not writable, then
-- Invalid_FD is returned for the file descriptor and null for the Name. -- Invalid_FD is returned for the file descriptor and null for the Name.
-- There is no race condition problem between processes trying to -- There is no race condition problem between processes trying to create
-- create temp files at the same time in the same directory. -- temp files at the same time in the same directory.
procedure Close (FD : File_Descriptor; Status : out Boolean); procedure Close (FD : File_Descriptor; Status : out Boolean);
-- Close file referenced by FD. Status is False if the underlying service -- Close file referenced by FD. Status is False if the underlying service
@ -254,8 +254,18 @@ pragma Elaborate_Body (OS_Lib);
-- and invalid file descriptor (the file may have been closed twice). -- and invalid file descriptor (the file may have been closed twice).
procedure Close (FD : File_Descriptor); procedure Close (FD : File_Descriptor);
-- Close file referenced by FD. This form is used when the caller -- Close file referenced by FD. This form is used when the caller wants to
-- wants to ignore any possible error (see above for error cases). -- ignore any possible error (see above for error cases).
procedure Set_Close_On_Exec
(FD : File_Descriptor;
Close_On_Exec : Boolean;
Status : out Boolean);
-- When Close_On_Exec is True, mark FD to be closed automatically when new
-- program is executed by the calling process (i.e. prevent FD from being
-- inherited by child processes). When Close_On_Exec is False, mark FD to
-- not be closed on exec (i.e. allow it to be inherited). Status is False
-- if the operation could not be performed.
procedure Delete_File (Name : String; Success : out Boolean); procedure Delete_File (Name : String; Success : out Boolean);
-- Deletes file. Success is set True or False indicating if the delete is -- Deletes file. Success is set True or False indicating if the delete is
@ -265,29 +275,29 @@ pragma Elaborate_Body (OS_Lib);
(Old_Name : String; (Old_Name : String;
New_Name : String; New_Name : String;
Success : out Boolean); Success : out Boolean);
-- Rename a file. Success is set True or False indicating if the -- Rename a file. Success is set True or False indicating if the rename is
-- rename is successful or not. -- successful or not.
-- The following defines the mode for the Copy_File procedure below. -- The following defines the mode for the Copy_File procedure below. Note
-- Note that "time stamps and other file attributes" in the descriptions -- that "time stamps and other file attributes" in the descriptions below
-- below refers to the creation and last modification times, and also -- refers to the creation and last modification times, and also the file
-- the file access (read/write/execute) status flags. -- access (read/write/execute) status flags.
type Copy_Mode is type Copy_Mode is
(Copy, (Copy,
-- Copy the file. It is an error if the target file already exists. -- Copy the file. It is an error if the target file already exists. The
-- The time stamps and other file attributes are preserved in the copy. -- time stamps and other file attributes are preserved in the copy.
Overwrite, Overwrite,
-- If the target file exists, the file is replaced otherwise -- If the target file exists, the file is replaced otherwise the file
-- the file is just copied. The time stamps and other file -- is just copied. The time stamps and other file attributes are
-- attributes are preserved in the copy. -- preserved in the copy.
Append); Append);
-- If the target file exists, the contents of the source file -- If the target file exists, the contents of the source file is
-- is appended at the end. Otherwise the source file is just -- appended at the end. Otherwise the source file is just copied. The
-- copied. The time stamps and other file attributes are -- time stamps and other file attributes are are preserved if the
-- are preserved if the destination file does not exist. -- destination file does not exist.
type Attribute is type Attribute is
(Time_Stamps, (Time_Stamps,
@ -295,8 +305,8 @@ pragma Elaborate_Body (OS_Lib);
-- attributes are set to normal default values for file creation. -- attributes are set to normal default values for file creation.
Full, Full,
-- All attributes are copied from the source file to the target -- All attributes are copied from the source file to the target file.
-- file. This includes the timestamps, and for example also includes -- This includes the timestamps, and for example also includes
-- read/write/execute attributes in Unix systems. -- read/write/execute attributes in Unix systems.
None); None);
@ -305,8 +315,8 @@ pragma Elaborate_Body (OS_Lib);
-- Note: The default is Time_Stamps, which corresponds to the normal -- Note: The default is Time_Stamps, which corresponds to the normal
-- default on Windows style systems. Full corresponds to the typical -- default on Windows style systems. Full corresponds to the typical
-- effect of "cp -p" on Unix systems, and None corresponds to the -- effect of "cp -p" on Unix systems, and None corresponds to the typical
-- typical effect of "cp" on Unix systems. -- effect of "cp" on Unix systems.
-- Note: Time_Stamps and Full are not supported on VMS and VxWorks -- Note: Time_Stamps and Full are not supported on VMS and VxWorks
@ -320,15 +330,15 @@ pragma Elaborate_Body (OS_Lib);
-- Pathname can be a filename or directory name. In the latter case Name -- Pathname can be a filename or directory name. In the latter case Name
-- is copied into the directory preserving the same file name. Mode -- is copied into the directory preserving the same file name. Mode
-- defines the kind of copy, see above with the default being a normal -- defines the kind of copy, see above with the default being a normal
-- copy in which the target file must not already exist. Success is set -- copy in which the target file must not already exist. Success is set to
-- to True or False indicating if the copy is successful (depending on -- True or False indicating if the copy is successful (depending on the
-- the specified Mode). -- specified Mode).
-- --
-- Note: this procedure is only supported to a very limited extent on -- Note: this procedure is only supported to a very limited extent on VMS.
-- VMS. The only supported mode is Overwrite, and the only supported -- The only supported mode is Overwrite, and the only supported value for
-- value for Preserve is None, resulting in the default action which -- Preserve is None, resulting in the default action which for Overwrite
-- for Overwrite is to leave attributes unchanged. Furthermore, the -- is to leave attributes unchanged. Furthermore, the copy only works for
-- copy only works for simple text files. -- simple text files.
procedure Copy_Time_Stamps (Source, Dest : String; Success : out Boolean); procedure Copy_Time_Stamps (Source, Dest : String; Success : out Boolean);
-- Copy Source file time stamps (last modification and last access time -- Copy Source file time stamps (last modification and last access time
@ -343,16 +353,16 @@ pragma Elaborate_Body (OS_Lib);
(FD : File_Descriptor; (FD : File_Descriptor;
A : System.Address; A : System.Address;
N : Integer) return Integer; N : Integer) return Integer;
-- Read N bytes to address A from file referenced by FD. Returned value -- Read N bytes to address A from file referenced by FD. Returned value is
-- is count of bytes actually read, which can be less than N at EOF. -- count of bytes actually read, which can be less than N at EOF.
function Write function Write
(FD : File_Descriptor; (FD : File_Descriptor;
A : System.Address; A : System.Address;
N : Integer) return Integer; N : Integer) return Integer;
-- Write N bytes from address A to file referenced by FD. The returned -- Write N bytes from address A to file referenced by FD. The returned
-- value is the number of bytes written, which can be less than N if -- value is the number of bytes written, which can be less than N if a
-- a disk full condition was detected. -- disk full condition was detected.
Seek_Cur : constant := 1; Seek_Cur : constant := 1;
Seek_End : constant := 2; Seek_End : constant := 2;
@ -364,9 +374,9 @@ pragma Elaborate_Body (OS_Lib);
offset : Long_Integer; offset : Long_Integer;
origin : Integer); origin : Integer);
pragma Import (C, Lseek, "__gnat_lseek"); pragma Import (C, Lseek, "__gnat_lseek");
-- Sets the current file pointer to the indicated offset value, -- Sets the current file pointer to the indicated offset value, relative
-- relative to the current position (origin = SEEK_CUR), end of -- to the current position (origin = SEEK_CUR), end of file (origin =
-- file (origin = SEEK_END), or start of file (origin = SEEK_SET). -- SEEK_END), or start of file (origin = SEEK_SET).
function File_Length (FD : File_Descriptor) return Long_Integer; function File_Length (FD : File_Descriptor) return Long_Integer;
pragma Import (C, File_Length, "__gnat_file_length"); pragma Import (C, File_Length, "__gnat_file_length");
@ -374,12 +384,12 @@ pragma Elaborate_Body (OS_Lib);
function File_Time_Stamp (Name : String) return OS_Time; function File_Time_Stamp (Name : String) return OS_Time;
-- Given the name of a file or directory, Name, obtains and returns the -- Given the name of a file or directory, Name, obtains and returns the
-- time stamp. This function can be used for an unopened file. -- time stamp. This function can be used for an unopened file. Returns
-- Returns Invalid_Time is Name doesn't correspond to an existing file. -- Invalid_Time is Name doesn't correspond to an existing file.
function File_Time_Stamp (FD : File_Descriptor) return OS_Time; function File_Time_Stamp (FD : File_Descriptor) return OS_Time;
-- Get time stamp of file from file descriptor FD -- Get time stamp of file from file descriptor FD Returns Invalid_Time is
-- Returns Invalid_Time is FD doesn't correspond to an existing file. -- FD doesn't correspond to an existing file.
function Normalize_Pathname function Normalize_Pathname
(Name : String; (Name : String;
@ -394,26 +404,25 @@ pragma Elaborate_Body (OS_Lib);
-- directory if Directory is null. The result returned is the normalized -- directory if Directory is null. The result returned is the normalized
-- name of the file. For most cases, if two file names designate the same -- name of the file. For most cases, if two file names designate the same
-- file through different paths, Normalize_Pathname will return the same -- file through different paths, Normalize_Pathname will return the same
-- canonical name in both cases. However, there are cases when this is -- canonical name in both cases. However, there are cases when this is not
-- not true; for example, this is not true in Unix for two hard links -- true; for example, this is not true in Unix for two hard links
-- designating the same file. -- designating the same file.
-- --
-- On Windows, the returned path will start with a drive letter except -- On Windows, the returned path will start with a drive letter except
-- when Directory is not empty and does not include a drive letter. -- when Directory is not empty and does not include a drive letter. If
-- If Directory is empty (the default) and Name is a relative path -- Directory is empty (the default) and Name is a relative path or an
-- or an absolute path without drive letter, the letter of the current -- absolute path without drive letter, the letter of the current drive
-- drive will start the returned path. If Case_Sensitive is True -- will start the returned path. If Case_Sensitive is True (the default),
-- (the default), then this drive letter will be forced to upper case -- then this drive letter will be forced to upper case ("C:\...").
-- ("C:\...").
-- --
-- If Resolve_Links is set to True, then the symbolic links, on systems -- If Resolve_Links is set to True, then the symbolic links, on systems
-- that support them, will be fully converted to the name of the file -- that support them, will be fully converted to the name of the file or
-- or directory pointed to. This is slightly less efficient, since it -- directory pointed to. This is slightly less efficient, since it
-- requires system calls. -- requires system calls.
-- --
-- If Name cannot be resolved or is null on entry (for example if there is -- If Name cannot be resolved or is null on entry (for example if there is
-- a circularity in symbolic links: A is a symbolic link for B, while B is -- symbolic link circularity, e.g. A is a symbolic link for B, and B is a
-- a symbolic link for A), then Normalize_Pathname returns an empty string. -- symbolic link for A), then Normalize_Pathname returns an empty string.
-- --
-- In VMS, if Name follows the VMS syntax file specification, it is first -- In VMS, if Name follows the VMS syntax file specification, it is first
-- converted into Unix syntax. If the conversion fails, Normalize_Pathname -- converted into Unix syntax. If the conversion fails, Normalize_Pathname
@ -428,9 +437,8 @@ pragma Elaborate_Body (OS_Lib);
-- function does not change the casing of file and directory names. -- function does not change the casing of file and directory names.
function Is_Absolute_Path (Name : String) return Boolean; function Is_Absolute_Path (Name : String) return Boolean;
-- Returns True if Name is an absolute path name, i.e. it designates -- Returns True if Name is an absolute path name, i.e. it designates a
-- a file or a directory absolutely, rather than relative to another -- file or directory absolutely rather than relative to another directory.
-- directory.
function Is_Regular_File (Name : String) return Boolean; function Is_Regular_File (Name : String) return Boolean;
-- Determines if the given string, Name, is the name of an existing -- Determines if the given string, Name, is the name of an existing
@ -446,25 +454,25 @@ pragma Elaborate_Body (OS_Lib);
-- a relative path name, it is relative to the current working directory. -- a relative path name, it is relative to the current working directory.
function Is_Readable_File (Name : String) return Boolean; function Is_Readable_File (Name : String) return Boolean;
-- Determines if the given string, Name, is the name of an existing -- Determines if the given string, Name, is the name of an existing file
-- file that is readable. Returns True if so, False otherwise. Note -- that is readable. Returns True if so, False otherwise. Note that this
-- that this function simply interrogates the file attributes (e.g. -- function simply interrogates the file attributes (e.g. using the C
-- using the C function stat), so it does not indicate a situation -- function stat), so it does not indicate a situation in which a file may
-- in which a file may not actually be readable due to some other -- not actually be readable due to some other process having exclusive
-- process having exclusive access. -- access.
function Is_Writable_File (Name : String) return Boolean; function Is_Writable_File (Name : String) return Boolean;
-- Determines if the given string, Name, is the name of an existing -- Determines if the given string, Name, is the name of an existing file
-- file that is writable. Returns True if so, False otherwise. Note -- that is writable. Returns True if so, False otherwise. Note that this
-- that this function simply interrogates the file attributes (e.g. -- function simply interrogates the file attributes (e.g. using the C
-- using the C function stat), so it does not indicate a situation -- function stat), so it does not indicate a situation in which a file may
-- in which a file may not actually be writeable due to some other -- not actually be writeable due to some other process having exclusive
-- process having exclusive access. -- access.
function Is_Symbolic_Link (Name : String) return Boolean; function Is_Symbolic_Link (Name : String) return Boolean;
-- Determines if the given string, Name, is the path of a symbolic link -- Determines if the given string, Name, is the path of a symbolic link on
-- on systems that support it. Returns True if so, False if the path -- systems that support it. Returns True if so, False if the path is not a
-- is not a symbolic link or if the system does not support symbolic links. -- symbolic link or if the system does not support symbolic links.
-- --
-- A symbolic link is an indirect pointer to a file; its directory entry -- A symbolic link is an indirect pointer to a file; its directory entry
-- contains the name of the file to which it is linked. Symbolic links may -- contains the name of the file to which it is linked. Symbolic links may
@ -500,12 +508,12 @@ pragma Elaborate_Body (OS_Lib);
-- returned; otherwise, a null pointer is returned. If the File_Name given -- returned; otherwise, a null pointer is returned. If the File_Name given
-- is an absolute pathname, then Locate_Regular_File just checks that the -- is an absolute pathname, then Locate_Regular_File just checks that the
-- file exists and is a regular file. Otherwise, if the File_Name given -- file exists and is a regular file. Otherwise, if the File_Name given
-- includes directory information, Locate_Regular_File first checks if -- includes directory information, Locate_Regular_File first checks if the
-- the file exists relative to the current directory. If it does not, -- file exists relative to the current directory. If it does not, or if
-- or if the File_Name given is a simple file name, the Path argument is -- the File_Name given is a simple file name, the Path argument is parsed
-- parsed according to OS conventions, and for each directory in the Path -- according to OS conventions, and for each directory in the Path a check
-- a check is made if File_Name is a relative pathname of a regular file -- is made if File_Name is a relative pathname of a regular file from that
-- from that directory. -- directory.
-- --
-- Note that this function allocates some memory for the returned value. -- Note that this function allocates some memory for the returned value.
-- This memory needs to be deallocated after use. -- This memory needs to be deallocated after use.
@ -531,8 +539,8 @@ pragma Elaborate_Body (OS_Lib);
-- routine (using String in place of C_File_Name) defined above. -- routine (using String in place of C_File_Name) defined above.
subtype C_File_Name is System.Address; subtype C_File_Name is System.Address;
-- This subtype is used to document that a parameter is the address -- This subtype is used to document that a parameter is the address of a
-- of a null-terminated string containing the name of a file. -- null-terminated string containing the name of a file.
-- All the following functions need comments ??? -- All the following functions need comments ???
@ -571,7 +579,7 @@ pragma Elaborate_Body (OS_Lib);
Success : out Boolean); Success : out Boolean);
function File_Time_Stamp (Name : C_File_Name) return OS_Time; function File_Time_Stamp (Name : C_File_Name) return OS_Time;
-- Returns Invalid_Time is Name doesn't correspond to an existing file. -- Returns Invalid_Time is Name doesn't correspond to an existing file
function Is_Regular_File (Name : C_File_Name) return Boolean; function Is_Regular_File (Name : C_File_Name) return Boolean;
function Is_Directory (Name : C_File_Name) return Boolean; function Is_Directory (Name : C_File_Name) return Boolean;
@ -589,9 +597,9 @@ pragma Elaborate_Body (OS_Lib);
------------------ ------------------
subtype Argument_List is String_List; subtype Argument_List is String_List;
-- Type used for argument list in call to Spawn. The lower bound -- Type used for argument list in call to Spawn. The lower bound of the
-- of the array should be 1, and the length of the array indicates -- array should be 1, and the length of the array indicates the number of
-- the number of arguments. -- arguments.
subtype Argument_List_Access is String_List_Access; subtype Argument_List_Access is String_List_Access;
-- Type used to return Argument_List without dragging in secondary stack. -- Type used to return Argument_List without dragging in secondary stack.
@ -606,42 +614,45 @@ pragma Elaborate_Body (OS_Lib);
-- and Non_Blocking_Spawn call Normalize_Arguments automatically, but -- and Non_Blocking_Spawn call Normalize_Arguments automatically, but
-- since there is a guarantee that a second call does nothing, this -- since there is a guarantee that a second call does nothing, this
-- internal call will have no effect if Normalize_Arguments is called -- internal call will have no effect if Normalize_Arguments is called
-- before calling Spawn. The call to Normalize_Arguments assumes that -- before calling Spawn. The call to Normalize_Arguments assumes that the
-- the individual referenced arguments in Argument_List are on the heap, -- individual referenced arguments in Argument_List are on the heap, and
-- and may free them and reallocate if they are modified. -- may free them and reallocate if they are modified.
procedure Spawn procedure Spawn
(Program_Name : String; (Program_Name : String;
Args : Argument_List; Args : Argument_List;
Success : out Boolean); Success : out Boolean);
-- The first parameter of function Spawn is the name of the executable. -- This procedure spawns a program with a given list of arguments. The
-- The second parameter contains the arguments to be passed to the -- first parameter of is the name of the executable. The second parameter
-- program. Success is False if the named program could not be spawned -- contains the arguments to be passed to this program. Success is False
-- or its execution completed unsuccessfully. Note that the caller will -- if the named program could not be spawned or its execution completed
-- be blocked until the execution of the spawned program is complete. -- unsuccessfully. Note that the caller will be blocked until the
-- For maximum portability, use a full path name for the Program_Name -- execution of the spawned program is complete. For maximum portability,
-- argument. On some systems (notably Unix systems) a simple file -- use a full path name for the Program_Name argument. On some systems
-- name may also work (if the executable can be located in the path). -- (notably Unix systems) a simple file name may also work (if the
-- executable can be located in the path).
-- --
-- "Spawn" should not be used in tasking applications. -- "Spawn" should not be used in tasking applications. Why not??? More
-- documentation would be helpful here ??? Is it really tasking programs,
-- or tasking activity that cause trouble ???
-- --
-- Note: Arguments in Args that contain spaces and/or quotes such as -- Note: Arguments in Args that contain spaces and/or quotes such as
-- "--GCC=gcc -v" or "--GCC=""gcc -v""" are not portable across all -- "--GCC=gcc -v" or "--GCC=""gcc -v""" are not portable across all
-- operating systems, and would not have the desired effect if they -- operating systems, and would not have the desired effect if they were
-- were passed directly to the operating system. To avoid this problem, -- passed directly to the operating system. To avoid this problem, Spawn
-- Spawn makes an internal call to Normalize_Arguments, which ensures -- makes an internal call to Normalize_Arguments, which ensures that such
-- that such arguments are modified in a manner that ensures that the -- arguments are modified in a manner that ensures that the desired effect
-- desired effect is obtained on all operating systems. The caller may -- is obtained on all operating systems. The caller may call
-- call Normalize_Arguments explicitly before the call (e.g. to print -- Normalize_Arguments explicitly before the call (e.g. to print out the
-- out the exact form of arguments passed to the operating system). In -- exact form of arguments passed to the operating system). In this case
-- this case the guarantee a second call to Normalize_Arguments has no -- the guarantee a second call to Normalize_Arguments has no effect
-- effect ensures that the internal call will not affect the result. -- ensures that the internal call will not affect the result. Note that
-- Note that the implicit call to Normalize_Arguments may free and -- the implicit call to Normalize_Arguments may free and reallocate some
-- reallocate some of the individual arguments. -- of the individual arguments.
-- --
-- This function will always set Success to False under VxWorks and -- This function will always set Success to False under VxWorks and other
-- other similar operating systems which have no notion of the concept -- similar operating systems which have no notion of the concept of
-- of a dynamically executable file. -- dynamically executable file.
function Spawn function Spawn
(Program_Name : String; (Program_Name : String;
@ -659,12 +670,10 @@ pragma Elaborate_Body (OS_Lib);
Output_File_Descriptor : File_Descriptor; Output_File_Descriptor : File_Descriptor;
Return_Code : out Integer; Return_Code : out Integer;
Err_To_Out : Boolean := True); Err_To_Out : Boolean := True);
-- Similar to the procedure above, but redirects the output to -- Similar to the procedure above, but redirects the output to the file
-- the file designated by Output_File_Descriptor. If Err_To_Out -- designated by Output_File_Descriptor. If Err_To_Out is True, then the
-- is True, then the Standard Error output is also redirected. -- Standard Error output is also redirected.
-- -- Return_Code is set to the status code returned by the operating system
-- Return_Code is set to the status code returned by the operating
-- system as described above.
-- --
-- "Spawn" should not be used in tasking applications. -- "Spawn" should not be used in tasking applications.
@ -675,13 +684,13 @@ pragma Elaborate_Body (OS_Lib);
Success : out Boolean; Success : out Boolean;
Return_Code : out Integer; Return_Code : out Integer;
Err_To_Out : Boolean := True); Err_To_Out : Boolean := True);
-- Similar to the procedure above, but saves the output of the command -- Similar to the procedure above, but saves the output of the command to
-- to a file with the name Output_File. -- a file with the name Output_File.
-- --
-- Success is set to True if the command is executed and its output -- Success is set to True if the command is executed and its output
-- successfully written to the file. If Success is True, then -- successfully written to the file. If Success is True, then Return_Code
-- Return_Code will be set to the status code returned by the -- will be set to the status code returned by the operating system.
-- operating system. Otherwise, Return_Code is undefined. -- Otherwise, Return_Code is undefined.
-- --
-- "Spawn" should not be used in tasking applications. -- "Spawn" should not be used in tasking applications.
@ -691,31 +700,31 @@ pragma Elaborate_Body (OS_Lib);
-- comparison for equality. -- comparison for equality.
Invalid_Pid : constant Process_Id; Invalid_Pid : constant Process_Id;
-- A special value used to indicate errors, as described below. -- A special value used to indicate errors, as described below
function Non_Blocking_Spawn function Non_Blocking_Spawn
(Program_Name : String; (Program_Name : String;
Args : Argument_List) Args : Argument_List)
return Process_Id; return Process_Id;
-- This is a non blocking call. The Process_Id of the spawned process -- This is a non blocking call. The Process_Id of the spawned process is
-- is returned. Parameters are to be used as in Spawn. If Invalid_Id -- returned. Parameters are to be used as in Spawn. If Invalid_Id is
-- is returned the program could not be spawned. -- returned the program could not be spawned.
-- --
-- "Non_Blocking_Spawn" should not be used in tasking applications. -- "Non_Blocking_Spawn" should not be used in tasking applications.
-- --
-- This function will always return Invalid_Id under VxWorks, since -- This function will always return Invalid_Id under VxWorks, since there
-- there is no notion of executables under this OS. -- is no notion of executables under this OS.
procedure Wait_Process (Pid : out Process_Id; Success : out Boolean); procedure Wait_Process (Pid : out Process_Id; Success : out Boolean);
-- Wait for the completion of any of the processes created by previous -- Wait for the completion of any of the processes created by previous
-- calls to Non_Blocking_Spawn. The caller will be suspended until one -- calls to Non_Blocking_Spawn. The caller will be suspended until one of
-- of these processes terminates (normally or abnormally). If any of -- these processes terminates (normally or abnormally). If any of these
-- these subprocesses terminates prior to the call to Wait_Process (and -- subprocesses terminates prior to the call to Wait_Process (and has not
-- has not been returned by a previous call to Wait_Process), then the -- been returned by a previous call to Wait_Process), then the call to
-- call to Wait_Process is immediate. Pid identifies the process that -- Wait_Process is immediate. Pid identifies the process that has
-- has terminated (matching the value returned from Non_Blocking_Spawn). -- terminated (matching the value returned from Non_Blocking_Spawn).
-- Success is set to True if this sub-process terminated successfully. -- Success is set to True if this sub-process terminated successfully. If
-- If Pid = Invalid_Id, there were no subprocesses left to wait on. -- Pid = Invalid_Id, there were no subprocesses left to wait on.
-- --
-- This function will always set success to False under VxWorks, since -- This function will always set success to False under VxWorks, since
-- there is no notion of executables under this OS. -- there is no notion of executables under this OS.
@ -723,9 +732,9 @@ pragma Elaborate_Body (OS_Lib);
function Argument_String_To_List function Argument_String_To_List
(Arg_String : String) (Arg_String : String)
return Argument_List_Access; return Argument_List_Access;
-- Take a string that is a program and its arguments and parse it into -- Take a string that is a program and its arguments and parse it into an
-- an Argument_List. Note that the result is allocated on the heap, and -- Argument_List. Note that the result is allocated on the heap, and must
-- must be freed by the programmer (when it is no longer needed) to avoid -- be freed by the programmer (when it is no longer needed) to avoid
-- memory leaks. -- memory leaks.
------------------- -------------------
@ -733,25 +742,24 @@ pragma Elaborate_Body (OS_Lib);
------------------- -------------------
function Getenv (Name : String) return String_Access; function Getenv (Name : String) return String_Access;
-- Get the value of the environment variable. Returns an access -- Get the value of the environment variable. Returns an access to the
-- to the empty string if the environment variable does not exist -- empty string if the environment variable does not exist or has an
-- or has an explicit null value (in some operating systems these -- explicit null value (in some operating systems these are distinct
-- are distinct cases, in others they are not; this interface -- cases, in others they are not; this interface abstracts away that
-- abstracts away that difference. The argument is allocated on -- difference. The argument is allocated on the heap (even in the null
-- the heap (even in the null case), and needs to be freed explicitly -- case), and needs to be freed explicitly when no longer needed to avoid
-- when no longer needed to avoid memory leaks. -- memory leaks.
procedure Setenv (Name : String; Value : String); procedure Setenv (Name : String; Value : String);
-- Set the value of the environment variable Name to Value. This call -- Set the value of the environment variable Name to Value. This call
-- modifies the current environment, but does not modify the parent -- modifies the current environment, but does not modify the parent
-- process environment. After a call to Setenv, Getenv (Name) will -- process environment. After a call to Setenv, Getenv (Name) will always
-- always return a String_Access referencing the same String as Value. -- return a String_Access referencing the same String as Value. This is
-- This is true also for the null string case (the actual effect may -- true also for the null string case (the actual effect may be to either
-- be to either set an explicit null as the value, or to remove the -- set an explicit null as the value, or to remove the entry, this is
-- entry, this is operating system dependent). Note that any following -- operating system dependent). Note that any following calls to Spawn
-- calls to Spawn will pass an environment to the spawned process that -- will pass an environment to the spawned process that includes the
-- includes the changes made by Setenv calls. This procedure is not -- changes made by Setenv calls. This procedure is not available on VMS.
-- available under VMS.
procedure OS_Exit (Status : Integer); procedure OS_Exit (Status : Integer);
pragma Import (C, OS_Exit, "__gnat_os_exit"); pragma Import (C, OS_Exit, "__gnat_os_exit");
@ -762,37 +770,36 @@ pragma Elaborate_Body (OS_Lib);
pragma Import (C, OS_Abort, "abort"); pragma Import (C, OS_Abort, "abort");
pragma No_Return (OS_Abort); pragma No_Return (OS_Abort);
-- Exit to OS signalling an abort (traceback or other appropriate -- Exit to OS signalling an abort (traceback or other appropriate
-- diagnostic information should be given if possible, or entry made -- diagnostic information should be given if possible, or entry made to
-- to the debugger if that is possible). -- the debugger if that is possible).
function Errno return Integer; function Errno return Integer;
pragma Import (C, Errno, "__get_errno"); pragma Import (C, Errno, "__get_errno");
-- Return the task-safe last error number. -- Return the task-safe last error number
procedure Set_Errno (Errno : Integer); procedure Set_Errno (Errno : Integer);
pragma Import (C, Set_Errno, "__set_errno"); pragma Import (C, Set_Errno, "__set_errno");
-- Set the task-safe error number. -- Set the task-safe error number
Directory_Separator : constant Character; Directory_Separator : constant Character;
-- The character that is used to separate parts of a pathname. -- The character that is used to separate parts of a pathname
Path_Separator : constant Character; Path_Separator : constant Character;
-- The character to separate paths in an environment variable value. -- The character to separate paths in an environment variable value
private private
pragma Import (C, Path_Separator, "__gnat_path_separator"); pragma Import (C, Path_Separator, "__gnat_path_separator");
pragma Import (C, Directory_Separator, "__gnat_dir_separator"); pragma Import (C, Directory_Separator, "__gnat_dir_separator");
type OS_Time is new Long_Integer; type OS_Time is new Long_Integer;
-- Type used for timestamps in the compiler. This type is used to -- Type used for timestamps in the compiler. This type is used to hold
-- hold time stamps, but may have a different representation than -- time stamps, but may have a different representation than C's time_t.
-- C's time_t. This type needs to match the declaration of OS_Time -- This type needs to match the declaration of OS_Time in adaint.h.
-- in adaint.h.
-- Add pragma Inline statements for comparison operations on OS_Time. -- Add pragma Inline statements for comparison operations on OS_Time. It
-- It would actually be nice to use pragma Import (Intrinsic) here, -- would actually be nice to use pragma Import (Intrinsic) here, but this
-- but this was not properly supported till GNAT 3.15a, so that would -- was not properly supported till GNAT 3.15a, so that would cause
-- cause bootstrap path problems. To be changed later ??? -- bootstrap path problems. To be changed later ???
Invalid_Time : constant OS_Time := -1; Invalid_Time : constant OS_Time := -1;
-- This value should match the return valud by __gnat_file_time_* -- This value should match the return valud by __gnat_file_time_*