Commit 2f97d24c by Arnaud Charlet

[multiple changes]

2015-10-27  Tristan Gingold  <gingold@adacore.com>

	* bindgen.adb (System_BB_CPU_Primitives_Multiprocessors_Used):
	New variable.
	(Gen_Adainit): Call Start_All_CPUs if the above
	variable is set to true.

2015-10-27  Emmanuel Briot  <briot@adacore.com>

	* adaint.c, s-os_lib.adb, s-os_lib.ads (Copy_File_Attributes): New
	subprogram.

From-SVN: r229429
parent 4e48e02b
2015-10-27 Tristan Gingold <gingold@adacore.com>
* bindgen.adb (System_BB_CPU_Primitives_Multiprocessors_Used):
New variable.
(Gen_Adainit): Call Start_All_CPUs if the above
variable is set to true.
2015-10-27 Emmanuel Briot <briot@adacore.com>
* adaint.c, s-os_lib.adb, s-os_lib.ads (Copy_File_Attributes): New
subprogram.
2015-10-27 Hristian Kirtchev <kirtchev@adacore.com>
* namet.adb, namet.ads: Minor reformatting.
......
......@@ -2902,6 +2902,8 @@ char __gnat_environment_char = '$';
mode = 1 : In this mode, time stamps and read/write/execute attributes are
copied.
mode = 2 : In this mode, only read/write/execute attributes are copied
Returns 0 if operation was successful and -1 in case of error. */
int
......@@ -2921,10 +2923,14 @@ __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED, char *to ATTRIBUTE_UNUSED,
S2WSC (wfrom, from, GNAT_MAX_PATH_LEN + 2);
S2WSC (wto, to, GNAT_MAX_PATH_LEN + 2);
/* Do we need to copy the timestamp ? */
if (mode != 2) {
/* retrieve from times */
hfrom = CreateFile
(wfrom, GENERIC_READ, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
(wfrom, GENERIC_READ, 0, NULL, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, NULL);
if (hfrom == INVALID_HANDLE_VALUE)
return -1;
......@@ -2939,7 +2945,8 @@ __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED, char *to ATTRIBUTE_UNUSED,
/* retrieve from times */
hto = CreateFile
(wto, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
(wto, GENERIC_WRITE, 0, NULL, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, NULL);
if (hto == INVALID_HANDLE_VALUE)
return -1;
......@@ -2950,10 +2957,12 @@ __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED, char *to ATTRIBUTE_UNUSED,
if (res == 0)
return -1;
}
/* Do we need to copy the permissions ? */
/* Set file attributes in full mode. */
if (mode == 1)
if (mode != 0)
{
DWORD attribs = GetFileAttributes (wfrom);
......@@ -2971,26 +2980,24 @@ __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED, char *to ATTRIBUTE_UNUSED,
GNAT_STRUCT_STAT fbuf;
struct utimbuf tbuf;
if (GNAT_STAT (from, &fbuf) == -1)
{
if (GNAT_STAT (from, &fbuf) == -1) {
return -1;
}
/* Do we need to copy timestamp ? */
if (mode != 2) {
tbuf.actime = fbuf.st_atime;
tbuf.modtime = fbuf.st_mtime;
if (utime (to, &tbuf) == -1)
{
if (utime (to, &tbuf) == -1) {
return -1;
}
}
if (mode == 1)
{
if (chmod (to, fbuf.st_mode) == -1)
{
/* Do we need to copy file permissions ? */
if (mode != 0 && (chmod (to, fbuf.st_mode) == -1)) {
return -1;
}
}
return 0;
#endif
......
......@@ -88,6 +88,12 @@ package body Bindgen is
-- attach interrupt handlers at the end of the elaboration when partition
-- elaboration policy is sequential.
System_BB_CPU_Primitives_Multiprocessors_Used : Boolean := False;
-- Flag indicating wether the unit System.BB.CPU_Primitives.Multiprocessors
-- is in the closure of the partiation. This is set by procedure
-- Resolve_Binder_Options, and it is used to call a procedure that starts
-- slave processors.
Lib_Final_Built : Boolean := False;
-- Flag indicating whether the finalize_library rountine has been built
......@@ -536,6 +542,13 @@ package body Bindgen is
WBI (" procedure Activate_All_Tasks_Sequential;");
WBI (" pragma Import (C, Activate_All_Tasks_Sequential," &
" ""__gnat_activate_all_tasks"");");
WBI ("");
end if;
if System_BB_CPU_Primitives_Multiprocessors_Used then
WBI (" procedure Start_Slave_CPUs;");
WBI (" pragma Import (C, Start_Slave_CPUs," &
" ""__gnat_start_slave_cpus"");");
end if;
WBI (" begin");
......@@ -944,6 +957,10 @@ package body Bindgen is
end if;
end if;
if System_BB_CPU_Primitives_Multiprocessors_Used then
WBI (" Start_Slave_CPUs;");
end if;
WBI (" end " & Ada_Init_Name.all & ";");
WBI ("");
end Gen_Adainit;
......@@ -2872,6 +2889,12 @@ package body Bindgen is
-- Ditto for the use of restrictions
Check_Package (System_Restrictions_Used, "system.restrictions%s");
-- Ditto for use of an SMP bareboard runtime
Check_Package (System_BB_CPU_Primitives_Multiprocessors_Used,
"system.bb.cpu_primitives.multiprocessors%s");
end loop;
end Resolve_Binder_Options;
......
......@@ -55,11 +55,13 @@ package body System.OS_Lib is
pragma Import (C, Dup2, "__gnat_dup2");
function Copy_Attributes
(From, To : System.Address;
(From : System.Address;
To : System.Address;
Mode : Integer) return Integer;
pragma Import (C, Copy_Attributes, "__gnat_copy_attribs");
-- Mode = 0 - copy only time stamps.
-- Mode = 1 - copy time stamps and read/write/execute attributes
-- Mode = 2 - copy read/write/execute attributes
On_Windows : constant Boolean := Directory_Separator = '\';
-- An indication that we are on Windows. Used in Normalize_Pathname, to
......@@ -324,7 +326,7 @@ package body System.OS_Lib is
-- Returns pathname Dir concatenated with File adding the directory
-- separator only if needed.
procedure Copy (From, To : File_Descriptor);
procedure Copy (From : File_Descriptor; To : File_Descriptor);
-- Read data from From and place them into To. In both cases the
-- operations uses the current file position. Raises Constraint_Error
-- if a problem occurs during the copy.
......@@ -337,11 +339,6 @@ package body System.OS_Lib is
----------------
function Build_Path (Dir : String; File : String) return String is
Res : String (1 .. Dir'Length + File'Length + 1);
Base_File_Ptr : Integer;
-- The base file name is File (Base_File_Ptr + 1 .. File'Last)
function Is_Dirsep (C : Character) return Boolean;
pragma Inline (Is_Dirsep);
-- Returns True if C is a directory separator. On Windows we
......@@ -356,6 +353,13 @@ package body System.OS_Lib is
return C = Directory_Separator or else C = '/';
end Is_Dirsep;
-- Local variables
Base_File_Ptr : Integer;
-- The base file name is File (Base_File_Ptr + 1 .. File'Last)
Res : String (1 .. Dir'Length + File'Length + 1);
-- Start of processing for Build_Path
begin
......@@ -392,7 +396,7 @@ package body System.OS_Lib is
-- Copy --
----------
procedure Copy (From, To : File_Descriptor) is
procedure Copy (From : File_Descriptor; To : File_Descriptor) is
Buf_Size : constant := 200_000;
type Buf is array (1 .. Buf_Size) of Character;
type Buf_Ptr is access Buf;
......@@ -490,7 +494,6 @@ package body System.OS_Lib is
C_To (C_To'Last) := ASCII.NUL;
case Preserve is
when Time_Stamps =>
if Copy_Attributes (C_From'Address, C_To'Address, 0) = -1 then
raise Copy_Error;
......@@ -621,11 +624,55 @@ package body System.OS_Lib is
Free (Ada_Pathname);
end Copy_File;
--------------------------
-- Copy_File_Attributes --
--------------------------
procedure Copy_File_Attributes
(From : String;
To : String;
Success : out Boolean;
Copy_Timestamp : Boolean := True;
Copy_Permissions : Boolean := True)
is
F : aliased String (1 .. From'Length + 1);
Mode : Integer;
T : aliased String (1 .. To'Length + 1);
begin
if Copy_Timestamp then
if Copy_Permissions then
Mode := 1;
else
Mode := 0;
end if;
else
if Copy_Permissions then
Mode := 2;
else
Success := True;
return; -- nothing to do
end if;
end if;
F (1 .. From'Length) := From;
F (F'Last) := ASCII.NUL;
T (1 .. To'Length) := To;
T (T'Last) := ASCII.NUL;
Success := Copy_Attributes (F'Address, T'Address, Mode) /= -1;
end Copy_File_Attributes;
----------------------
-- Copy_Time_Stamps --
----------------------
procedure Copy_Time_Stamps (Source, Dest : String; Success : out Boolean) is
procedure Copy_Time_Stamps
(Source : String;
Dest : String;
Success : out Boolean)
is
begin
if Is_Regular_File (Source) and then Is_Writable_File (Dest) then
declare
......@@ -652,7 +699,8 @@ package body System.OS_Lib is
end Copy_Time_Stamps;
procedure Copy_Time_Stamps
(Source, Dest : C_File_Name;
(Source : C_File_Name;
Dest : C_File_Name;
Success : out Boolean)
is
Ada_Source : String_Access :=
......@@ -726,10 +774,11 @@ package body System.OS_Lib is
-----------------------------
function Create_Output_Text_File (Name : String) return File_Descriptor is
function C_Create_File
(Name : C_File_Name) return File_Descriptor;
function C_Create_File (Name : C_File_Name) return File_Descriptor;
pragma Import (C, C_Create_File, "__gnat_create_output_file");
C_Name : String (1 .. Name'Length + 1);
begin
C_Name (1 .. Name'Length) := Name;
C_Name (C_Name'Last) := ASCII.NUL;
......@@ -801,10 +850,11 @@ package body System.OS_Lib is
function Create_New_Output_Text_File
(Name : String) return File_Descriptor
is
function C_Create_File
(Name : C_File_Name) return File_Descriptor;
function C_Create_File (Name : C_File_Name) return File_Descriptor;
pragma Import (C, C_Create_File, "__gnat_create_output_file_new");
C_Name : String (1 .. Name'Length + 1);
begin
C_Name (1 .. Name'Length) := Name;
C_Name (C_Name'Last) := ASCII.NUL;
......@@ -1036,9 +1086,9 @@ package body System.OS_Lib is
procedure Get_Suffix_Ptr (Length, Ptr : Address);
pragma Import (C, Get_Suffix_Ptr, "__gnat_get_debuggable_suffix_ptr");
Suffix_Ptr : Address;
Suffix_Length : Integer;
Result : String_Access;
Suffix_Length : Integer;
Suffix_Ptr : Address;
begin
Get_Suffix_Ptr (Suffix_Length'Address, Suffix_Ptr'Address);
......@@ -1059,9 +1109,9 @@ package body System.OS_Lib is
procedure Get_Suffix_Ptr (Length, Ptr : Address);
pragma Import (C, Get_Suffix_Ptr, "__gnat_get_executable_suffix_ptr");
Suffix_Ptr : Address;
Suffix_Length : Integer;
Result : String_Access;
Suffix_Length : Integer;
Suffix_Ptr : Address;
begin
Get_Suffix_Ptr (Suffix_Length'Address, Suffix_Ptr'Address);
......@@ -1082,9 +1132,9 @@ package body System.OS_Lib is
procedure Get_Suffix_Ptr (Length, Ptr : Address);
pragma Import (C, Get_Suffix_Ptr, "__gnat_get_object_suffix_ptr");
Suffix_Ptr : Address;
Suffix_Length : Integer;
Result : String_Access;
Suffix_Length : Integer;
Suffix_Ptr : Address;
begin
Get_Suffix_Ptr (Suffix_Length'Address, Suffix_Ptr'Address);
......@@ -1106,8 +1156,8 @@ package body System.OS_Lib is
pragma Import
(C, Target_Exec_Ext_Ptr, "__gnat_target_debuggable_extension");
Suffix_Length : Integer;
Result : String_Access;
Suffix_Length : Integer;
begin
Suffix_Length := Integer (CRTL.strlen (Target_Exec_Ext_Ptr));
......@@ -1130,8 +1180,8 @@ package body System.OS_Lib is
pragma Import
(C, Target_Exec_Ext_Ptr, "__gnat_target_executable_extension");
Suffix_Length : Integer;
Result : String_Access;
Suffix_Length : Integer;
begin
Suffix_Length := Integer (CRTL.strlen (Target_Exec_Ext_Ptr));
......@@ -1154,8 +1204,8 @@ package body System.OS_Lib is
pragma Import
(C, Target_Object_Ext_Ptr, "__gnat_target_object_extension");
Suffix_Length : Integer;
Result : String_Access;
Suffix_Length : Integer;
begin
Suffix_Length := Integer (CRTL.strlen (Target_Object_Ext_Ptr));
......@@ -1308,7 +1358,13 @@ package body System.OS_Lib is
Second : out Second_Type)
is
procedure To_GM_Time
(P_Time_T, P_Year, P_Month, P_Day, P_Hours, P_Mins, P_Secs : Address);
(P_Time_T : Address;
P_Year : Address;
P_Month : Address;
P_Day : Address;
P_Hours : Address;
P_Mins : Address;
P_Secs : Address);
pragma Import (C, To_GM_Time, "__gnat_to_gm_time");
T : OS_Time := Date;
......@@ -1325,8 +1381,13 @@ package body System.OS_Lib is
Locked_Processing : begin
SSL.Lock_Task.all;
To_GM_Time
(T'Address, Y'Address, Mo'Address, D'Address,
H'Address, Mn'Address, S'Address);
(P_Time_T => T'Address,
P_Year => Y'Address,
P_Month => Mo'Address,
P_Day => D'Address,
P_Hours => H'Address,
P_Mins => Mn'Address,
P_Secs => S'Address);
SSL.Unlock_Task.all;
exception
......@@ -1356,12 +1417,26 @@ package body System.OS_Lib is
Second : Second_Type) return OS_Time
is
procedure To_OS_Time
(P_Time_T : Address; Year, Month, Day, Hours, Mins, Secs : Integer);
(P_Time_T : Address;
P_Year : Integer;
P_Month : Integer;
P_Day : Integer;
P_Hours : Integer;
P_Mins : Integer;
P_Secs : Integer);
pragma Import (C, To_OS_Time, "__gnat_to_os_time");
Result : OS_Time;
begin
To_OS_Time
(Result'Address, Year - 1900, Month - 1, Day, Hour, Minute, Second);
(P_Time_T => Result'Address,
P_Year => Year - 1900,
P_Month => Month - 1,
P_Day => Day,
P_Hours => Hour,
P_Mins => Minute,
P_Secs => Second);
return Result;
end GM_Time_Of;
......@@ -1644,9 +1719,10 @@ package body System.OS_Lib is
(Program_Name : String;
Args : Argument_List) return Process_Id
is
Pid : Process_Id;
Junk : Integer;
pragma Warnings (Off, Junk);
Pid : Process_Id;
begin
Spawn_Internal (Program_Name, Args, Junk, Pid, Blocking => False);
return Pid;
......@@ -1658,9 +1734,9 @@ package body System.OS_Lib is
Output_File_Descriptor : File_Descriptor;
Err_To_Out : Boolean := True) return Process_Id
is
Saved_Output : File_Descriptor;
Saved_Error : File_Descriptor := Invalid_FD; -- prevent warning
Pid : Process_Id;
Saved_Error : File_Descriptor := Invalid_FD; -- prevent warning
Saved_Output : File_Descriptor;
begin
if Output_File_Descriptor = Invalid_FD then
......@@ -1717,7 +1793,8 @@ package body System.OS_Lib is
return Invalid_Pid;
else
Result := Non_Blocking_Spawn
Result :=
Non_Blocking_Spawn
(Program_Name, Args, Output_File_Descriptor, Err_To_Out);
-- Close the file just created for the output, as the file descriptor
......@@ -1737,15 +1814,14 @@ package body System.OS_Lib is
Stdout_File : String;
Stderr_File : String) return Process_Id
is
Stdout_FD : constant File_Descriptor :=
Create_Output_Text_File (Stdout_File);
Stderr_FD : constant File_Descriptor :=
Create_Output_Text_File (Stderr_File);
Saved_Output : File_Descriptor;
Saved_Error : File_Descriptor;
Stdout_FD : constant File_Descriptor :=
Create_Output_Text_File (Stdout_File);
Result : Process_Id;
Saved_Error : File_Descriptor;
Saved_Output : File_Descriptor;
begin
-- Do not attempt to spawn if the output files could not be created
......@@ -1784,7 +1860,6 @@ package body System.OS_Lib is
-------------------------
procedure Normalize_Arguments (Args : in out Argument_List) is
procedure Quote_Argument (Arg : in out String_Access);
-- Add quote around argument if it contains spaces (or HT characters)
......@@ -1797,9 +1872,9 @@ package body System.OS_Lib is
--------------------
procedure Quote_Argument (Arg : in out String_Access) is
Res : String (1 .. Arg'Length * 2);
J : Positive := 1;
Quote_Needed : Boolean := False;
Res : String (1 .. Arg'Length * 2);
begin
if Arg (Arg'First) /= '"' or else Arg (Arg'Last) /= '"' then
......@@ -1896,33 +1971,19 @@ package body System.OS_Lib is
Resolve_Links : Boolean := True;
Case_Sensitive : Boolean := True) return String
is
Max_Path : Integer;
pragma Import (C, Max_Path, "__gnat_max_path_len");
-- Maximum length of a path name
procedure Get_Current_Dir
(Dir : System.Address;
Length : System.Address);
pragma Import (C, Get_Current_Dir, "__gnat_get_current_dir");
Path_Buffer : String (1 .. Max_Path + Max_Path + 2);
End_Path : Natural := 0;
Link_Buffer : String (1 .. Max_Path + 2);
Status : Integer;
Last : Positive;
Start : Natural;
Finish : Positive;
Max_Iterations : constant := 500;
function Get_File_Names_Case_Sensitive return Integer;
pragma Import
(C, Get_File_Names_Case_Sensitive,
"__gnat_get_file_names_case_sensitive");
Fold_To_Lower_Case : constant Boolean :=
not Case_Sensitive
and then Get_File_Names_Case_Sensitive = 0;
Max_Path : Integer;
pragma Import (C, Max_Path, "__gnat_max_path_len");
-- Maximum length of a path name
function Readlink
(Path : System.Address;
......@@ -1936,9 +1997,9 @@ package body System.OS_Lib is
(C, To_Canonical_File_Spec, "__gnat_to_canonical_file_spec");
-- Convert possible foreign file syntax to canonical form
The_Name : String (1 .. Name'Length + 1);
Canonical_File_Addr : System.Address;
Canonical_File_Len : Integer;
Fold_To_Lower_Case : constant Boolean :=
not Case_Sensitive
and then Get_File_Names_Case_Sensitive = 0;
function Final_Value (S : String) return String;
-- Make final adjustment to the returned string. This function strips
......@@ -2052,6 +2113,22 @@ package body System.OS_Lib is
end if;
end Get_Directory;
-- Local variables
Max_Iterations : constant := 500;
Canonical_File_Addr : System.Address;
Canonical_File_Len : Integer;
End_Path : Natural := 0;
Finish : Positive;
Last : Positive;
Link_Buffer : String (1 .. Max_Path + 2);
Path_Buffer : String (1 .. Max_Path + Max_Path + 2);
Start : Natural;
Status : Integer;
The_Name : String (1 .. Name'Length + 1);
-- Start of processing for Normalize_Pathname
begin
......@@ -2236,15 +2313,12 @@ package body System.OS_Lib is
if Last = 1 then
return (1 => Directory_Separator);
else
if Fold_To_Lower_Case then
System.Case_Util.To_Lower (Path_Buffer (1 .. Last - 1));
end if;
return Path_Buffer (1 .. Last - 1);
end if;
else
Path_Buffer (Last + 1 .. End_Path - 2) :=
Path_Buffer (Last + 3 .. End_Path);
......@@ -2294,9 +2368,11 @@ package body System.OS_Lib is
begin
Path_Buffer (Finish + 1) := ASCII.NUL;
Status := Readlink (Path_Buffer'Address,
Link_Buffer'Address,
Link_Buffer'Length);
Status :=
Readlink
(Path => Path_Buffer'Address,
Buf => Link_Buffer'Address,
Bufsiz => Link_Buffer'Length);
Path_Buffer (Finish + 1) := Saved;
end;
......@@ -2631,9 +2707,10 @@ package body System.OS_Lib is
(Program_Name : String;
Args : Argument_List) return Integer
is
Result : Integer;
Junk : Process_Id;
pragma Warnings (Off, Junk);
Result : Integer;
begin
Spawn_Internal (Program_Name, Args, Result, Junk, Blocking => True);
return Result;
......@@ -2655,8 +2732,8 @@ package body System.OS_Lib is
Return_Code : out Integer;
Err_To_Out : Boolean := True)
is
Saved_Output : File_Descriptor;
Saved_Error : File_Descriptor := Invalid_FD; -- prevent compiler warning
Saved_Output : File_Descriptor;
begin
-- Set standard output and error to the temporary file
......@@ -2727,7 +2804,6 @@ package body System.OS_Lib is
Pid : out Process_Id;
Blocking : Boolean)
is
procedure Spawn (Args : Argument_List);
-- Call Spawn with given argument list
......@@ -2742,8 +2818,8 @@ package body System.OS_Lib is
type Chars is array (Positive range <>) of aliased Character;
type Char_Ptr is access constant Character;
Command_Len : constant Positive := Program_Name'Length + 1
+ Args_Length (Args);
Command_Len : constant Positive := Program_Name'Length + 1 +
Args_Length (Args);
Command_Last : Natural := 0;
Command : aliased Chars (1 .. Command_Len);
-- Command contains all characters of the Program_Name and Args, all
......
......@@ -66,14 +66,14 @@ package System.OS_Lib is
subtype String_Access is Strings.String_Access;
function "=" (Left, Right : String_Access) return Boolean
function "=" (Left : String_Access; Right : String_Access) return Boolean
renames Strings."=";
procedure Free (X : in out String_Access) renames Strings.Free;
subtype String_List is Strings.String_List;
function "=" (Left, Right : String_List) return Boolean
function "=" (Left : String_List; Right : String_List) return Boolean
renames Strings."=";
function "&" (Left : String_Access; Right : String_Access)
......@@ -87,11 +87,11 @@ package System.OS_Lib is
subtype String_List_Access is Strings.String_List_Access;
function "=" (Left, Right : String_List_Access) return Boolean
renames Strings."=";
function "="
(Left : String_List_Access;
Right : String_List_Access) return Boolean renames Strings."=";
procedure Free (Arg : in out String_List_Access)
renames Strings.Free;
procedure Free (Arg : in out String_List_Access) renames Strings.Free;
---------------------
-- Time/Date Stuff --
......@@ -110,6 +110,14 @@ package System.OS_Lib is
Invalid_Time : constant OS_Time;
-- A special unique value used to flag an invalid time stamp value
function "<" (X : OS_Time; Y : OS_Time) return Boolean;
function ">" (X : OS_Time; Y : OS_Time) return Boolean;
function ">=" (X : OS_Time; Y : OS_Time) return Boolean;
function "<=" (X : OS_Time; Y : OS_Time) return Boolean;
-- Basic comparison operators on OS_Time with obvious meanings. Note that
-- these have Intrinsic convention, so for example it is not permissible
-- to create accesses to any of these functions.
subtype Year_Type is Integer range 1900 .. 2099;
subtype Month_Type is Integer range 1 .. 12;
subtype Day_Type is Integer range 1 .. 31;
......@@ -121,6 +129,10 @@ package System.OS_Lib is
function Current_Time return OS_Time;
-- Return the system clock value as OS_Time
function Current_Time_String return String;
-- Returns current local time in the form YYYY-MM-DD HH:MM:SS. The result
-- has bounds 1 .. 19.
function GM_Year (Date : OS_Time) return Year_Type;
function GM_Month (Date : OS_Time) return Month_Type;
function GM_Day (Date : OS_Time) return Day_Type;
......@@ -129,14 +141,6 @@ package System.OS_Lib is
function GM_Second (Date : OS_Time) return Second_Type;
-- Functions to extract information from OS_Time value in GMT form
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 that
-- these have Intrinsic convention, so for example it is not permissible
-- to create accesses to any of these functions.
procedure GM_Split
(Date : OS_Time;
Year : out Year_Type;
......@@ -160,10 +164,6 @@ package System.OS_Lib is
-- component parts to be interpreted in the local time zone, and returns
-- an OS_Time. Returns Invalid_Time if the creation fails.
function Current_Time_String return String;
-- Returns current local time in the form YYYY-MM-DD HH:MM:SS. The result
-- has bounds 1 .. 19.
----------------
-- File Stuff --
----------------
......@@ -191,6 +191,87 @@ package System.OS_Lib is
Invalid_FD : constant File_Descriptor := -1;
-- File descriptor returned when error in opening/creating file
procedure Close (FD : File_Descriptor; Status : out Boolean);
-- Close file referenced by FD. Status is False if the underlying service
-- failed. Reasons for failure include: disk full, disk quotas exceeded
-- and invalid file descriptor (the file may have been closed twice).
procedure Close (FD : File_Descriptor);
-- Close file referenced by FD. This form is used when the caller wants to
-- ignore any possible error (see above for error cases).
type Copy_Mode is
(Copy,
-- Copy the file. It is an error if the target file already exists. The
-- time stamps and other file attributes are preserved in the copy.
Overwrite,
-- If the target file exists, the file is replaced otherwise the file
-- is just copied. The time stamps and other file attributes are
-- preserved in the copy.
Append);
-- If the target file exists, the contents of the source file is
-- appended at the end. Otherwise the source file is just copied. The
-- time stamps and other file attributes are preserved if the
-- destination file does not exist.
type Attribute is
(Time_Stamps,
-- Copy time stamps from source file to target file. All other
-- attributes are set to normal default values for file creation.
Full,
-- All attributes are copied from the source file to the target file.
-- This includes the timestamps, and for example also includes
-- read/write/execute attributes in Unix systems.
None);
-- No attributes are copied. All attributes including the time stamp
-- values are set to normal default values for file creation.
-- Note: The default is Time_Stamps, which corresponds to the normal
-- default on Windows style systems. Full corresponds to the typical
-- effect of "cp -p" on Unix systems, and None corresponds to the typical
-- effect of "cp" on Unix systems.
-- Note: Time_Stamps and Full are not supported on VxWorks 5
procedure Copy_File
(Name : String;
Pathname : String;
Success : out Boolean;
Mode : Copy_Mode := Copy;
Preserve : Attribute := Time_Stamps);
-- Copy a file. Name must designate a single file (no wild cards allowed).
-- Pathname can be a filename or directory name. In the latter case Name
-- is copied into the directory preserving the same file name. Mode
-- 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 to
-- True or False indicating if the copy is successful (depending on the
-- specified Mode).
procedure Copy_File_Attributes
(From : String;
To : String;
Success : out Boolean;
Copy_Timestamp : Boolean := True;
Copy_Permissions : Boolean := True);
-- Copy some of the file attributes from one file to another. Both files
-- must exist, or Success is set to False.
procedure Copy_Time_Stamps
(Source : String;
Dest : String;
Success : out Boolean);
-- Copy Source file time stamps (last modification and last access time
-- stamps) to Dest file. Source and Dest must be valid filenames,
-- furthermore Dest must be writable. Success will be set to True if the
-- operation was successful and False otherwise.
--
-- Note: this procedure is not supported on VxWorks 5. On this platform,
-- Success is always set to False.
type Mode is (Binary, Text);
for Mode'Size use Integer'Size;
for Mode use (Binary => 0, Text => 1);
......@@ -202,26 +283,6 @@ package System.OS_Lib is
-- of Text where appropriate allows programs to take a portable Unix view
-- of DOS-format files and process them appropriately.
function Open_Read
(Name : String;
Fmode : Mode) return File_Descriptor;
-- Open file Name for reading, returning its file descriptor. File
-- descriptor returned is Invalid_FD if the file cannot be opened.
function Open_Read_Write
(Name : String;
Fmode : Mode) return File_Descriptor;
-- Open file Name for both reading and writing, returning its file
-- descriptor. File descriptor returned is Invalid_FD if the file
-- cannot be opened.
function Open_Append
(Name : String;
Fmode : Mode) return File_Descriptor;
-- Opens file Name for appending, returning its file descriptor. File
-- descriptor returned is Invalid_FD if the file cannot be successfully
-- opened.
function Create_File
(Name : String;
Fmode : Mode) return File_Descriptor;
......@@ -230,11 +291,6 @@ package System.OS_Lib is
-- overwritten. File descriptor returned is Invalid_FD if file cannot be
-- successfully created.
function Create_Output_Text_File (Name : String) return File_Descriptor;
-- Creates new text file with given name suitable to redirect standard
-- output, returning file descriptor. File descriptor returned is
-- Invalid_FD if file cannot be successfully created.
function Create_New_File
(Name : String;
Fmode : Mode) return File_Descriptor;
......@@ -243,6 +299,11 @@ package System.OS_Lib is
-- that it fails if the file already exists. File descriptor returned is
-- Invalid_FD if the file exists or cannot be created.
function Create_Output_Text_File (Name : String) return File_Descriptor;
-- Creates new text file with given name suitable to redirect standard
-- output, returning file descriptor. File descriptor returned is
-- Invalid_FD if file cannot be successfully created.
Temp_File_Len : constant Integer := 12;
-- Length of name returned by Create_Temp_File call (GNAT-XXXXXX & NUL)
......@@ -296,148 +357,17 @@ package System.OS_Lib is
-- There is no race condition problem between processes trying to create
-- temp files at the same time in the same directory.
procedure Close (FD : File_Descriptor; Status : out Boolean);
-- Close file referenced by FD. Status is False if the underlying service
-- failed. Reasons for failure include: disk full, disk quotas exceeded
-- and invalid file descriptor (the file may have been closed twice).
procedure Close (FD : File_Descriptor);
-- Close file referenced by FD. This form is used when the caller wants to
-- 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);
-- Deletes file. Success is set True or False indicating if the delete is
-- successful.
procedure Rename_File
(Old_Name : String;
New_Name : String;
Success : out Boolean);
-- Rename a file. Success is set True or False indicating if the rename is
-- successful or not.
--
-- WARNING: In one very important respect, this function is significantly
-- non-portable. If New_Name already exists then on Unix systems, the call
-- deletes the existing file, and the call signals success. On Windows, the
-- call fails, without doing the rename operation. See also the procedure
-- Ada.Directories.Rename, which portably provides the windows semantics,
-- i.e. fails if the output file already exists.
-- The following defines the mode for the Copy_File procedure below. Note
-- that "time stamps and other file attributes" in the descriptions below
-- refers to the creation and last modification times, and also the file
-- access (read/write/execute) status flags.
type Copy_Mode is
(Copy,
-- Copy the file. It is an error if the target file already exists. The
-- time stamps and other file attributes are preserved in the copy.
Overwrite,
-- If the target file exists, the file is replaced otherwise the file
-- is just copied. The time stamps and other file attributes are
-- preserved in the copy.
Append);
-- If the target file exists, the contents of the source file is
-- appended at the end. Otherwise the source file is just copied. The
-- time stamps and other file attributes are preserved if the
-- destination file does not exist.
type Attribute is
(Time_Stamps,
-- Copy time stamps from source file to target file. All other
-- attributes are set to normal default values for file creation.
Full,
-- All attributes are copied from the source file to the target file.
-- This includes the timestamps, and for example also includes
-- read/write/execute attributes in Unix systems.
None);
-- No attributes are copied. All attributes including the time stamp
-- values are set to normal default values for file creation.
-- Note: The default is Time_Stamps, which corresponds to the normal
-- default on Windows style systems. Full corresponds to the typical
-- effect of "cp -p" on Unix systems, and None corresponds to the typical
-- effect of "cp" on Unix systems.
-- Note: Time_Stamps and Full are not supported on VxWorks 5
procedure Copy_File
(Name : String;
Pathname : String;
Success : out Boolean;
Mode : Copy_Mode := Copy;
Preserve : Attribute := Time_Stamps);
-- Copy a file. Name must designate a single file (no wild cards allowed).
-- Pathname can be a filename or directory name. In the latter case Name
-- is copied into the directory preserving the same file name. Mode
-- 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 to
-- True or False indicating if the copy is successful (depending on the
-- specified Mode).
--
procedure Copy_Time_Stamps (Source, Dest : String; Success : out Boolean);
-- Copy Source file time stamps (last modification and last access time
-- stamps) to Dest file. Source and Dest must be valid filenames,
-- furthermore Dest must be writable. Success will be set to True if the
-- operation was successful and False otherwise.
--
-- Note: this procedure is not supported on VxWorks 5. On this platform,
-- Success is always set to False.
procedure Set_File_Last_Modify_Time_Stamp (Name : String; Time : OS_Time);
-- Given the name of a file or directory, Name, set the last modification
-- time stamp. This function must be used for an unopened file.
function Read
(FD : File_Descriptor;
A : System.Address;
N : Integer) return Integer;
-- Read N bytes to address A from file referenced by FD. Returned value is
-- count of bytes actually read, which can be less than N at EOF.
function Write
(FD : File_Descriptor;
A : System.Address;
N : Integer) return Integer;
-- 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 a
-- disk full condition was detected.
Seek_Cur : constant := 1;
Seek_End : constant := 2;
Seek_Set : constant := 0;
-- Used to indicate origin for Lseek call
procedure Lseek
(FD : File_Descriptor;
offset : Long_Integer;
origin : Integer);
pragma Import (C, Lseek, "__gnat_lseek");
-- Sets the current file pointer to the indicated offset value, relative
-- to the current position (origin = SEEK_CUR), end of file (origin =
-- SEEK_END), or start of file (origin = SEEK_SET).
function File_Length (FD : File_Descriptor) return Long_Integer;
pragma Import (C, File_Length, "__gnat_file_length_long");
type Large_File_Size is range -2**63 .. 2**63 - 1;
-- Maximum supported size for a file (8 exabytes = 8 million terabytes,
-- should be enough to accomodate all possible needs for quite a while).
function File_Length (FD : File_Descriptor) return Long_Integer;
pragma Import (C, File_Length, "__gnat_file_length_long");
function File_Length64 (FD : File_Descriptor) return Large_File_Size;
pragma Import (C, File_Length64, "__gnat_file_length");
-- Get length of file from file descriptor FD
......@@ -451,9 +381,127 @@ package System.OS_Lib is
-- Get time stamp of file from file descriptor FD Returns Invalid_Time is
-- FD doesn't correspond to an existing file.
function Normalize_Pathname
(Name : String;
Directory : String := "";
function Get_Debuggable_Suffix return String_Access;
-- Return the debuggable suffix convention. Usually this is the same as
-- the convention for Get_Executable_Suffix. The result is allocated on
-- the heap and should be freed after use to avoid storage leaks.
function Get_Executable_Suffix return String_Access;
-- Return the executable suffix convention. The result is allocated on the
-- heap and should be freed after use to avoid storage leaks.
function Get_Object_Suffix return String_Access;
-- Return the object suffix convention. The result is allocated on the heap
-- and should be freed after use to avoid storage leaks.
function Get_Target_Debuggable_Suffix return String_Access;
-- Return the target debuggable suffix convention. Usually this is the same
-- as the convention for Get_Executable_Suffix. The result is allocated on
-- the heap and should be freed after use to avoid storage leaks.
function Get_Target_Executable_Suffix return String_Access;
-- Return the target executable suffix convention. The result is allocated
-- on the heap and should be freed after use to avoid storage leaks.
function Get_Target_Object_Suffix return String_Access;
-- Return the target object suffix convention. The result is allocated on
-- the heap and should be freed after use to avoid storage leaks.
function Is_Absolute_Path (Name : String) return Boolean;
-- Returns True if Name is an absolute path name, i.e. it designates a
-- file or directory absolutely rather than relative to another directory.
function Is_Directory (Name : String) return Boolean;
-- Determines if the given string, Name, is the name of a directory.
-- Returns True if so, False otherwise. Name may be an absolute path
-- name or a relative path name, including a simple file name. If it is
-- a relative path name, it is relative to the current working directory.
function Is_Executable_File (Name : String) return Boolean;
-- Determines if the given string, Name, is the name of an existing file
-- that is executable. Returns True if so, False otherwise. Note that this
-- function simply interrogates the file attributes (e.g. using the C
-- function stat), so it does not indicate a situation in which a file may
-- not actually be readable due to some other process having exclusive
-- access.
function Is_Readable_File (Name : String) return Boolean;
-- Determines if the given string, Name, is the name of an existing file
-- that is readable. Returns True if so, False otherwise. Note that this
-- function simply interrogates the file attributes (e.g. using the C
-- function stat), so it does not indicate a situation in which a file may
-- not actually be readable due to some other process having exclusive
-- access.
function Is_Regular_File (Name : String) return Boolean;
-- Determines if the given string, Name, is the name of an existing
-- regular file. Returns True if so, False otherwise. Name may be an
-- absolute path name or a relative path name, including a simple file
-- name. If it is a relative path name, it is relative to the current
-- working directory.
function Is_Symbolic_Link (Name : String) return Boolean;
-- Determines if the given string, Name, is the path of a symbolic link on
-- systems that support it. Returns True if so, False if the path is not a
-- symbolic link or if the system does not support symbolic links.
--
-- 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
-- span file systems and may refer to directories.
function Is_Writable_File (Name : String) return Boolean;
-- Determines if the given string, Name, is the name of an existing file
-- that is writable. Returns True if so, False otherwise. Note that this
-- function simply interrogates the file attributes (e.g. using the C
-- function stat), so it does not indicate a situation in which a file may
-- not actually be writeable due to some other process having exclusive
-- access.
function Locate_Exec_On_Path (Exec_Name : String) return String_Access;
-- Try to locate an executable whose name is given by Exec_Name in the
-- directories listed in the environment Path. If the Exec_Name does not
-- have the executable suffix, it will be appended before the search.
-- Otherwise works like Locate_Regular_File below. If the executable is
-- not found, null is returned.
--
-- Note that this function allocates memory for the returned value. This
-- memory needs to be deallocated after use.
function Locate_Regular_File
(File_Name : String;
Path : String) return String_Access;
-- Try to locate a regular file whose name is given by File_Name in the
-- directories listed in Path. If a file is found, its full pathname is
-- returned; otherwise, a null pointer is returned. If the File_Name given
-- 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
-- includes directory information, Locate_Regular_File first checks if the
-- file exists relative to the current directory. If it does not, or if
-- the File_Name given is a simple file name, the Path argument is parsed
-- according to OS conventions, and for each directory in the Path a check
-- is made if File_Name is a relative pathname of a regular file from that
-- directory.
--
-- Note that this function allocates some memory for the returned value.
-- This memory needs to be deallocated after use.
Seek_Cur : constant := 1;
Seek_End : constant := 2;
Seek_Set : constant := 0;
-- Used to indicate origin for Lseek call
procedure Lseek
(FD : File_Descriptor;
offset : Long_Integer;
origin : Integer);
pragma Import (C, Lseek, "__gnat_lseek");
-- Sets the current file pointer to the indicated offset value, relative
-- to the current position (origin = SEEK_CUR), end of file (origin =
-- SEEK_END), or start of file (origin = SEEK_SET).
function Normalize_Pathname
(Name : String;
Directory : String := "";
Resolve_Links : Boolean := True;
Case_Sensitive : Boolean := True) return String;
-- Returns a file name as an absolute path name, resolving all relative
......@@ -493,66 +541,61 @@ package System.OS_Lib is
-- results. If Case_Sensitive is set to True, this function does not change
-- the casing of file and directory names.
function Is_Absolute_Path (Name : String) return Boolean;
-- Returns True if Name is an absolute path name, i.e. it designates a
-- file or directory absolutely rather than relative to another directory.
function Is_Regular_File (Name : String) return Boolean;
-- Determines if the given string, Name, is the name of an existing
-- regular file. Returns True if so, False otherwise. Name may be an
-- absolute path name or a relative path name, including a simple file
-- name. If it is a relative path name, it is relative to the current
-- working directory.
function Is_Directory (Name : String) return Boolean;
-- Determines if the given string, Name, is the name of a directory.
-- Returns True if so, False otherwise. Name may be an absolute path
-- name or a relative path name, including a simple file name. If it is
-- a relative path name, it is relative to the current working directory.
function Open_Append
(Name : String;
Fmode : Mode) return File_Descriptor;
-- Opens file Name for appending, returning its file descriptor. File
-- descriptor returned is Invalid_FD if the file cannot be successfully
-- opened.
function Is_Readable_File (Name : String) return Boolean;
-- Determines if the given string, Name, is the name of an existing file
-- that is readable. Returns True if so, False otherwise. Note that this
-- function simply interrogates the file attributes (e.g. using the C
-- function stat), so it does not indicate a situation in which a file may
-- not actually be readable due to some other process having exclusive
-- access.
function Open_Read
(Name : String;
Fmode : Mode) return File_Descriptor;
-- Open file Name for reading, returning its file descriptor. File
-- descriptor returned is Invalid_FD if the file cannot be opened.
function Is_Executable_File (Name : String) return Boolean;
-- Determines if the given string, Name, is the name of an existing file
-- that is executable. Returns True if so, False otherwise. Note that this
-- function simply interrogates the file attributes (e.g. using the C
-- function stat), so it does not indicate a situation in which a file may
-- not actually be readable due to some other process having exclusive
-- access.
function Open_Read_Write
(Name : String;
Fmode : Mode) return File_Descriptor;
-- Open file Name for both reading and writing, returning its file
-- descriptor. File descriptor returned is Invalid_FD if the file
-- cannot be opened.
function Is_Writable_File (Name : String) return Boolean;
-- Determines if the given string, Name, is the name of an existing file
-- that is writable. Returns True if so, False otherwise. Note that this
-- function simply interrogates the file attributes (e.g. using the C
-- function stat), so it does not indicate a situation in which a file may
-- not actually be writeable due to some other process having exclusive
-- access.
function Read
(FD : File_Descriptor;
A : System.Address;
N : Integer) return Integer;
-- Read N bytes to address A from file referenced by FD. Returned value is
-- count of bytes actually read, which can be less than N at EOF.
function Is_Symbolic_Link (Name : String) return Boolean;
-- Determines if the given string, Name, is the path of a symbolic link on
-- systems that support it. Returns True if so, False if the path is not a
-- symbolic link or if the system does not support symbolic links.
procedure Rename_File
(Old_Name : String;
New_Name : String;
Success : out Boolean);
-- Rename a file. Success is set True or False indicating if the rename is
-- successful or not.
--
-- 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
-- span file systems and may refer to directories.
procedure Set_Writable (Name : String);
-- Change permissions on the named file to make it writable for its owner
-- WARNING: In one very important respect, this function is significantly
-- non-portable. If New_Name already exists then on Unix systems, the call
-- deletes the existing file, and the call signals success. On Windows, the
-- call fails, without doing the rename operation. See also the procedure
-- Ada.Directories.Rename, which portably provides the windows semantics,
-- i.e. fails if the output file already exists.
procedure Set_Non_Writable (Name : String);
-- Change permissions on the named file to make it non-writable for its
-- owner. The readable and executable permissions are not modified.
-- The following defines the mode for the Copy_File procedure below. Note
-- that "time stamps and other file attributes" in the descriptions below
-- refers to the creation and last modification times, and also the file
-- access (read/write/execute) status flags.
procedure Set_Read_Only (Name : String) renames Set_Non_Writable;
-- This renaming is provided for backwards compatibility with previous
-- versions. The use of Set_Non_Writable is preferred (clearer name).
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.
S_Owner : constant := 1;
S_Group : constant := 2;
......@@ -564,69 +607,37 @@ package System.OS_Lib is
-- for its owner, group or others, according to the setting of Mode.
-- As indicated, the default if no Mode parameter is given is owner.
procedure Set_Readable (Name : String);
-- Change permissions on the named file to make it readable for its
-- owner.
procedure Set_File_Last_Modify_Time_Stamp (Name : String; Time : OS_Time);
-- Given the name of a file or directory, Name, set the last modification
-- time stamp. This function must be used for an unopened file.
procedure Set_Non_Readable (Name : String);
-- Change permissions on the named file to make it non-readable for
-- its owner. The writable and executable permissions are not
-- modified.
function Locate_Exec_On_Path
(Exec_Name : String) return String_Access;
-- Try to locate an executable whose name is given by Exec_Name in the
-- directories listed in the environment Path. If the Exec_Name does not
-- have the executable suffix, it will be appended before the search.
-- Otherwise works like Locate_Regular_File below. If the executable is
-- not found, null is returned.
--
-- Note that this function allocates memory for the returned value. This
-- memory needs to be deallocated after use.
function Locate_Regular_File
(File_Name : String;
Path : String) return String_Access;
-- Try to locate a regular file whose name is given by File_Name in the
-- directories listed in Path. If a file is found, its full pathname is
-- returned; otherwise, a null pointer is returned. If the File_Name given
-- 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
-- includes directory information, Locate_Regular_File first checks if the
-- file exists relative to the current directory. If it does not, or if
-- the File_Name given is a simple file name, the Path argument is parsed
-- according to OS conventions, and for each directory in the Path a check
-- is made if File_Name is a relative pathname of a regular file from that
-- directory.
--
-- Note that this function allocates some memory for the returned value.
-- This memory needs to be deallocated after use.
function Get_Debuggable_Suffix return String_Access;
-- Return the debuggable suffix convention. Usually this is the same as
-- the convention for Get_Executable_Suffix. The result is allocated on
-- the heap and should be freed after use to avoid storage leaks.
function Get_Target_Debuggable_Suffix return String_Access;
-- Return the target debuggable suffix convention. Usually this is the same
-- as the convention for Get_Executable_Suffix. The result is allocated on
-- the heap and should be freed after use to avoid storage leaks.
procedure Set_Non_Writable (Name : String);
-- Change permissions on the named file to make it non-writable for its
-- owner. The readable and executable permissions are not modified.
function Get_Executable_Suffix return String_Access;
-- Return the executable suffix convention. The result is allocated on the
-- heap and should be freed after use to avoid storage leaks.
procedure Set_Read_Only (Name : String) renames Set_Non_Writable;
-- This renaming is provided for backwards compatibility with previous
-- versions. The use of Set_Non_Writable is preferred (clearer name).
function Get_Object_Suffix return String_Access;
-- Return the object suffix convention. The result is allocated on the heap
-- and should be freed after use to avoid storage leaks.
procedure Set_Readable (Name : String);
-- Change permissions on the named file to make it readable for its
-- owner.
function Get_Target_Executable_Suffix return String_Access;
-- Return the target executable suffix convention. The result is allocated
-- on the heap and should be freed after use to avoid storage leaks.
procedure Set_Writable (Name : String);
-- Change permissions on the named file to make it writable for its owner
function Get_Target_Object_Suffix return String_Access;
-- Return the target object suffix convention. The result is allocated on
-- the heap and should be freed after use to avoid storage leaks.
function Write
(FD : File_Descriptor;
A : System.Address;
N : Integer) return Integer;
-- 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 a
-- disk full condition was detected.
-- The following section contains low-level routines using addresses to
-- pass file name and executable name. In each routine the name must be
......@@ -637,34 +648,7 @@ package System.OS_Lib is
-- This subtype is used to document that a parameter is the address of a
-- null-terminated string containing the name of a file.
-- All the following functions need comments ???
function Open_Read
(Name : C_File_Name;
Fmode : Mode) return File_Descriptor;
function Open_Read_Write
(Name : C_File_Name;
Fmode : Mode) return File_Descriptor;
function Open_Append
(Name : C_File_Name;
Fmode : Mode) return File_Descriptor;
function Create_File
(Name : C_File_Name;
Fmode : Mode) return File_Descriptor;
function Create_New_File
(Name : C_File_Name;
Fmode : Mode) return File_Descriptor;
procedure Delete_File (Name : C_File_Name; Success : out Boolean);
procedure Rename_File
(Old_Name : C_File_Name;
New_Name : C_File_Name;
Success : out Boolean);
-- All the following functions need comments ???
procedure Copy_File
(Name : C_File_Name;
......@@ -674,23 +658,51 @@ package System.OS_Lib is
Preserve : Attribute := Time_Stamps);
procedure Copy_Time_Stamps
(Source, Dest : C_File_Name;
(Source : C_File_Name;
Dest : C_File_Name;
Success : out Boolean);
function Create_File
(Name : C_File_Name;
Fmode : Mode) return File_Descriptor;
function Create_New_File
(Name : C_File_Name;
Fmode : Mode) return File_Descriptor;
procedure Delete_File (Name : C_File_Name; Success : out Boolean);
function File_Time_Stamp (Name : C_File_Name) return OS_Time;
-- Returns Invalid_Time is Name doesn't correspond to an existing file
function Is_Regular_File (Name : C_File_Name) return Boolean;
function Is_Directory (Name : C_File_Name) return Boolean;
function Is_Readable_File (Name : C_File_Name) return Boolean;
function Is_Executable_File (Name : C_File_Name) return Boolean;
function Is_Writable_File (Name : C_File_Name) return Boolean;
function Is_Readable_File (Name : C_File_Name) return Boolean;
function Is_Regular_File (Name : C_File_Name) return Boolean;
function Is_Symbolic_Link (Name : C_File_Name) return Boolean;
function Is_Writable_File (Name : C_File_Name) return Boolean;
function Locate_Regular_File
(File_Name : C_File_Name;
Path : C_File_Name) return String_Access;
function Open_Append
(Name : C_File_Name;
Fmode : Mode) return File_Descriptor;
function Open_Read
(Name : C_File_Name;
Fmode : Mode) return File_Descriptor;
function Open_Read_Write
(Name : C_File_Name;
Fmode : Mode) return File_Descriptor;
procedure Rename_File
(Old_Name : C_File_Name;
New_Name : C_File_Name;
Success : out Boolean);
------------------
-- Subprocesses --
------------------
......@@ -705,6 +717,84 @@ package System.OS_Lib is
-- Note that there is a Free procedure declared for this subtype which
-- frees the array and all referenced strings.
type Process_Id is private;
-- A private type used to identify a process activated by the following
-- non-blocking calls. The only meaningful operation on this type is a
-- comparison for equality.
Invalid_Pid : constant Process_Id;
-- A special value used to indicate errors, as described below
function Argument_String_To_List
(Arg_String : String) return Argument_List_Access;
-- Take a string that is a program and its arguments and parse it into an
-- Argument_List. Note that the result is allocated on the heap, and must
-- be freed by the programmer (when it is no longer needed) to avoid
-- memory leaks.
procedure Kill (Pid : Process_Id; Hard_Kill : Boolean := True);
-- Kill the process designated by Pid. Does nothing if Pid is Invalid_Pid
-- or on platforms where it is not supported, such as VxWorks. Hard_Kill
-- is True by default, and when True the process is terminated immediately.
-- If Hard_Kill is False, then a signal SIGINT is sent to the process on
-- POSIX OS or a ctrl-C event on Windows, allowing the process a chance to
-- terminate properly using a corresponding handler.
function Non_Blocking_Spawn
(Program_Name : String;
Args : Argument_List) return Process_Id;
-- This is a non blocking call. The Process_Id of the spawned process is
-- returned. Parameters are to be used as in Spawn. If Invalid_Pid is
-- returned the program could not be spawned.
--
-- Spawning processes from tasking programs is not recommended. See
-- "NOTE: Spawn in tasking programs" below.
--
-- This function will always return Invalid_Pid under VxWorks, since there
-- is no notion of executables under this OS.
function Non_Blocking_Spawn
(Program_Name : String;
Args : Argument_List;
Output_File_Descriptor : File_Descriptor;
Err_To_Out : Boolean := True) return Process_Id;
-- Similar to the procedure above, but redirects the output to the file
-- designated by Output_File_Descriptor. If Err_To_Out is True, then the
-- Standard Error output is also redirected. Invalid_Pid is returned
-- if the program could not be spawned successfully.
--
-- Spawning processes from tasking programs is not recommended. See
-- "NOTE: Spawn in tasking programs" below.
--
-- This function will always return Invalid_Pid under VxWorks, since there
-- is no notion of executables under this OS.
function Non_Blocking_Spawn
(Program_Name : String;
Args : Argument_List;
Output_File : String;
Err_To_Out : Boolean := True) return Process_Id;
-- Similar to the procedure above, but saves the output of the command to
-- a file with the name Output_File.
--
-- Invalid_Pid is returned if the output file could not be created or if
-- the program could not be spawned successfully.
--
-- Spawning processes from tasking programs is not recommended. See
-- "NOTE: Spawn in tasking programs" below.
--
-- This function will always return Invalid_Pid under VxWorks, since there
-- is no notion of executables under this OS.
function Non_Blocking_Spawn
(Program_Name : String;
Args : Argument_List;
Stdout_File : String;
Stderr_File : String) return Process_Id;
-- Similar to the procedure above, but saves the standard output of the
-- command to a file with the name Stdout_File and the standard output
-- of the command to a file with the name Stderr_File.
procedure Normalize_Arguments (Args : in out Argument_List);
-- Normalize all arguments in the list. This ensure that the argument list
-- is compatible with the running OS and will works fine with Spawn and
......@@ -717,6 +807,10 @@ package System.OS_Lib is
-- individual referenced arguments in Argument_List are on the heap, and
-- may free them and reallocate if they are modified.
function Pid_To_Integer (Pid : Process_Id) return Integer;
-- Convert a process id to an Integer. Useful for writing hash functions
-- for type Process_Id or to compare two Process_Id (e.g. for sorting).
procedure Spawn
(Program_Name : String;
Args : Argument_List;
......@@ -795,73 +889,6 @@ package System.OS_Lib is
-- Spawning processes from tasking programs is not recommended. See
-- "NOTE: Spawn in tasking programs" below.
type Process_Id is private;
-- A private type used to identify a process activated by the following
-- non-blocking calls. The only meaningful operation on this type is a
-- comparison for equality.
Invalid_Pid : constant Process_Id;
-- A special value used to indicate errors, as described below
function Pid_To_Integer (Pid : Process_Id) return Integer;
-- Convert a process id to an Integer. Useful for writing hash functions
-- for type Process_Id or to compare two Process_Id (e.g. for sorting).
function Non_Blocking_Spawn
(Program_Name : String;
Args : Argument_List) return Process_Id;
-- This is a non blocking call. The Process_Id of the spawned process is
-- returned. Parameters are to be used as in Spawn. If Invalid_Pid is
-- returned the program could not be spawned.
--
-- Spawning processes from tasking programs is not recommended. See
-- "NOTE: Spawn in tasking programs" below.
--
-- This function will always return Invalid_Pid under VxWorks, since there
-- is no notion of executables under this OS.
function Non_Blocking_Spawn
(Program_Name : String;
Args : Argument_List;
Output_File_Descriptor : File_Descriptor;
Err_To_Out : Boolean := True) return Process_Id;
-- Similar to the procedure above, but redirects the output to the file
-- designated by Output_File_Descriptor. If Err_To_Out is True, then the
-- Standard Error output is also redirected. Invalid_Pid is returned
-- if the program could not be spawned successfully.
--
-- Spawning processes from tasking programs is not recommended. See
-- "NOTE: Spawn in tasking programs" below.
--
-- This function will always return Invalid_Pid under VxWorks, since there
-- is no notion of executables under this OS.
function Non_Blocking_Spawn
(Program_Name : String;
Args : Argument_List;
Output_File : String;
Err_To_Out : Boolean := True) return Process_Id;
-- Similar to the procedure above, but saves the output of the command to
-- a file with the name Output_File.
--
-- Invalid_Pid is returned if the output file could not be created or if
-- the program could not be spawned successfully.
--
-- Spawning processes from tasking programs is not recommended. See
-- "NOTE: Spawn in tasking programs" below.
--
-- This function will always return Invalid_Pid under VxWorks, since there
-- is no notion of executables under this OS.
function Non_Blocking_Spawn
(Program_Name : String;
Args : Argument_List;
Stdout_File : String;
Stderr_File : String) return Process_Id;
-- Similar to the procedure above, but saves the standard output of the
-- command to a file with the name Stdout_File and the standard output
-- of the command to a file with the name Stderr_File.
procedure Wait_Process (Pid : out Process_Id; Success : out Boolean);
-- Wait for the completion of any of the processes created by previous
-- calls to Non_Blocking_Spawn. The caller will be suspended until one of
......@@ -876,21 +903,6 @@ package System.OS_Lib is
-- This function will always set success to False under VxWorks, since
-- there is no notion of executables under this OS.
procedure Kill (Pid : Process_Id; Hard_Kill : Boolean := True);
-- Kill the process designated by Pid. Does nothing if Pid is Invalid_Pid
-- or on platforms where it is not supported, such as VxWorks. Hard_Kill
-- is True by default, and when True the process is terminated immediately.
-- If Hard_Kill is False, then a signal SIGINT is sent to the process on
-- POSIX OS or a ctrl-C event on Windows, allowing the process a chance to
-- terminate properly using a corresponding handler.
function Argument_String_To_List
(Arg_String : String) return Argument_List_Access;
-- Take a string that is a program and its arguments and parse it into an
-- Argument_List. Note that the result is allocated on the heap, and must
-- be freed by the programmer (when it is no longer needed) to avoid
-- memory leaks.
-------------------------------------
-- NOTE: Spawn in Tasking Programs --
-------------------------------------
......@@ -960,6 +972,17 @@ package System.OS_Lib is
-- Miscellaneous --
-------------------
function Errno return Integer;
pragma Import (C, Errno, "__get_errno");
-- Return the task-safe last error number
function Errno_Message
(Err : Integer := Errno;
Default : String := "") return String;
-- Return a message describing the given Errno value. If none is provided
-- by the system, return Default if not empty, else return a generic
-- message indicating the numeric errno value.
function Getenv (Name : String) return String_Access;
-- Get the value of the environment variable. Returns an access to the
-- empty string if the environment variable does not exist or has an
......@@ -969,16 +992,12 @@ package System.OS_Lib is
-- case), and needs to be freed explicitly when no longer needed to avoid
-- memory leaks.
procedure Setenv (Name : String; Value : String);
-- Set the value of the environment variable Name to Value. This call
-- modifies the current environment, but does not modify the parent
-- process environment. After a call to Setenv, Getenv (Name) will always
-- return a String_Access referencing the same String as Value. This is
-- true also for the null string case (the actual effect may be to either
-- set an explicit null as the value, or to remove the entry, this is
-- operating system dependent). Note that any following calls to Spawn
-- will pass an environment to the spawned process that includes the
-- changes made by Setenv calls.
procedure OS_Abort;
pragma Import (C, OS_Abort, "abort");
pragma No_Return (OS_Abort);
-- Exit to OS signalling an abort (traceback or other appropriate
-- diagnostic information should be given if possible, or entry made to
-- the debugger if that is possible).
procedure OS_Exit (Status : Integer);
pragma No_Return (OS_Exit);
......@@ -999,27 +1018,20 @@ package System.OS_Lib is
-- change the implementation of OS_Exit by redirecting OS_Exit_Ptr to an
-- other implementation.
procedure OS_Abort;
pragma Import (C, OS_Abort, "abort");
pragma No_Return (OS_Abort);
-- Exit to OS signalling an abort (traceback or other appropriate
-- diagnostic information should be given if possible, or entry made to
-- the debugger if that is possible).
function Errno return Integer;
pragma Import (C, Errno, "__get_errno");
-- Return the task-safe last error number
procedure Set_Errno (Errno : Integer);
pragma Import (C, Set_Errno, "__set_errno");
-- Set the task-safe error number
function Errno_Message
(Err : Integer := Errno;
Default : String := "") return String;
-- Return a message describing the given Errno value. If none is provided
-- by the system, return Default if not empty, else return a generic
-- message indicating the numeric errno value.
procedure Setenv (Name : String; Value : String);
-- Set the value of the environment variable Name to Value. This call
-- modifies the current environment, but does not modify the parent
-- process environment. After a call to Setenv, Getenv (Name) will always
-- return a String_Access referencing the same String as Value. This is
-- true also for the null string case (the actual effect may be to either
-- set an explicit null as the value, or to remove the entry, this is
-- operating system dependent). Note that any following calls to Spawn
-- will pass an environment to the spawned process that includes the
-- changes made by Setenv calls.
Directory_Separator : constant Character;
-- The character that is used to separate parts of a pathname
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment