From: Arnaud Charlet Date: Tue, 27 Oct 2015 11:56:12 +0000 (+0100) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=2f97d24cad349a09ee1beb3e20b636925aa9baa9;p=gcc.git [multiple changes] 2015-10-27 Tristan Gingold * 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 * adaint.c, s-os_lib.adb, s-os_lib.ads (Copy_File_Attributes): New subprogram. From-SVN: r229429 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d11df2e8114..0065f944087 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2015-10-27 Tristan Gingold + + * 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 + + * adaint.c, s-os_lib.adb, s-os_lib.ads (Copy_File_Attributes): New + subprogram. + 2015-10-27 Hristian Kirtchev * namet.adb, namet.ads: Minor reformatting. diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index df6dbffaadf..5fef49cc4c0 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -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,39 +2923,46 @@ __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); - /* retrieve from times */ + /* Do we need to copy the timestamp ? */ - hfrom = CreateFile - (wfrom, GENERIC_READ, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); + if (mode != 2) { + /* retrieve from times */ - if (hfrom == INVALID_HANDLE_VALUE) - return -1; + hfrom = CreateFile + (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) - return -1; + CloseHandle (hfrom); - /* retrieve from times */ + if (res == 0) + return -1; - hto = CreateFile - (wto, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); + /* retrieve from times */ - if (hto == INVALID_HANDLE_VALUE) - return -1; + hto = CreateFile + (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) - return -1; + CloseHandle (hto); + 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) - { - return -1; - } + if (GNAT_STAT (from, &fbuf) == -1) { + return -1; + } - tbuf.actime = fbuf.st_atime; - tbuf.modtime = fbuf.st_mtime; + /* Do we need to copy timestamp ? */ + if (mode != 2) { + tbuf.actime = fbuf.st_atime; + tbuf.modtime = fbuf.st_mtime; - if (utime (to, &tbuf) == -1) - { - return -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 diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index e284a0e130b..098a1aeab14 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -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; diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb index 02efbd71406..dad157861da 100644 --- a/gcc/ada/s-os_lib.adb +++ b/gcc/ada/s-os_lib.adb @@ -55,11 +55,13 @@ package body System.OS_Lib is pragma Import (C, Dup2, "__gnat_dup2"); function Copy_Attributes - (From, To : System.Address; - Mode : Integer) return Integer; + (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,8 +699,9 @@ package body System.OS_Lib is end Copy_Time_Stamps; procedure Copy_Time_Stamps - (Source, Dest : C_File_Name; - Success : out Boolean) + (Source : C_File_Name; + Dest : C_File_Name; + Success : out Boolean) is Ada_Source : String_Access := To_Path_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,8 +1793,9 @@ package body System.OS_Lib is return Invalid_Pid; else - Result := Non_Blocking_Spawn - (Program_Name, Args, Output_File_Descriptor, Err_To_Out); + 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 -- cannot be used anywhere, being a local value. It is safe to do @@ -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); + 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; - - Result : Process_Id; + 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 diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads index 4c03c700f5a..dcc1deab687 100644 --- a/gcc/ada/s-os_lib.ads +++ b/gcc/ada/s-os_lib.ads @@ -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,73 +381,42 @@ 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 := ""; - 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_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_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 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; -- 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 @@ -526,14 +425,21 @@ package System.OS_Lib is -- not actually be readable due to some other process having exclusive -- 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 - -- 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 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. + 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 @@ -543,38 +449,15 @@ package System.OS_Lib is -- 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 - - 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). - - 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 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; + 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. @@ -602,31 +485,159 @@ package System.OS_Lib is -- 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. + Seek_Cur : constant := 1; + Seek_End : constant := 2; + Seek_Set : constant := 0; + -- Used to indicate origin for Lseek call - 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 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 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 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 + -- 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; - -- Return the object suffix convention. The result is allocated on the heap - -- and should be freed after use to avoid storage leaks. + 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 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 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 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 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 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 -- pass file name and executable name. In each routine the name must be @@ -639,17 +650,17 @@ package System.OS_Lib is -- 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; + procedure Copy_File + (Name : C_File_Name; + Pathname : C_File_Name; + Success : out Boolean; + Mode : Copy_Mode := Copy; + Preserve : Attribute := Time_Stamps); - function Open_Append - (Name : C_File_Name; - Fmode : Mode) return File_Descriptor; + procedure Copy_Time_Stamps + (Source : C_File_Name; + Dest : C_File_Name; + Success : out Boolean); function Create_File (Name : C_File_Name; @@ -661,36 +672,37 @@ package System.OS_Lib is 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; -- 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