Skip to content

R
riscv-gcc-1
Commit 2f97d24c by Arnaud Charlet
Options

[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
Showing with 664 additions and 534 deletions
gcc/ada/ChangeLog
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> 2015-10-27 Hristian Kirtchev <kirtchev@adacore.com>
* namet.adb, namet.ads: Minor reformatting. * namet.adb, namet.ads: Minor reformatting.
......
gcc/ada/adaint.c
...@@ -2902,6 +2902,8 @@ char __gnat_environment_char = '$'; ...@@ -2902,6 +2902,8 @@ char __gnat_environment_char = '$';
mode = 1 : In this mode, time stamps and read/write/execute attributes are mode = 1 : In this mode, time stamps and read/write/execute attributes are
copied. 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. */ Returns 0 if operation was successful and -1 in case of error. */
int int
...@@ -2921,39 +2923,46 @@ __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED, char *to ATTRIBUTE_UNUSED, ...@@ -2921,39 +2923,46 @@ __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED, char *to ATTRIBUTE_UNUSED,
S2WSC (wfrom, from, GNAT_MAX_PATH_LEN + 2); S2WSC (wfrom, from, GNAT_MAX_PATH_LEN + 2);
S2WSC (wto, to, GNAT_MAX_PATH_LEN + 2); S2WSC (wto, to, GNAT_MAX_PATH_LEN + 2);
/* retrieve from times */ /* Do we need to copy the timestamp ? */
hfrom = CreateFile if (mode != 2) {
(wfrom, GENERIC_READ, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); /* retrieve from times */
if (hfrom == INVALID_HANDLE_VALUE) hfrom = CreateFile
return -1; (wfrom, GENERIC_READ, 0, NULL, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, NULL);
res = GetFileTime (hfrom, &fct, &flat, &flwt); if (hfrom == INVALID_HANDLE_VALUE)
return -1;
CloseHandle (hfrom); res = GetFileTime (hfrom, &fct, &flat, &flwt);
if (res == 0) CloseHandle (hfrom);
return -1;
/* retrieve from times */ if (res == 0)
return -1;
hto = CreateFile /* retrieve from times */
(wto, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
if (hto == INVALID_HANDLE_VALUE) hto = CreateFile
return -1; (wto, GENERIC_WRITE, 0, NULL, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, NULL);
res = SetFileTime (hto, NULL, &flat, &flwt); if (hto == INVALID_HANDLE_VALUE)
return -1;
CloseHandle (hto); res = SetFileTime (hto, NULL, &flat, &flwt);
if (res == 0) CloseHandle (hto);
return -1;
if (res == 0)
return -1;
}
/* Do we need to copy the permissions ? */
/* Set file attributes in full mode. */ /* Set file attributes in full mode. */
if (mode == 1) if (mode != 0)
{ {
DWORD attribs = GetFileAttributes (wfrom); DWORD attribs = GetFileAttributes (wfrom);
...@@ -2971,26 +2980,24 @@ __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED, char *to ATTRIBUTE_UNUSED, ...@@ -2971,26 +2980,24 @@ __gnat_copy_attribs (char *from ATTRIBUTE_UNUSED, char *to ATTRIBUTE_UNUSED,
GNAT_STRUCT_STAT fbuf; GNAT_STRUCT_STAT fbuf;
struct utimbuf tbuf; struct utimbuf tbuf;
if (GNAT_STAT (from, &fbuf) == -1) if (GNAT_STAT (from, &fbuf) == -1) {
{ return -1;
return -1; }
}
tbuf.actime = fbuf.st_atime; /* Do we need to copy timestamp ? */
tbuf.modtime = fbuf.st_mtime; 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;
return -1; }
} }
if (mode == 1) /* Do we need to copy file permissions ? */
{ if (mode != 0 && (chmod (to, fbuf.st_mode) == -1)) {
if (chmod (to, fbuf.st_mode) == -1)
{
return -1; return -1;
} }
}
return 0; return 0;
#endif #endif
......
gcc/ada/bindgen.adb
...@@ -88,6 +88,12 @@ package body Bindgen is ...@@ -88,6 +88,12 @@ package body Bindgen is
-- attach interrupt handlers at the end of the elaboration when partition -- attach interrupt handlers at the end of the elaboration when partition
-- elaboration policy is sequential. -- 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; Lib_Final_Built : Boolean := False;
-- Flag indicating whether the finalize_library rountine has been built -- Flag indicating whether the finalize_library rountine has been built
...@@ -536,6 +542,13 @@ package body Bindgen is ...@@ -536,6 +542,13 @@ package body Bindgen is
WBI (" procedure Activate_All_Tasks_Sequential;"); WBI (" procedure Activate_All_Tasks_Sequential;");
WBI (" pragma Import (C, Activate_All_Tasks_Sequential," & WBI (" pragma Import (C, Activate_All_Tasks_Sequential," &
" ""__gnat_activate_all_tasks"");"); " ""__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; end if;
WBI (" begin"); WBI (" begin");
...@@ -944,6 +957,10 @@ package body Bindgen is ...@@ -944,6 +957,10 @@ package body Bindgen is
end if; end if;
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 " & Ada_Init_Name.all & ";");
WBI (""); WBI ("");
end Gen_Adainit; end Gen_Adainit;
...@@ -2872,6 +2889,12 @@ package body Bindgen is ...@@ -2872,6 +2889,12 @@ package body Bindgen is
-- Ditto for the use of restrictions -- Ditto for the use of restrictions
Check_Package (System_Restrictions_Used, "system.restrictions%s"); 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 loop;
end Resolve_Binder_Options; end Resolve_Binder_Options;
......
gcc/ada/s-os_lib.adb
...@@ -55,11 +55,13 @@ package body System.OS_Lib is ...@@ -55,11 +55,13 @@ package body System.OS_Lib is
pragma Import (C, Dup2, "__gnat_dup2"); pragma Import (C, Dup2, "__gnat_dup2");
function Copy_Attributes function Copy_Attributes
(From, To : System.Address; (From : System.Address;
Mode : Integer) return Integer; To : System.Address;
Mode : Integer) return Integer;
pragma Import (C, Copy_Attributes, "__gnat_copy_attribs"); pragma Import (C, Copy_Attributes, "__gnat_copy_attribs");
-- Mode = 0 - copy only time stamps. -- Mode = 0 - copy only time stamps.
-- Mode = 1 - copy time stamps and read/write/execute attributes -- Mode = 1 - copy time stamps and read/write/execute attributes
-- Mode = 2 - copy read/write/execute attributes
On_Windows : constant Boolean := Directory_Separator = '\'; On_Windows : constant Boolean := Directory_Separator = '\';
-- An indication that we are on Windows. Used in Normalize_Pathname, to -- An indication that we are on Windows. Used in Normalize_Pathname, to
...@@ -324,7 +326,7 @@ package body System.OS_Lib is ...@@ -324,7 +326,7 @@ package body System.OS_Lib is
-- Returns pathname Dir concatenated with File adding the directory -- Returns pathname Dir concatenated with File adding the directory
-- separator only if needed. -- 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 -- Read data from From and place them into To. In both cases the
-- operations uses the current file position. Raises Constraint_Error -- operations uses the current file position. Raises Constraint_Error
-- if a problem occurs during the copy. -- if a problem occurs during the copy.
...@@ -337,11 +339,6 @@ package body System.OS_Lib is ...@@ -337,11 +339,6 @@ package body System.OS_Lib is
---------------- ----------------
function Build_Path (Dir : String; File : String) return String 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; function Is_Dirsep (C : Character) return Boolean;
pragma Inline (Is_Dirsep); pragma Inline (Is_Dirsep);
-- Returns True if C is a directory separator. On Windows we -- Returns True if C is a directory separator. On Windows we
...@@ -356,6 +353,13 @@ package body System.OS_Lib is ...@@ -356,6 +353,13 @@ package body System.OS_Lib is
return C = Directory_Separator or else C = '/'; return C = Directory_Separator or else C = '/';
end Is_Dirsep; 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 -- Start of processing for Build_Path
begin begin
...@@ -392,7 +396,7 @@ package body System.OS_Lib is ...@@ -392,7 +396,7 @@ package body System.OS_Lib is
-- Copy -- -- Copy --
---------- ----------
procedure Copy (From, To : File_Descriptor) is procedure Copy (From : File_Descriptor; To : File_Descriptor) is
Buf_Size : constant := 200_000; Buf_Size : constant := 200_000;
type Buf is array (1 .. Buf_Size) of Character; type Buf is array (1 .. Buf_Size) of Character;
type Buf_Ptr is access Buf; type Buf_Ptr is access Buf;
...@@ -490,7 +494,6 @@ package body System.OS_Lib is ...@@ -490,7 +494,6 @@ package body System.OS_Lib is
C_To (C_To'Last) := ASCII.NUL; C_To (C_To'Last) := ASCII.NUL;
case Preserve is case Preserve is
when Time_Stamps => when Time_Stamps =>
if Copy_Attributes (C_From'Address, C_To'Address, 0) = -1 then if Copy_Attributes (C_From'Address, C_To'Address, 0) = -1 then
raise Copy_Error; raise Copy_Error;
...@@ -621,11 +624,55 @@ package body System.OS_Lib is ...@@ -621,11 +624,55 @@ package body System.OS_Lib is
Free (Ada_Pathname); Free (Ada_Pathname);
end Copy_File; 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 -- -- 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 begin
if Is_Regular_File (Source) and then Is_Writable_File (Dest) then if Is_Regular_File (Source) and then Is_Writable_File (Dest) then
declare declare
...@@ -652,8 +699,9 @@ package body System.OS_Lib is ...@@ -652,8 +699,9 @@ package body System.OS_Lib is
end Copy_Time_Stamps; end Copy_Time_Stamps;
procedure Copy_Time_Stamps procedure Copy_Time_Stamps
(Source, Dest : C_File_Name; (Source : C_File_Name;
Success : out Boolean) Dest : C_File_Name;
Success : out Boolean)
is is
Ada_Source : String_Access := Ada_Source : String_Access :=
To_Path_String_Access To_Path_String_Access
...@@ -726,10 +774,11 @@ package body System.OS_Lib is ...@@ -726,10 +774,11 @@ package body System.OS_Lib is
----------------------------- -----------------------------
function Create_Output_Text_File (Name : String) return File_Descriptor is function Create_Output_Text_File (Name : String) return File_Descriptor is
function C_Create_File function C_Create_File (Name : C_File_Name) return File_Descriptor;
(Name : C_File_Name) return File_Descriptor;
pragma Import (C, C_Create_File, "__gnat_create_output_file"); pragma Import (C, C_Create_File, "__gnat_create_output_file");
C_Name : String (1 .. Name'Length + 1); C_Name : String (1 .. Name'Length + 1);
begin begin
C_Name (1 .. Name'Length) := Name; C_Name (1 .. Name'Length) := Name;
C_Name (C_Name'Last) := ASCII.NUL; C_Name (C_Name'Last) := ASCII.NUL;
...@@ -801,10 +850,11 @@ package body System.OS_Lib is ...@@ -801,10 +850,11 @@ package body System.OS_Lib is
function Create_New_Output_Text_File function Create_New_Output_Text_File
(Name : String) return File_Descriptor (Name : String) return File_Descriptor
is is
function C_Create_File function C_Create_File (Name : C_File_Name) return File_Descriptor;
(Name : C_File_Name) return File_Descriptor;
pragma Import (C, C_Create_File, "__gnat_create_output_file_new"); pragma Import (C, C_Create_File, "__gnat_create_output_file_new");
C_Name : String (1 .. Name'Length + 1); C_Name : String (1 .. Name'Length + 1);
begin begin
C_Name (1 .. Name'Length) := Name; C_Name (1 .. Name'Length) := Name;
C_Name (C_Name'Last) := ASCII.NUL; C_Name (C_Name'Last) := ASCII.NUL;
...@@ -1036,9 +1086,9 @@ package body System.OS_Lib is ...@@ -1036,9 +1086,9 @@ package body System.OS_Lib is
procedure Get_Suffix_Ptr (Length, Ptr : Address); procedure Get_Suffix_Ptr (Length, Ptr : Address);
pragma Import (C, Get_Suffix_Ptr, "__gnat_get_debuggable_suffix_ptr"); pragma Import (C, Get_Suffix_Ptr, "__gnat_get_debuggable_suffix_ptr");
Suffix_Ptr : Address;
Suffix_Length : Integer;
Result : String_Access; Result : String_Access;
Suffix_Length : Integer;
Suffix_Ptr : Address;
begin begin
Get_Suffix_Ptr (Suffix_Length'Address, Suffix_Ptr'Address); Get_Suffix_Ptr (Suffix_Length'Address, Suffix_Ptr'Address);
...@@ -1059,9 +1109,9 @@ package body System.OS_Lib is ...@@ -1059,9 +1109,9 @@ package body System.OS_Lib is
procedure Get_Suffix_Ptr (Length, Ptr : Address); procedure Get_Suffix_Ptr (Length, Ptr : Address);
pragma Import (C, Get_Suffix_Ptr, "__gnat_get_executable_suffix_ptr"); pragma Import (C, Get_Suffix_Ptr, "__gnat_get_executable_suffix_ptr");
Suffix_Ptr : Address;
Suffix_Length : Integer;
Result : String_Access; Result : String_Access;
Suffix_Length : Integer;
Suffix_Ptr : Address;
begin begin
Get_Suffix_Ptr (Suffix_Length'Address, Suffix_Ptr'Address); Get_Suffix_Ptr (Suffix_Length'Address, Suffix_Ptr'Address);
...@@ -1082,9 +1132,9 @@ package body System.OS_Lib is ...@@ -1082,9 +1132,9 @@ package body System.OS_Lib is
procedure Get_Suffix_Ptr (Length, Ptr : Address); procedure Get_Suffix_Ptr (Length, Ptr : Address);
pragma Import (C, Get_Suffix_Ptr, "__gnat_get_object_suffix_ptr"); pragma Import (C, Get_Suffix_Ptr, "__gnat_get_object_suffix_ptr");
Suffix_Ptr : Address;
Suffix_Length : Integer;
Result : String_Access; Result : String_Access;
Suffix_Length : Integer;
Suffix_Ptr : Address;
begin begin
Get_Suffix_Ptr (Suffix_Length'Address, Suffix_Ptr'Address); Get_Suffix_Ptr (Suffix_Length'Address, Suffix_Ptr'Address);
...@@ -1106,8 +1156,8 @@ package body System.OS_Lib is ...@@ -1106,8 +1156,8 @@ package body System.OS_Lib is
pragma Import pragma Import
(C, Target_Exec_Ext_Ptr, "__gnat_target_debuggable_extension"); (C, Target_Exec_Ext_Ptr, "__gnat_target_debuggable_extension");
Suffix_Length : Integer;
Result : String_Access; Result : String_Access;
Suffix_Length : Integer;
begin begin
Suffix_Length := Integer (CRTL.strlen (Target_Exec_Ext_Ptr)); Suffix_Length := Integer (CRTL.strlen (Target_Exec_Ext_Ptr));
...@@ -1130,8 +1180,8 @@ package body System.OS_Lib is ...@@ -1130,8 +1180,8 @@ package body System.OS_Lib is
pragma Import pragma Import
(C, Target_Exec_Ext_Ptr, "__gnat_target_executable_extension"); (C, Target_Exec_Ext_Ptr, "__gnat_target_executable_extension");
Suffix_Length : Integer;
Result : String_Access; Result : String_Access;
Suffix_Length : Integer;
begin begin
Suffix_Length := Integer (CRTL.strlen (Target_Exec_Ext_Ptr)); Suffix_Length := Integer (CRTL.strlen (Target_Exec_Ext_Ptr));
...@@ -1154,8 +1204,8 @@ package body System.OS_Lib is ...@@ -1154,8 +1204,8 @@ package body System.OS_Lib is
pragma Import pragma Import
(C, Target_Object_Ext_Ptr, "__gnat_target_object_extension"); (C, Target_Object_Ext_Ptr, "__gnat_target_object_extension");
Suffix_Length : Integer;
Result : String_Access; Result : String_Access;
Suffix_Length : Integer;
begin begin
Suffix_Length := Integer (CRTL.strlen (Target_Object_Ext_Ptr)); Suffix_Length := Integer (CRTL.strlen (Target_Object_Ext_Ptr));
...@@ -1308,7 +1358,13 @@ package body System.OS_Lib is ...@@ -1308,7 +1358,13 @@ package body System.OS_Lib is
Second : out Second_Type) Second : out Second_Type)
is is
procedure To_GM_Time 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"); pragma Import (C, To_GM_Time, "__gnat_to_gm_time");
T : OS_Time := Date; T : OS_Time := Date;
...@@ -1325,8 +1381,13 @@ package body System.OS_Lib is ...@@ -1325,8 +1381,13 @@ package body System.OS_Lib is
Locked_Processing : begin Locked_Processing : begin
SSL.Lock_Task.all; SSL.Lock_Task.all;
To_GM_Time To_GM_Time
(T'Address, Y'Address, Mo'Address, D'Address, (P_Time_T => T'Address,
H'Address, Mn'Address, S'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; SSL.Unlock_Task.all;
exception exception
...@@ -1356,12 +1417,26 @@ package body System.OS_Lib is ...@@ -1356,12 +1417,26 @@ package body System.OS_Lib is
Second : Second_Type) return OS_Time Second : Second_Type) return OS_Time
is is
procedure To_OS_Time 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"); pragma Import (C, To_OS_Time, "__gnat_to_os_time");
Result : OS_Time; Result : OS_Time;
begin begin
To_OS_Time 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; return Result;
end GM_Time_Of; end GM_Time_Of;
...@@ -1644,9 +1719,10 @@ package body System.OS_Lib is ...@@ -1644,9 +1719,10 @@ package body System.OS_Lib is
(Program_Name : String; (Program_Name : String;
Args : Argument_List) return Process_Id Args : Argument_List) return Process_Id
is is
Pid : Process_Id;
Junk : Integer; Junk : Integer;
pragma Warnings (Off, Junk); pragma Warnings (Off, Junk);
Pid : Process_Id;
begin begin
Spawn_Internal (Program_Name, Args, Junk, Pid, Blocking => False); Spawn_Internal (Program_Name, Args, Junk, Pid, Blocking => False);
return Pid; return Pid;
...@@ -1658,9 +1734,9 @@ package body System.OS_Lib is ...@@ -1658,9 +1734,9 @@ package body System.OS_Lib is
Output_File_Descriptor : File_Descriptor; Output_File_Descriptor : File_Descriptor;
Err_To_Out : Boolean := True) return Process_Id Err_To_Out : Boolean := True) return Process_Id
is is
Saved_Output : File_Descriptor;
Saved_Error : File_Descriptor := Invalid_FD; -- prevent warning
Pid : Process_Id; Pid : Process_Id;
Saved_Error : File_Descriptor := Invalid_FD; -- prevent warning
Saved_Output : File_Descriptor;
begin begin
if Output_File_Descriptor = Invalid_FD then if Output_File_Descriptor = Invalid_FD then
...@@ -1717,8 +1793,9 @@ package body System.OS_Lib is ...@@ -1717,8 +1793,9 @@ package body System.OS_Lib is
return Invalid_Pid; return Invalid_Pid;
else else
Result := Non_Blocking_Spawn Result :=
(Program_Name, Args, Output_File_Descriptor, Err_To_Out); Non_Blocking_Spawn
(Program_Name, Args, Output_File_Descriptor, Err_To_Out);
-- Close the file just created for the output, as the file descriptor -- Close the file just created for the output, as the file descriptor
-- cannot be used anywhere, being a local value. It is safe to do -- cannot be used anywhere, being a local value. It is safe to do
...@@ -1737,15 +1814,14 @@ package body System.OS_Lib is ...@@ -1737,15 +1814,14 @@ package body System.OS_Lib is
Stdout_File : String; Stdout_File : String;
Stderr_File : String) return Process_Id Stderr_File : String) return Process_Id
is is
Stdout_FD : constant File_Descriptor :=
Create_Output_Text_File (Stdout_File);
Stderr_FD : constant File_Descriptor := Stderr_FD : constant File_Descriptor :=
Create_Output_Text_File (Stderr_File); Create_Output_Text_File (Stderr_File);
Stdout_FD : constant File_Descriptor :=
Create_Output_Text_File (Stdout_File);
Saved_Output : File_Descriptor; Result : Process_Id;
Saved_Error : File_Descriptor; Saved_Error : File_Descriptor;
Saved_Output : File_Descriptor;
Result : Process_Id;
begin begin
-- Do not attempt to spawn if the output files could not be created -- Do not attempt to spawn if the output files could not be created
...@@ -1784,7 +1860,6 @@ package body System.OS_Lib is ...@@ -1784,7 +1860,6 @@ package body System.OS_Lib is
------------------------- -------------------------
procedure Normalize_Arguments (Args : in out Argument_List) is procedure Normalize_Arguments (Args : in out Argument_List) is
procedure Quote_Argument (Arg : in out String_Access); procedure Quote_Argument (Arg : in out String_Access);
-- Add quote around argument if it contains spaces (or HT characters) -- Add quote around argument if it contains spaces (or HT characters)
...@@ -1797,9 +1872,9 @@ package body System.OS_Lib is ...@@ -1797,9 +1872,9 @@ package body System.OS_Lib is
-------------------- --------------------
procedure Quote_Argument (Arg : in out String_Access) is procedure Quote_Argument (Arg : in out String_Access) is
Res : String (1 .. Arg'Length * 2);
J : Positive := 1; J : Positive := 1;
Quote_Needed : Boolean := False; Quote_Needed : Boolean := False;
Res : String (1 .. Arg'Length * 2);
begin begin
if Arg (Arg'First) /= '"' or else Arg (Arg'Last) /= '"' then if Arg (Arg'First) /= '"' or else Arg (Arg'Last) /= '"' then
...@@ -1896,33 +1971,19 @@ package body System.OS_Lib is ...@@ -1896,33 +1971,19 @@ package body System.OS_Lib is
Resolve_Links : Boolean := True; Resolve_Links : Boolean := True;
Case_Sensitive : Boolean := True) return String Case_Sensitive : Boolean := True) return String
is is
Max_Path : Integer;
pragma Import (C, Max_Path, "__gnat_max_path_len");
-- Maximum length of a path name
procedure Get_Current_Dir procedure Get_Current_Dir
(Dir : System.Address; (Dir : System.Address;
Length : System.Address); Length : System.Address);
pragma Import (C, Get_Current_Dir, "__gnat_get_current_dir"); 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; function Get_File_Names_Case_Sensitive return Integer;
pragma Import pragma Import
(C, Get_File_Names_Case_Sensitive, (C, Get_File_Names_Case_Sensitive,
"__gnat_get_file_names_case_sensitive"); "__gnat_get_file_names_case_sensitive");
Fold_To_Lower_Case : constant Boolean := Max_Path : Integer;
not Case_Sensitive pragma Import (C, Max_Path, "__gnat_max_path_len");
and then Get_File_Names_Case_Sensitive = 0; -- Maximum length of a path name
function Readlink function Readlink
(Path : System.Address; (Path : System.Address;
...@@ -1936,9 +1997,9 @@ package body System.OS_Lib is ...@@ -1936,9 +1997,9 @@ package body System.OS_Lib is
(C, To_Canonical_File_Spec, "__gnat_to_canonical_file_spec"); (C, To_Canonical_File_Spec, "__gnat_to_canonical_file_spec");
-- Convert possible foreign file syntax to canonical form -- Convert possible foreign file syntax to canonical form
The_Name : String (1 .. Name'Length + 1); Fold_To_Lower_Case : constant Boolean :=
Canonical_File_Addr : System.Address; not Case_Sensitive
Canonical_File_Len : Integer; and then Get_File_Names_Case_Sensitive = 0;
function Final_Value (S : String) return String; function Final_Value (S : String) return String;
-- Make final adjustment to the returned string. This function strips -- Make final adjustment to the returned string. This function strips
...@@ -2052,6 +2113,22 @@ package body System.OS_Lib is ...@@ -2052,6 +2113,22 @@ package body System.OS_Lib is
end if; end if;
end Get_Directory; 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 -- Start of processing for Normalize_Pathname
begin begin
...@@ -2236,15 +2313,12 @@ package body System.OS_Lib is ...@@ -2236,15 +2313,12 @@ package body System.OS_Lib is
if Last = 1 then if Last = 1 then
return (1 => Directory_Separator); return (1 => Directory_Separator);
else else
if Fold_To_Lower_Case then if Fold_To_Lower_Case then
System.Case_Util.To_Lower (Path_Buffer (1 .. Last - 1)); System.Case_Util.To_Lower (Path_Buffer (1 .. Last - 1));
end if; end if;
return Path_Buffer (1 .. Last - 1); return Path_Buffer (1 .. Last - 1);
end if; end if;
else else
Path_Buffer (Last + 1 .. End_Path - 2) := Path_Buffer (Last + 1 .. End_Path - 2) :=
Path_Buffer (Last + 3 .. End_Path); Path_Buffer (Last + 3 .. End_Path);
...@@ -2294,9 +2368,11 @@ package body System.OS_Lib is ...@@ -2294,9 +2368,11 @@ package body System.OS_Lib is
begin begin
Path_Buffer (Finish + 1) := ASCII.NUL; Path_Buffer (Finish + 1) := ASCII.NUL;
Status := Readlink (Path_Buffer'Address, Status :=
Link_Buffer'Address, Readlink
Link_Buffer'Length); (Path => Path_Buffer'Address,
Buf => Link_Buffer'Address,
Bufsiz => Link_Buffer'Length);
Path_Buffer (Finish + 1) := Saved; Path_Buffer (Finish + 1) := Saved;
end; end;
...@@ -2631,9 +2707,10 @@ package body System.OS_Lib is ...@@ -2631,9 +2707,10 @@ package body System.OS_Lib is
(Program_Name : String; (Program_Name : String;
Args : Argument_List) return Integer Args : Argument_List) return Integer
is is
Result : Integer;
Junk : Process_Id; Junk : Process_Id;
pragma Warnings (Off, Junk); pragma Warnings (Off, Junk);
Result : Integer;
begin begin
Spawn_Internal (Program_Name, Args, Result, Junk, Blocking => True); Spawn_Internal (Program_Name, Args, Result, Junk, Blocking => True);
return Result; return Result;
...@@ -2655,8 +2732,8 @@ package body System.OS_Lib is ...@@ -2655,8 +2732,8 @@ package body System.OS_Lib is
Return_Code : out Integer; Return_Code : out Integer;
Err_To_Out : Boolean := True) Err_To_Out : Boolean := True)
is is
Saved_Output : File_Descriptor;
Saved_Error : File_Descriptor := Invalid_FD; -- prevent compiler warning Saved_Error : File_Descriptor := Invalid_FD; -- prevent compiler warning
Saved_Output : File_Descriptor;
begin begin
-- Set standard output and error to the temporary file -- Set standard output and error to the temporary file
...@@ -2727,7 +2804,6 @@ package body System.OS_Lib is ...@@ -2727,7 +2804,6 @@ package body System.OS_Lib is
Pid : out Process_Id; Pid : out Process_Id;
Blocking : Boolean) Blocking : Boolean)
is is
procedure Spawn (Args : Argument_List); procedure Spawn (Args : Argument_List);
-- Call Spawn with given argument list -- Call Spawn with given argument list
...@@ -2742,8 +2818,8 @@ package body System.OS_Lib is ...@@ -2742,8 +2818,8 @@ package body System.OS_Lib is
type Chars is array (Positive range <>) of aliased Character; type Chars is array (Positive range <>) of aliased Character;
type Char_Ptr is access constant Character; type Char_Ptr is access constant Character;
Command_Len : constant Positive := Program_Name'Length + 1 Command_Len : constant Positive := Program_Name'Length + 1 +
+ Args_Length (Args); Args_Length (Args);
Command_Last : Natural := 0; Command_Last : Natural := 0;
Command : aliased Chars (1 .. Command_Len); Command : aliased Chars (1 .. Command_Len);
-- Command contains all characters of the Program_Name and Args, all -- Command contains all characters of the Program_Name and Args, all
......
gcc/ada/s-os_lib.ads
...@@ -66,14 +66,14 @@ package System.OS_Lib is ...@@ -66,14 +66,14 @@ package System.OS_Lib is
subtype String_Access is Strings.String_Access; 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."="; renames Strings."=";
procedure Free (X : in out String_Access) renames Strings.Free; procedure Free (X : in out String_Access) renames Strings.Free;
subtype String_List is Strings.String_List; 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."="; renames Strings."=";
function "&" (Left : String_Access; Right : String_Access) function "&" (Left : String_Access; Right : String_Access)
...@@ -87,11 +87,11 @@ package System.OS_Lib is ...@@ -87,11 +87,11 @@ package System.OS_Lib is
subtype String_List_Access is Strings.String_List_Access; subtype String_List_Access is Strings.String_List_Access;
function "=" (Left, Right : String_List_Access) return Boolean function "="
renames Strings."="; (Left : String_List_Access;
Right : String_List_Access) return Boolean renames Strings."=";
procedure Free (Arg : in out String_List_Access) procedure Free (Arg : in out String_List_Access) renames Strings.Free;
renames Strings.Free;
--------------------- ---------------------
-- Time/Date Stuff -- -- Time/Date Stuff --
...@@ -110,6 +110,14 @@ package System.OS_Lib is ...@@ -110,6 +110,14 @@ package System.OS_Lib is
Invalid_Time : constant OS_Time; Invalid_Time : constant OS_Time;
-- A special unique value used to flag an invalid time stamp value -- 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 Year_Type is Integer range 1900 .. 2099;
subtype Month_Type is Integer range 1 .. 12; subtype Month_Type is Integer range 1 .. 12;
subtype Day_Type is Integer range 1 .. 31; subtype Day_Type is Integer range 1 .. 31;
...@@ -121,6 +129,10 @@ package System.OS_Lib is ...@@ -121,6 +129,10 @@ package System.OS_Lib is
function Current_Time return OS_Time; function Current_Time return OS_Time;
-- Return the system clock value as 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_Year (Date : OS_Time) return Year_Type;
function GM_Month (Date : OS_Time) return Month_Type; function GM_Month (Date : OS_Time) return Month_Type;
function GM_Day (Date : OS_Time) return Day_Type; function GM_Day (Date : OS_Time) return Day_Type;
...@@ -129,14 +141,6 @@ package System.OS_Lib is ...@@ -129,14 +141,6 @@ package System.OS_Lib is
function GM_Second (Date : OS_Time) return Second_Type; function GM_Second (Date : OS_Time) return Second_Type;
-- Functions to extract information from OS_Time value in GMT form -- 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 procedure GM_Split
(Date : OS_Time; (Date : OS_Time;
Year : out Year_Type; Year : out Year_Type;
...@@ -160,10 +164,6 @@ package System.OS_Lib is ...@@ -160,10 +164,6 @@ package System.OS_Lib is
-- component parts to be interpreted in the local time zone, and returns -- component parts to be interpreted in the local time zone, and returns
-- an OS_Time. Returns Invalid_Time if the creation fails. -- 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 -- -- File Stuff --
---------------- ----------------
...@@ -191,6 +191,87 @@ package System.OS_Lib is ...@@ -191,6 +191,87 @@ package System.OS_Lib is
Invalid_FD : constant File_Descriptor := -1; Invalid_FD : constant File_Descriptor := -1;
-- File descriptor returned when error in opening/creating file -- 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); type Mode is (Binary, Text);
for Mode'Size use Integer'Size; for Mode'Size use Integer'Size;
for Mode use (Binary => 0, Text => 1); for Mode use (Binary => 0, Text => 1);
...@@ -202,26 +283,6 @@ package System.OS_Lib is ...@@ -202,26 +283,6 @@ package System.OS_Lib is
-- of Text where appropriate allows programs to take a portable Unix view -- of Text where appropriate allows programs to take a portable Unix view
-- of DOS-format files and process them appropriately. -- 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 function Create_File
(Name : String; (Name : String;
Fmode : Mode) return File_Descriptor; Fmode : Mode) return File_Descriptor;
...@@ -230,11 +291,6 @@ package System.OS_Lib is ...@@ -230,11 +291,6 @@ package System.OS_Lib is
-- overwritten. File descriptor returned is Invalid_FD if file cannot be -- overwritten. File descriptor returned is Invalid_FD if file cannot be
-- successfully created. -- 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 function Create_New_File
(Name : String; (Name : String;
Fmode : Mode) return File_Descriptor; Fmode : Mode) return File_Descriptor;
...@@ -243,6 +299,11 @@ package System.OS_Lib is ...@@ -243,6 +299,11 @@ package System.OS_Lib is
-- that it fails if the file already exists. File descriptor returned is -- that it fails if the file already exists. File descriptor returned is
-- Invalid_FD if the file exists or cannot be created. -- 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; Temp_File_Len : constant Integer := 12;
-- Length of name returned by Create_Temp_File call (GNAT-XXXXXX & NUL) -- Length of name returned by Create_Temp_File call (GNAT-XXXXXX & NUL)
...@@ -296,148 +357,17 @@ package System.OS_Lib is ...@@ -296,148 +357,17 @@ package System.OS_Lib is
-- There is no race condition problem between processes trying to create -- There is no race condition problem between processes trying to 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);
-- 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); 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
-- successful. -- successful.
procedure Rename_File function File_Length (FD : File_Descriptor) return Long_Integer;
(Old_Name : String; pragma Import (C, File_Length, "__gnat_file_length_long");
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).
type Large_File_Size is range -2**63 .. 2**63 - 1; type Large_File_Size is range -2**63 .. 2**63 - 1;
-- Maximum supported size for a file (8 exabytes = 8 million terabytes, -- Maximum supported size for a file (8 exabytes = 8 million terabytes,
-- should be enough to accomodate all possible needs for quite a while). -- 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; function File_Length64 (FD : File_Descriptor) return Large_File_Size;
pragma Import (C, File_Length64, "__gnat_file_length"); pragma Import (C, File_Length64, "__gnat_file_length");
-- Get length of file from file descriptor FD -- Get length of file from file descriptor FD
...@@ -451,73 +381,42 @@ package System.OS_Lib is ...@@ -451,73 +381,42 @@ package System.OS_Lib is
-- Get time stamp of file from file descriptor FD Returns Invalid_Time is -- Get time stamp of file from file descriptor FD Returns Invalid_Time is
-- FD doesn't correspond to an existing file. -- FD doesn't correspond to an existing file.
function Normalize_Pathname function Get_Debuggable_Suffix return String_Access;
(Name : String; -- Return the debuggable suffix convention. Usually this is the same as
Directory : String := ""; -- the convention for Get_Executable_Suffix. The result is allocated on
Resolve_Links : Boolean := True; -- the heap and should be freed after use to avoid storage leaks.
Case_Sensitive : Boolean := True) return String;
-- Returns a file name as an absolute path name, resolving all relative function Get_Executable_Suffix return String_Access;
-- directories, and symbolic links. The parameter Directory is a fully -- Return the executable suffix convention. The result is allocated on the
-- resolved path name for a directory, or the empty string (the default). -- heap and should be freed after use to avoid storage leaks.
-- Name is the name of a file, which is either relative to the given
-- directory name, if Directory is non-null, or to the current working function Get_Object_Suffix return String_Access;
-- directory if Directory is null. The result returned is the normalized -- Return the object suffix convention. The result is allocated on the heap
-- name of the file. For most cases, if two file names designate the same -- and should be freed after use to avoid storage leaks.
-- file through different paths, Normalize_Pathname will return the same
-- canonical name in both cases. However, there are cases when this is not function Get_Target_Debuggable_Suffix return String_Access;
-- true; for example, this is not true in Unix for two hard links -- Return the target debuggable suffix convention. Usually this is the same
-- designating the same file. -- as the convention for Get_Executable_Suffix. The result is allocated on
-- -- the heap and should be freed after use to avoid storage leaks.
-- On Windows, the returned path will start with a drive letter except
-- when Directory is not empty and does not include a drive letter. If function Get_Target_Executable_Suffix return String_Access;
-- Directory is empty (the default) and Name is a relative path or an -- Return the target executable suffix convention. The result is allocated
-- absolute path without drive letter, the letter of the current drive -- on the heap and should be freed after use to avoid storage leaks.
-- will start the returned path. If Case_Sensitive is True (the default),
-- then this drive letter will be forced to upper case ("C:\..."). function Get_Target_Object_Suffix return String_Access;
-- -- Return the target object suffix convention. The result is allocated on
-- If Resolve_Links is set to True, then the symbolic links, on systems -- the heap and should be freed after use to avoid storage leaks.
-- that support them, will be fully converted to the name of the file or
-- directory pointed to. This is slightly less efficient, since it
-- requires system calls.
--
-- If Name cannot be resolved, is invalid (for example if it is too big) or
-- is null on entry (for example if there is symbolic link circularity,
-- e.g. A is a symbolic link for B, and B is a symbolic link for A), then
-- Normalize_Pathname returns an empty string.
--
-- For case-sensitive file systems, the value of Case_Sensitive parameter
-- is ignored. For file systems that are not case-sensitive, such as
-- Windows, if this parameter is set to False, then the file and directory
-- names are folded to lower case. This allows checking whether two files
-- are the same by applying this function to their names and comparing the
-- 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; function Is_Absolute_Path (Name : String) return Boolean;
-- Returns True if Name is an absolute path name, i.e. it designates a -- Returns True if Name is an absolute path name, i.e. it designates a
-- file or directory absolutely rather than relative to another directory. -- 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; function Is_Directory (Name : String) return Boolean;
-- Determines if the given string, Name, is the name of a directory. -- Determines if the given string, Name, is the name of a directory.
-- Returns True if so, False otherwise. Name may be an absolute path -- 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 -- 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. -- a relative path name, it is relative to the current working directory.
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_Executable_File (Name : String) return Boolean; function Is_Executable_File (Name : String) return Boolean;
-- Determines if the given string, Name, is the name of an existing file -- 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 -- that is executable. Returns True if so, False otherwise. Note that this
...@@ -526,14 +425,21 @@ package System.OS_Lib is ...@@ -526,14 +425,21 @@ package System.OS_Lib is
-- not actually be readable due to some other process having exclusive -- not actually be readable due to some other process having exclusive
-- access. -- access.
function Is_Writable_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 file -- 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 -- that is readable. Returns True if so, False otherwise. Note that this
-- function simply interrogates the file attributes (e.g. using the C -- 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 -- 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 -- not actually be readable due to some other process having exclusive
-- access. -- 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; function Is_Symbolic_Link (Name : String) return Boolean;
-- Determines if the given string, Name, is the path of a symbolic link on -- 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 -- systems that support it. Returns True if so, False if the path is not a
...@@ -543,38 +449,15 @@ package System.OS_Lib is ...@@ -543,38 +449,15 @@ package System.OS_Lib is
-- 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
-- span file systems and may refer to directories. -- span file systems and may refer to directories.
procedure Set_Writable (Name : String); function Is_Writable_File (Name : String) return Boolean;
-- Change permissions on the named file to make it writable for its owner -- 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
procedure Set_Non_Writable (Name : String); -- function simply interrogates the file attributes (e.g. using the C
-- Change permissions on the named file to make it non-writable for its -- function stat), so it does not indicate a situation in which a file may
-- owner. The readable and executable permissions are not modified. -- not actually be writeable due to some other process having exclusive
-- access.
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).
S_Owner : constant := 1;
S_Group : constant := 2;
S_Others : constant := 4;
-- Constants for use in Mode parameter to Set_Executable
procedure Set_Executable (Name : String; Mode : Positive := S_Owner);
-- Change permissions on the file given by Name to make it executable
-- 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_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 function Locate_Exec_On_Path (Exec_Name : String) return String_Access;
(Exec_Name : String) return String_Access;
-- Try to locate an executable whose name is given by Exec_Name in the -- 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 -- directories listed in the environment Path. If the Exec_Name does not
-- have the executable suffix, it will be appended before the search. -- have the executable suffix, it will be appended before the search.
...@@ -602,31 +485,159 @@ package System.OS_Lib is ...@@ -602,31 +485,159 @@ package System.OS_Lib is
-- 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.
function Get_Debuggable_Suffix return String_Access; Seek_Cur : constant := 1;
-- Return the debuggable suffix convention. Usually this is the same as Seek_End : constant := 2;
-- the convention for Get_Executable_Suffix. The result is allocated on Seek_Set : constant := 0;
-- the heap and should be freed after use to avoid storage leaks. -- Used to indicate origin for Lseek call
function Get_Target_Debuggable_Suffix return String_Access; procedure Lseek
-- Return the target debuggable suffix convention. Usually this is the same (FD : File_Descriptor;
-- as the convention for Get_Executable_Suffix. The result is allocated on offset : Long_Integer;
-- the heap and should be freed after use to avoid storage leaks. 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 Get_Executable_Suffix return String_Access; function Normalize_Pathname
-- Return the executable suffix convention. The result is allocated on the (Name : String;
-- heap and should be freed after use to avoid storage leaks. Directory : String := "";
Resolve_Links : Boolean := True;
Case_Sensitive : Boolean := True) return String;
-- Returns a file name as an absolute path name, resolving all relative
-- directories, and symbolic links. The parameter Directory is a fully
-- resolved path name for a directory, or the empty string (the default).
-- Name is the name of a file, which is either relative to the given
-- directory name, if Directory is non-null, or to the current working
-- 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
-- file through different paths, Normalize_Pathname will return the same
-- canonical name in both cases. However, there are cases when this is not
-- true; for example, this is not true in Unix for two hard links
-- designating the same file.
--
-- On Windows, the returned path will start with a drive letter except
-- when Directory is not empty and does not include a drive letter. If
-- Directory is empty (the default) and Name is a relative path or an
-- absolute path without drive letter, the letter of the current drive
-- will start the returned path. If Case_Sensitive is True (the default),
-- then this drive letter will be forced to upper case ("C:\...").
--
-- 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 or
-- directory pointed to. This is slightly less efficient, since it
-- requires system calls.
--
-- If Name cannot be resolved, is invalid (for example if it is too big) or
-- is null on entry (for example if there is symbolic link circularity,
-- e.g. A is a symbolic link for B, and B is a symbolic link for A), then
-- Normalize_Pathname returns an empty string.
--
-- For case-sensitive file systems, the value of Case_Sensitive parameter
-- is ignored. For file systems that are not case-sensitive, such as
-- Windows, if this parameter is set to False, then the file and directory
-- names are folded to lower case. This allows checking whether two files
-- are the same by applying this function to their names and comparing the
-- results. If Case_Sensitive is set to True, this function does not change
-- the casing of file and directory names.
function Get_Object_Suffix return String_Access; function Open_Append
-- Return the object suffix convention. The result is allocated on the heap (Name : String;
-- and should be freed after use to avoid storage leaks. 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 Get_Target_Executable_Suffix return String_Access; function Open_Read
-- Return the target executable suffix convention. The result is allocated (Name : String;
-- on the heap and should be freed after use to avoid storage leaks. 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 Get_Target_Object_Suffix return String_Access; function Open_Read_Write
-- Return the target object suffix convention. The result is allocated on (Name : String;
-- the heap and should be freed after use to avoid storage leaks. 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 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.
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.
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;
S_Others : constant := 4;
-- Constants for use in Mode parameter to Set_Executable
procedure Set_Executable (Name : String; Mode : Positive := S_Owner);
-- Change permissions on the file given by Name to make it executable
-- 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_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.
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.
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_Readable (Name : String);
-- Change permissions on the named file to make it readable for its
-- owner.
procedure Set_Writable (Name : String);
-- Change permissions on the named file to make it writable for its owner
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 -- The following section contains low-level routines using addresses to
-- pass file name and executable name. In each routine the name must be -- pass file name and executable name. In each routine the name must be
...@@ -639,17 +650,17 @@ package System.OS_Lib is ...@@ -639,17 +650,17 @@ package System.OS_Lib is
-- All the following functions need comments ??? -- All the following functions need comments ???
function Open_Read procedure Copy_File
(Name : C_File_Name; (Name : C_File_Name;
Fmode : Mode) return File_Descriptor; Pathname : C_File_Name;
Success : out Boolean;
function Open_Read_Write Mode : Copy_Mode := Copy;
(Name : C_File_Name; Preserve : Attribute := Time_Stamps);
Fmode : Mode) return File_Descriptor;
function Open_Append procedure Copy_Time_Stamps
(Name : C_File_Name; (Source : C_File_Name;
Fmode : Mode) return File_Descriptor; Dest : C_File_Name;
Success : out Boolean);
function Create_File function Create_File
(Name : C_File_Name; (Name : C_File_Name;
...@@ -661,36 +672,37 @@ package System.OS_Lib is ...@@ -661,36 +672,37 @@ package System.OS_Lib is
procedure Delete_File (Name : C_File_Name; Success : out Boolean); 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);
procedure Copy_File
(Name : C_File_Name;
Pathname : C_File_Name;
Success : out Boolean;
Mode : Copy_Mode := Copy;
Preserve : Attribute := Time_Stamps);
procedure Copy_Time_Stamps
(Source, Dest : C_File_Name;
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_Directory (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_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_Symbolic_Link (Name : C_File_Name) return Boolean;
function Is_Writable_File (Name : C_File_Name) return Boolean;
function Locate_Regular_File function Locate_Regular_File
(File_Name : C_File_Name; (File_Name : C_File_Name;
Path : C_File_Name) return String_Access; 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 -- -- Subprocesses --
------------------ ------------------
...@@ -705,6 +717,84 @@ package System.OS_Lib is ...@@ -705,6 +717,84 @@ package System.OS_Lib is
-- Note that there is a Free procedure declared for this subtype which -- Note that there is a Free procedure declared for this subtype which
-- frees the array and all referenced strings. -- 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); procedure Normalize_Arguments (Args : in out Argument_List);
-- Normalize all arguments in the list. This ensure that the 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 -- is compatible with the running OS and will works fine with Spawn and
...@@ -717,6 +807,10 @@ package System.OS_Lib is ...@@ -717,6 +807,10 @@ package System.OS_Lib is
-- individual referenced arguments in Argument_List are on the heap, and -- individual referenced arguments in Argument_List are on the heap, and
-- may free them and reallocate if they are modified. -- 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 procedure Spawn
(Program_Name : String; (Program_Name : String;
Args : Argument_List; Args : Argument_List;
...@@ -795,73 +889,6 @@ package System.OS_Lib is ...@@ -795,73 +889,6 @@ package System.OS_Lib is
-- Spawning processes from tasking programs is not recommended. See -- Spawning processes from tasking programs is not recommended. See
-- "NOTE: Spawn in tasking programs" below. -- "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); 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 of -- calls to Non_Blocking_Spawn. The caller will be suspended until one of
...@@ -876,21 +903,6 @@ package System.OS_Lib is ...@@ -876,21 +903,6 @@ package System.OS_Lib is
-- 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.
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 -- -- NOTE: Spawn in Tasking Programs --
------------------------------------- -------------------------------------
...@@ -960,6 +972,17 @@ package System.OS_Lib is ...@@ -960,6 +972,17 @@ package System.OS_Lib is
-- Miscellaneous -- -- 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; function Getenv (Name : String) return String_Access;
-- Get the value of the environment variable. Returns an access to the -- Get the value of the environment variable. Returns an access to the
-- empty string if the environment variable does not exist or has an -- empty string if the environment variable does not exist or has an
...@@ -969,16 +992,12 @@ package System.OS_Lib is ...@@ -969,16 +992,12 @@ package System.OS_Lib is
-- case), and needs to be freed explicitly when no longer needed to avoid -- case), and needs to be freed explicitly when no longer needed to avoid
-- memory leaks. -- memory leaks.
procedure Setenv (Name : String; Value : String); procedure OS_Abort;
-- Set the value of the environment variable Name to Value. This call pragma Import (C, OS_Abort, "abort");
-- modifies the current environment, but does not modify the parent pragma No_Return (OS_Abort);
-- process environment. After a call to Setenv, Getenv (Name) will always -- Exit to OS signalling an abort (traceback or other appropriate
-- return a String_Access referencing the same String as Value. This is -- diagnostic information should be given if possible, or entry made to
-- true also for the null string case (the actual effect may be to either -- the debugger if that is possible).
-- 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_Exit (Status : Integer); procedure OS_Exit (Status : Integer);
pragma No_Return (OS_Exit); pragma No_Return (OS_Exit);
...@@ -999,27 +1018,20 @@ package System.OS_Lib is ...@@ -999,27 +1018,20 @@ package System.OS_Lib is
-- change the implementation of OS_Exit by redirecting OS_Exit_Ptr to an -- change the implementation of OS_Exit by redirecting OS_Exit_Ptr to an
-- other implementation. -- 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); 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
function Errno_Message procedure Setenv (Name : String; Value : String);
(Err : Integer := Errno; -- Set the value of the environment variable Name to Value. This call
Default : String := "") return String; -- modifies the current environment, but does not modify the parent
-- Return a message describing the given Errno value. If none is provided -- process environment. After a call to Setenv, Getenv (Name) will always
-- by the system, return Default if not empty, else return a generic -- return a String_Access referencing the same String as Value. This is
-- message indicating the numeric errno value. -- 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; 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
......
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