------------------------------------------------------------------------------ -- -- -- GPR PROJECT MANAGER -- -- -- -- Copyright (C) 2012-2021, Free Software Foundation, Inc. -- -- -- -- This library is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 3, or (at your option) any later -- -- version. This library is distributed in the hope that it will be useful, -- -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- -- As a special exception under Section 7 of GPL version 3, you are granted -- -- additional permissions described in the GCC Runtime Library Exception, -- -- version 3.1, as published by the Free Software Foundation. -- -- -- -- You should have received a copy of the GNU General Public License and -- -- a copy of the GCC Runtime Library Exception along with this program; -- -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- . -- -- -- ------------------------------------------------------------------------------ with Ada.Calendar; use Ada.Calendar; with Ada.Directories; use Ada.Directories; with Ada.Exceptions; use Ada.Exceptions; with Ada.Numerics.Float_Random; use Ada.Numerics.Float_Random; with Ada.Strings.Fixed; use Ada.Strings.Fixed; with Ada.Strings.Maps.Constants; use Ada.Strings; with Ada.Text_IO; use Ada.Text_IO; with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNAT.Sockets; use GNAT; use GNAT.Sockets; with GNAT.String_Split; use GNAT.String_Split; with GPR.Compilation.Process; with GPR.Conf; with GPR.Names; use GPR.Names; with GPR.Opt; use GPR.Opt; with GPR.Snames; use GPR.Snames; package body GPR.Compilation.Slave is type Slave is record Sock : Integer; Data : Slave_Data; Channel : Communication_Channel; Current : Natural := 0; Max_Processes : Positive := 1; Root_Dir : Unbounded_String; Rsync_Pid : Process_Id; end record; function "<" (K1, K2 : Slave) return Boolean is (K1.Sock < K2.Sock); function "=" (K1, K2 : Slave) return Boolean is (K1.Sock = K2.Sock); No_Slave : constant Slave := (-1, No_Slave_Data, Current => Natural'Last, others => <>); package Slave_S is new Containers.Ordered_Sets (Slave); -- The key is the C socket number function Connect_Slave (S_Data : Slave_Data; Project_Name : String; Sync : Boolean; Included_Artifact_Patterns : String := "") return Slave; -- Connect to the slave and return the corresponding object function Parse (Host_Name : String) return Slave_Data; -- Parse a host[:port] string and returns corresponding Slave_Data record -- Ack transient signal stored into this variable protected Wait_Ack is procedure Set (Pid : Remote_Id); entry Get (Pid : out Remote_Id); private Is_Set : Boolean := False; Id : Remote_Id; end Wait_Ack; task type Wait_Remote; -- Wait for incoming data from all registered slaves type Wait_Remote_Ref is access Wait_Remote; WR : Wait_Remote_Ref; -- Will be initialized only if the distributed mode is activated Compiler_Path : constant OS_Lib.String_Access := Locate_Exec_On_Path ("gnatls"); Remote_Process : Shared_Counter; Slaves_Sockets : Socket_Set_Type; Max_Processes : Natural := 0; R_Gen : Generator; protected Slaves is procedure Insert (S : Slave); -- Add a slave into the pool function Find (Socket : Integer) return Slave; -- Find a slave given the socket number function Find (Host : String) return Slave; -- Find a slave give a host[:port] name function Get_Free return Slave; -- Returns a slave with free compilation slot function Count return Natural; -- Returns the number of registered slaves procedure Increment_Current (S : in out Slave); -- Increment the number of processes handled by slave procedure Decrement_Current (S : in out Slave); -- Decrement the number of processes handled by slave procedure Set_Rewrite_CD (S : in out Slave; Path : String); -- Record rewriting of the compiler directory procedure Set_Rewrite_WD (S : in out Slave; Path : String); -- Record rewriting of the wording directory procedure Iterate (Proc : access procedure (S : in out Slave)); -- Iterate over all slaves in the pool and call proc procedure Clear; -- Clear the pool private Pool : Slave_S.Set; end Slaves; ------------- -- Channel -- ------------- function Channel (Host : String) return Protocol.Communication_Channel is S : constant Slave := Slaves.Find (Host); begin if S = No_Slave then return No_Channel; else return S.Channel; end if; end Channel; ---------------------------- -- Clean_Up_Remote_Slaves -- ---------------------------- procedure Clean_Up_Remote_Slaves (Tree : Project_Tree_Ref; Project : Project_Id) is pragma Unreferenced (Tree); procedure Clean_Up_Remote_Slave (S_Data : Slave_Data; Project_Name : String); -- Clean-up slave --------------------------- -- Clean_Up_Remote_Slave -- --------------------------- procedure Clean_Up_Remote_Slave (S_Data : Slave_Data; Project_Name : String) is S : Slave; begin S := Connect_Slave (S_Data, Project_Name, Sync => False); -- Send the clean-up request Protocol.Send_Clean_Up (S.Channel, Project_Name); declare Cmd : constant Command := Get_Command (S.Channel); begin if Kind (Cmd) = OK then if Opt.Verbosity_Level > Opt.Low then Put_Line ("Clean-up done on " & To_String (S_Data.Host)); end if; elsif Kind (Cmd) = KO then Put_Line ("Slave cannot clean-up " & To_String (S_Data.Host)); OS_Exit (1); else Put_Line ("protocol error: " & Command_Kind'Image (Kind (Cmd))); OS_Exit (1); end if; end; Protocol.Send_End_Of_Compilation (S.Channel); -- Wait for acknowledge to ensure the clean-up is terminated on the -- slave. declare Cmd : constant Command := Get_Command (S.Channel) with Unreferenced; begin null; end; Close (S.Channel); exception when others => Close (S.Channel); end Clean_Up_Remote_Slave; begin for S of Slaves_Data loop Clean_Up_Remote_Slave (S, Get_Name_String (Project.Name)); end loop; end Clean_Up_Remote_Slaves; ------------------- -- Connect_Slave -- ------------------- function Connect_Slave (S_Data : Slave_Data; Project_Name : String; Sync : Boolean; Included_Artifact_Patterns : String := "") return Slave is Address : Sock_Addr_Type; Sock : Socket_Type; S : Slave; Status : Selector_Status; begin S.Data := S_Data; if S.Data.Host = Null_Unbounded_String then Put_Line ("A slave must have a name, aborting"); OS_Exit (1); end if; Address.Addr := Addresses (Get_Host_By_Name (To_String (S.Data.Host)), 1); Address.Port := S_Data.Port; Create_Socket (Sock); Set_Socket_Option (Sock, Socket_Level, (Reuse_Address, True)); begin Connect_Socket (Sock, Address, Timeout => 2.0, Status => Status); exception when Socket_Error => Put_Line ("Cannot connect to slave " & To_String (S.Data.Host) & ", aborting"); raise; end; if Status in Expired .. Aborted then Put_Line ("Cannot connect to slave " & To_String (S.Data.Host) & ", aborting"); OS_Exit (1); end if; S.Channel := Create (Sock); -- Do initial handshake Protocol.Send_Context (S.Channel, Get_Target, Project_Name, Slave_Env.all, Sync, (if Hash_Value = null then "" else Hash_Value.all), Included_Artifact_Patterns); declare Cmd : constant Command := Get_Command (S.Channel); Parameters : constant Argument_List_Access := Args (Cmd); begin if Kind (Cmd) = OK and then Parameters'Length = 3 then S.Max_Processes := Natural'Value (Parameters (1).all); S.Root_Dir := To_Unbounded_String (Parameters (2).all); if not Boolean'Value (Parameters (3).all) then Put_Line ("warning: non synchronized clock detected for " & To_String (S.Data.Host)); end if; elsif Kind (Cmd) = KO then Put_Line ((if Parameters'Length = 1 and then Parameters (1).all /= "" then Parameters (1).all else "build slave is not compatible") & " : " & To_String (S.Data.Host)); OS_Exit (1); else Put_Line ("protocol error: " & Command_Kind'Image (Kind (Cmd))); OS_Exit (1); end if; end; return S; end Connect_Slave; ----------------------- -- Get_Max_Processes -- ----------------------- function Get_Max_Processes return Natural is begin return Max_Processes; end Get_Max_Processes; ----------- -- Parse -- ----------- function Parse (Host_Name : String) return Slave_Data is V : String renames Host_Name; I : constant Natural := Index (V, ":"); Host : Unbounded_String; Port : Port_Type := Default_Port; begin -- Get for port if I = 0 then Host := To_Unbounded_String (V (V'First .. V'Last)); else Host := To_Unbounded_String (V (V'First .. I - 1)); declare Port_Str : constant String := V (I + 1 .. V'Last); begin if Strings.Maps.Is_Subset (Maps.To_Set (Port_Str), Maps.Constants.Decimal_Digit_Set) then Port := Port_Type'Value (V (I + 1 .. V'Last)); else return No_Slave_Data; end if; end; end if; return Slave_Data'(Host, Port); end Parse; ------------------- -- Record_Slaves -- ------------------- procedure Record_Slaves (Option : String) is S : Slice_Set; procedure Parse_Build_Slave (V : String); -- Parse the build slave V ----------------------- -- Parse_Build_Slave -- ----------------------- procedure Parse_Build_Slave (V : String) is S_Data : constant Slave_Data := Parse (V); begin if S_Data = No_Slave_Data then Put_Line ("error: invalid port value in " & V); OS_Exit (1); else Slaves_Data.Append (S_Data); end if; end Parse_Build_Slave; begin Create (S, Option, ","); for K in 1 .. Slice_Count (S) loop Parse_Build_Slave (Slice (S, K)); end loop; end Record_Slaves; --------------------------- -- Register_Remote_Slave -- --------------------------- procedure Register_Remote_Slave (S_Data : Slave_Data; Project_Name : String; Excluded_Patterns : Sync.Str_Vect.Vector; Included_Patterns : Sync.Str_Vect.Vector; Included_Artifact_Patterns : Sync.Str_Vect.Vector; Synchronize : Boolean) is S : Slave; IAP : Unbounded_String; begin for P of Included_Artifact_Patterns loop if IAP /= Null_Unbounded_String then Append (IAP, ";"); end if; Append (IAP, P); end loop; S := Connect_Slave (S_Data, Project_Name, Sync => Synchronize, Included_Artifact_Patterns => To_String (IAP)); Set (Slaves_Sockets, Sock (S.Channel)); -- Sum the Max_Process values Max_Processes := Max_Processes + S.Max_Processes; if Opt.Verbosity_Level > Opt.Low then Put ("Register slave " & To_String (S_Data.Host) & ","); Put (Integer'Image (S.Max_Processes)); Put_Line (" process(es)"); Put_Line (" location: " & To_String (S.Root_Dir)); end if; -- Let's double check that Root_Dir and Projet_Name are not empty, -- this is a safety check to avoid rsync destroying remote environment -- as rsync is using the --delete options. if Length (S.Root_Dir) = 0 then Put_Line ("error: Root_Dir cannot be empty"); OS_Exit (1); end if; if Project_Name = "" then Put_Line ("error: Project_Name cannot be empty"); OS_Exit (1); end if; if Synchronize then Compilation.Sync.Send_Files (Channel => S.Channel, Root_Dir => To_String (Root_Dir), Included_Patterns => Included_Patterns, Excluded_Patterns => Excluded_Patterns, Mode => Sync.To_Slave); end if; -- Now that all slave's data is known and set, record it S.Sock := To_C (Sock (S.Channel)); Slaves.Insert (S); exception when Host_Error => raise Constraint_Error with "cannot connect to " & To_String (S_Data.Host); end Register_Remote_Slave; ---------------------------- -- Register_Remote_Slaves -- ---------------------------- procedure Register_Remote_Slaves (Tree : Project_Tree_Ref; Project : Project_Id) is use type Containers.Count_Type; Start, Stop : Calendar.Time; procedure Insert (V : out Sync.Str_Vect.Vector; Values : String_List_Id); -- Inserts all values into the vector Excluded_Patterns : Sync.Str_Vect.Vector; Included_Patterns : Sync.Str_Vect.Vector; Included_Artifact_Patterns : Sync.Str_Vect.Vector; ------------ -- Insert -- ------------ procedure Insert (V : out Sync.Str_Vect.Vector; Values : String_List_Id) is Idx : String_List_Id := Values; begin while Idx /= Nil_String loop declare Item : constant String_Element := Tree.Shared.String_Elements.Table (Idx); begin V.Append (Get_Name_String (Item.Value)); Idx := Item.Next; end; end loop; end Insert; Pcks : Package_Table.Table_Ptr renames Tree.Shared.Packages.Table; Pck : Package_Id := Project.Decl.Packages; begin Root_Dir := To_Unbounded_String (Containing_Directory (Get_Name_String (Project.Path.Display_Name))); -- Check for Root_Dir attribute and Excluded_Patterns Look_Remote_Package : while Pck /= No_Package loop if Pcks (Pck).Decl /= No_Declarations and then Pcks (Pck).Name = Name_Remote then declare Id : Variable_Id := Pcks (Pck).Decl.Attributes; begin while Id /= No_Variable loop declare V : constant Variable := Tree.Shared.Variable_Elements.Table (Id); begin if not V.Value.Default then if V.Name = Name_Root_Dir then declare RD : constant String := Get_Name_String (V.Value.Value); begin if Is_Absolute_Path (RD) then Root_Dir := To_Unbounded_String (RD); else Root_Dir := To_Unbounded_String (Normalize_Pathname (To_String (Root_Dir) & Directory_Separator & RD)); end if; if not Exists (To_String (Root_Dir)) or else not Is_Directory (To_String (Root_Dir)) then Put_Line ("error: " & To_String (Root_Dir) & " is not a directory" & " or does not exist"); OS_Exit (1); else Put_Line ("root dir : " & To_String (Root_Dir)); end if; end; elsif V.Name = Name_Excluded_Patterns then Insert (Excluded_Patterns, V.Value.Values); elsif V.Name = Name_Included_Patterns then Insert (Included_Patterns, V.Value.Values); elsif V.Name = Name_Included_Artifact_Patterns then Insert (Included_Artifact_Patterns, V.Value.Values); end if; end if; end; Id := Tree.Shared.Variable_Elements.Table (Id).Next; end loop; end; end if; Pck := Pcks (Pck).Next; end loop Look_Remote_Package; -- Check if Excluded_Patterns and Included_Patterns are set if Included_Patterns.Length /= 0 and then Excluded_Patterns.Length /= 0 then Put_Line ("error: Excluded_Patterns and Included_Patterns are exclusive"); OS_Exit (1); end if; -- Then registers the build slaves Start := Calendar.Clock; for S of Slaves_Data loop Register_Remote_Slave (S, Get_Name_String (Project.Name), Excluded_Patterns, Included_Patterns, Included_Artifact_Patterns, True); end loop; Sync.Wait; Stop := Calendar.Clock; if Opt.Verbosity_Level > Opt.Low then Put (" All data synchronized in "); Put (Duration'Image (Stop - Start)); Put_Line (" seconds"); end if; -- We are in remote mode, the initialization was successful, start tasks -- now. Start_Waiting_Task; end Register_Remote_Slaves; --------- -- Run -- --------- function Run (Project : Project_Id; Language : String; Options : String_Vectors.Vector; Obj_Name : String; Dep_Name : String := ""; Env : String := "") return GPR.Compilation.Id is RD : constant String := To_String (Root_Dir); S : Slave := Slaves.Get_Free; -- Get a free slave for conducting the compilation function Filter_String (O : String; Sep : String := WD_Path_Tag) return String; -- Make O PATH relative to RD. For option -gnatec and -gnatem makes -- the specified filename absolute in the slave environment and send -- the file to the slave. ------------------- -- Filter_String -- ------------------- function Filter_String (O : String; Sep : String := WD_Path_Tag) return String is Pos : constant Natural := Index (O, RD); begin if Pos = 0 then return O; else -- Note that we transfer files only when they are under the -- project root. if O'Length > 8 and then O (O'First .. O'First + 7) in "-gnatem=" | "-gnatec=" then -- Send the corresponding file to the slave declare File_Name : constant String := O (O'First + 8 .. O'Last); begin if Exists (File_Name) then Send_File (S.Channel, File_Name, Rewrite => True, Keep_Time_Stamp => True); else Put_Line ("File not found " & File_Name); Put_Line ("Please check that Built_Root is properly set"); end if; return O (O'First .. O'First + 7) & Translate_Send (S.Channel, File_Name); end; elsif O'Length > 7 and then O (O'First .. O'First + 6) = "-specs=" then -- Send the corresponding file to the slave declare File_Name : constant String := O (O'First + 7 .. O'Last); File : Text_IO.File_Type; Line : String (1 .. 2_048); Last : Natural; begin if Exists (File_Name) then Send_File (S.Channel, File_Name, Rewrite => True, Keep_Time_Stamp => True); -- And now send the spec filename in the second line Text_IO.Open (File, Text_IO.In_File, File_Name); Text_IO.Skip_Line (File); Text_IO.Get_Line (File, Line, Last); Text_IO.Close (File); -- A spec filename starts with '+ @', so 3 characters declare Filename_Offset : constant := 3; Spec_Filename : constant String := Line (1 + Filename_Offset .. Last); begin if Exists (Spec_Filename) then Send_File (S.Channel, Spec_Filename, Rewrite => True, Keep_Time_Stamp => True); else Put_Line ("Spec file not found " & Spec_Filename); Put_Line ("Please check that Built_Root is properly set"); end if; end; else Put_Line ("File not found " & File_Name); Put_Line ("Please check that Built_Root is properly set"); end if; return O (O'First .. O'First + 6) & Translate_Send (S.Channel, File_Name); end; end if; return O (O'First .. Pos - 1) & Sep & Filter_String (O (Pos + RD'Length + 1 .. O'Last)); end if; end Filter_String; Lang_Id : constant Name_Id := Get_Name_Id (Language); Pid : Remote_Id; begin -- Record the rewrite information for this channel Slaves.Set_Rewrite_WD (S, Path => RD); if Compiler_Path /= null then Slaves.Set_Rewrite_CD (S, Path => Containing_Directory (Containing_Directory (Compiler_Path.all))); end if; Send_Exec (S.Channel, Get_Name_String (Project.Path.Display_Name), Filter_String (Get_Current_Dir, Sep => ""), Language, Opt.Target_Value.all, Conf.Runtime_Name_For (Lang_Id), Options, Obj_Name, Dep_Name, Env, Filter_String'Access); Remote_Process.Increment; -- Wait for the Ack from the remote host, this is set by the Wait_Remote -- task. Wait_Ack.Get (Pid); return Process.Create_Remote (Pid); exception when E : others => Put_Line ("Unexpected exception: " & Exception_Information (E)); OS_Exit (1); end Run; ------------ -- Slaves -- ------------ protected body Slaves is -------------------- -- Change_Current -- -------------------- procedure Change_Current (S : in out Slave; Value : Integer) is Position : constant Slave_S.Cursor := Pool.Find (S); begin Pool (Position).Current := Pool (Position).Current + Value; end Change_Current; ----------- -- Clear -- ----------- procedure Clear is begin Pool.Clear; end Clear; ----------- -- Count -- ----------- function Count return Natural is begin return Natural (Pool.Length); end Count; ----------------------- -- Decrement_Current -- ----------------------- procedure Decrement_Current (S : in out Slave) is begin Change_Current (S, -1); end Decrement_Current; ---------- -- Find -- ---------- function Find (Socket : Integer) return Slave is S : constant Slave := (Sock => Socket, others => <>); Position : constant Slave_S.Cursor := Pool.Find (S); begin if Slave_S.Has_Element (Position) then return Slave_S.Element (Position); else return No_Slave; end if; end Find; function Find (Host : String) return Slave is S_Data : constant Slave_Data := Parse (Host); begin for S of Pool loop if S.Data = S_Data then return S; end if; end loop; return No_Slave; end Find; -------------- -- Get_Free -- -------------- function Get_Free return Slave is use type Containers.Count_Type; S_Count : constant Containers.Count_Type := Pool.Length; Index : constant Positive := Natural (Float (S_Count - 1) * Random (R_Gen)) + 1; -- Index of the slave to return if available Result : Slave := No_Slave; K : Positive := 1; begin -- We want to have a random pick of one slave Search_Slaves : for S of Pool loop if S.Current < S.Max_Processes then Result := S; -- Slave is ready and this is the one picked-up randomly, stop -- searching now. exit Search_Slaves when K = Index; end if; K := K + 1; -- We are past the random slave and we have found one slave ready, -- stop search here. exit Search_Slaves when K > Index and Result /= No_Slave; end loop Search_Slaves; return Result; end Get_Free; ----------------------- -- Increment_Current -- ----------------------- procedure Increment_Current (S : in out Slave) is begin Change_Current (S, 1); end Increment_Current; ------------ -- Insert -- ------------ procedure Insert (S : Slave) is begin Pool.Insert (S); end Insert; ------------- -- Iterate -- ------------- procedure Iterate (Proc : access procedure (S : in out Slave)) is begin for C in Pool.Iterate loop declare S : Slave := Slave_S.Element (C); begin Proc (S); Pool.Replace_Element (C, S); end; end loop; end Iterate; -------------------- -- Set_Rewrite_CD -- -------------------- procedure Set_Rewrite_CD (S : in out Slave; Path : String) is Position : constant Slave_S.Cursor := Pool.Find (S); begin Set_Rewrite_CD (Pool (Position).Channel, Path => Path); S := Pool (Position); end Set_Rewrite_CD; -------------------- -- Set_Rewrite_WD -- -------------------- procedure Set_Rewrite_WD (S : in out Slave; Path : String) is Position : constant Slave_S.Cursor := Pool.Find (S); begin Set_Rewrite_WD (Pool (Position).Channel, Path => Path); S := Pool (Position); end Set_Rewrite_WD; end Slaves; ------------------------ -- Start_Waiting_Task -- ------------------------ procedure Start_Waiting_Task is begin if WR = null then WR := new Wait_Remote; end if; end Start_Waiting_Task; ------------------------------ -- Unregister_Remote_Slaves -- ------------------------------ procedure Unregister_Remote_Slaves (From_Signal : Boolean := False) is procedure Unregister (S : in out Slave); -- Unregister given slave Start, Stop : Time; ---------------- -- Unregister -- ---------------- procedure Unregister (S : in out Slave) is begin if not From_Signal then Send_End_Of_Compilation (S.Channel); -- Wait for acknowledge to ensure the clean-up is terminated on -- on the slave. declare Cmd : constant Command := Get_Command (S.Channel) with Unreferenced; begin null; end; end if; Close (S.Channel); exception when others => Close (S.Channel); end Unregister; begin Start := Clock; Slaves.Iterate (Unregister'Access); if not From_Signal then Sync.Wait; end if; Stop := Clock; if not From_Signal and then Opt.Verbosity_Level > Opt.Low and then Slaves.Count > 0 then Put (" All data synchronized in "); Put (Duration'Image (Stop - Start)); Put_Line (" seconds"); end if; Slaves.Clear; end Unregister_Remote_Slaves; -------------- -- Wait_Ack -- -------------- protected body Wait_Ack is --------- -- Set -- --------- procedure Set (Pid : Remote_Id) is begin Id := Pid; Is_Set := True; end Set; --------- -- Get -- --------- entry Get (Pid : out Remote_Id) when Is_Set is begin Pid := Id; Is_Set := False; end Get; end Wait_Ack; ----------------- -- Wait_Remote -- ----------------- task body Wait_Remote is Proc : Id; Pid : Remote_Id; Selector : Selector_Type; Status : Selector_Status; R_Set, W_Set : Socket_Set_Type; Sock : Socket_Type; S : Slave; begin -- In this task we are only interested by the incoming data, so we do -- not wait on socket ready for writing. Sockets.Empty (W_Set); Create_Selector (Selector); loop -- Let's wait for at least some process to monitor Remote_Process.Wait_Non_Zero; -- Wait for response from all registered slaves Copy (Slaves_Sockets, R_Set); Check_Selector (Selector, R_Set, W_Set, Status); if Status = Completed then Get (R_Set, Sock); pragma Assert (Sock /= No_Socket, "no socket returned by selector"); S := Slaves.Find (To_C (Sock)); if S /= No_Slave then declare Cmd : constant Command := Get_Command (S.Channel); Success : Boolean; begin -- A display output if Kind (Cmd) = DP then -- Write output to the console Put (To_String (Protocol.Output (Cmd))); Get_Pid (S.Channel, Pid, Success); Proc := Process.Create_Remote (Pid); Remote_Process.Decrement; Slaves.Decrement_Current (S); Process.Add_Result (Proc, Success, To_String (S.Data.Host)); -- An acknowledgment of an compilation job elsif Kind (Cmd) = AK then declare Pid : constant Remote_Id := Remote_Id'Value (Args (Cmd)(1).all); begin Slaves.Increment_Current (S); Wait_Ack.Set (Pid); end; elsif Kind (Cmd) in EC | SI then null; else raise Constraint_Error with "Unexpected command: " & Command_Kind'Image (Kind (Cmd)); end if; end; end if; else if Opt.Verbosity_Level = Opt.High then Put_Line ("warning: selector in " & Selector_Status'Image (Status) & " state"); end if; end if; Sockets.Empty (R_Set); end loop; exception when E : others => Put_Line (Exception_Information (E)); OS_Exit (1); end Wait_Remote; end GPR.Compilation.Slave;