------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- Cheddar is a GNU GPL real-time scheduling analysis tool. -- This program provides services to automatically check schedulability and -- other performance criteria of real-time architecture models. -- -- Copyright (C) 2002-2023, Frank Singhoff, Alain Plantec, Jerome Legrand, -- Hai Nam Tran, Stephane Rubini -- -- The Cheddar project was started in 2002 by -- Frank Singhoff, Lab-STICC UMR CNRS 6285, Universite de Bretagne Occidentale -- -- Cheddar has been published in the "Agence de Protection des Programmes/France" in 2008. -- Since 2008, Ellidiss technologies also contributes to the development of -- Cheddar and provides industrial support. -- -- The full list of contributors and sponsors can be found in README.md -- -- This program is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- -- -- Contact : cheddar@listes.univ-brest.fr -- ------------------------------------------------------------------------------ -- Last update : -- $Rev: 4589 $ -- $Date: 2023-09-29 16:02:19 +0200 (ven. 29 sept. 2023) $ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Ada.Streams; with Ada.Streams.Stream_IO; with Tasks; use Tasks; with Systems; use Systems; with task_set; use task_set; with Resources; use Resources; with Ada.Text_IO; use Ada.Text_IO; with resource_set; use resource_set; with GNAT.Sockets; use GNAT.Sockets; with Marzhin_Utils; use Marzhin_Utils; with Ada.Strings.Maps; use Ada.Strings.Maps; with time_unit_events; use time_unit_events; with Ada.Strings.Fixed; use Ada.Strings.Fixed; with unbounded_strings; use unbounded_strings; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO; with Multiprocessor_Services_Interface; use Multiprocessor_Services_Interface; use type Ada.Streams.Stream_Element_Count; use type time_unit_events.time_unit_range; use type Multiprocessor_Services_Interface.scheduling_table_range; --#[debug] with debug; use debug; --------------------------------------------------------------------- -- Package Sockets_Overlay -- Purpose: Contain types definitions, functions and procedures -- usefull for sockets manipulations such as IO and configuration. -- Extra: # Documentations on methods are puts in the specification file. -- # AADLInspector related procedures could be factorized and -- added to a new package `AADLInspector_Communication`. --------------------------------------------------------------------- package body Sockets_Overlay is -- ASCII strings: LF : constant Character := ASCII.LF; CRLF : constant String := ASCII.CR & ASCII.LF; -------------------------------------- -- Data_Communication -- -------------------------------------- procedure Data_Communication (Sys : in system; Result : in scheduling_table_ptr; J : in scheduling_table_range; Current_Time : in Natural; Last_Time_Mod : in out Natural; SpeedFactor : in Duration; Speed : in out Duration; Slice_Size : in out Natural; Exit_Simulation : in out Boolean) is Event_XML : Unbounded_String; Event_String : Unbounded_String; Task_Id_String : Unbounded_String; Message_To_Send : Unbounded_String; Message_Received : Unbounded_String; Resource_Id_String : Unbounded_String; Current_Task : generic_task_ptr; Current_Resource : generic_resource_ptr; begin -- For each scheduler entrey check the event entries at current time -- and construct the server response with current events data: for Current_Entry in 0 .. Result.entries (J).data.result.nb_entries - 1 loop -- Check for arrival of a socket commmand: GNAT.Sockets.Set (Input_Set, Command_Socket); Check_Selector (Input_Selector, Input_Set, WSet, Input_Status, 0.0); if Input_Status = Completed then Current_Communication_State := running; Command_Communication (Slice_Size, Last_Time_Mod, Speed, SpeedFactor, Exit_Simulation); if Exit_Simulation then return; end if; end if; -- Process the time unit event data to be sent on socket: if Result.entries (J).data.result.entries (Current_Entry).item = Current_Time then -- Initialization value for current entry: Event_XML := xml_string (Result.entries (J).data.result.entries (Current_Entry).data); Message_To_Send := To_Unbounded_String (""); -- Get the Cheddar's event name: Get_Event_String_From_XML (Event_XML, Event_String); -- Get the current resource of the event: if Is_Resource_Event (Event_String) then Get_Resource_Id_From_XML (Event_XML, Event_String, Resource_Id_String); Current_Resource := search_resource_by_id (Sys.Resources, Resource_Id_String); end if; -- Get the task linked to the current event: Get_Task_Id_From_XML (Event_XML, Event_String, Task_Id_String); Current_Task := search_task_by_id (Sys.Tasks, Task_Id_String); -- Transform the Cheddar EventString to a Marzhin EventString: Set_To_Marzhin_Event (Event_String); -- Output the event on socket: Message_To_Send := To_Marzhin_Output_Format (Current_Time, Event_String, Current_Task.name) & Message_To_Send; Write_Channel (Data_Channel, Message_To_Send & LF); --#[debug] put_debug ("__DEBUG__ :: " & Message_To_Send & LF); -- Output resource event on socket (if exist): if Is_Resource_Event (Event_String) then Set_To_Marzhin_Resource_Event (Event_String); Message_To_Send := To_Marzhin_Output_Format (Current_Time, Event_String, Current_Resource.name); Write_Channel (Data_Channel, Message_To_Send & LF); --#[debug] put_debug ("__DEBUG__ :: " & Message_To_Send & LF); end if; --#[debug] put_debug ("__DEBUG__ :: " & Event_XML); end if; end loop; -- Output end of tick event: Message_To_Send := To_Marzhin_Output_Format (Current_Time, To_Unbounded_String ("PROCESS_END_TICK"), Current_Task.address_space_name); Write_Channel (Data_Channel, Message_To_Send & LF); --#[debug] put_debug ("__DEBUG__ :: " & Message_To_Send & LF); delay Speed; end Data_Communication; ------------------- -- Close_Sockets -- ------------------- procedure Close_Sockets is begin Close_Socket (Ack_Socket); Close_Socket (Data_Socket); Close_Socket (Command_Socket); end Close_Sockets; -------------------- -- Connect_Socket -- -------------------- procedure Connect_Socket (Serv : in out Socket_Type; Client : in out Socket_Type; Addr : in Sock_Addr_Type; Channel : in out GNAT.Sockets.Stream_Access) is begin Listen_Socket (Serv); Accept_Socket (Serv, Client, Address); Channel := GNAT.Sockets.Stream (Client); end Connect_Socket; ----------------------- -- Get_Command_Value -- ----------------------- function Get_Command_Value (Command : Unbounded_String) return String is begin return To_String (substring (Command, (Index (Command, "[") + 1), (Index (Command, "]") - 1))); end Get_Command_Value; ----------------------- -- Initialize_Socket -- ----------------------- procedure Initialize_Socket (Address : in Sock_Addr_Type; Serv : in out Socket_Type) is begin Create_Socket (Serv); Set_Socket_Option (Serv, Socket_Level, (Reuse_Address, True)); Bind_Socket (Serv, Address); end Initialize_Socket; ---------- -- Read -- ---------- function Read (Client : in out Socket_Type; Channel : in out Stream_Access) return Unbounded_String is -- Offset : Ada.Streams.Stream_Element_Count; Buffer : String (1 .. 256); Result : Unbounded_String := To_Unbounded_String (""); Byte_Count : Natural; begin Byte_Count := 0; for Index in Buffer'range loop Byte_Count := Byte_Count + 1; Character'read (Channel, Buffer (Byte_Count)); if Buffer (Byte_Count) = ASCII.LF then if Buffer (Byte_Count - 1) = ASCII.CR then Result := Result & Buffer (1 .. Byte_Count - 2); return Result; end if; end if; end loop; return Result; end Read; ------------------ -- Read_Channel -- ------------------ procedure Read_Channel (Channel : in out GNAT.Sockets.Stream_Access; Data : out Unbounded_String) is -- Size : Integer; begin Data := To_Unbounded_String (String'input (Channel)); end Read_Channel; ---------------------------- -- Server_Start_Listening -- ---------------------------- procedure Server_Start_Listening (Addr : in String; Port : in Port_Type; Socket : in out Socket_Type; Channel : in out GNAT.Sockets.Stream_Access) is begin Address.Addr := Inet_Addr (Addr); Address.Port := Port; Create_Socket (Server); Set_Socket_Option (Server, Socket_Level, (Reuse_Address, True)); Bind_Socket (Server, Address); Listen_Socket (Server); Accept_Socket (Server, Socket, Address); Channel := GNAT.Sockets.Stream (Socket); end Server_Start_Listening; ------------------------ -- Sockets_Initialize -- ------------------------ procedure Initialize_Sockets is begin Server_Start_Listening ("127.0.0.1", 8902, Command_Socket, Command_Channel); put_debug ("__INFO__ :: Command socket connected."); Server_Start_Listening ("127.0.0.1", 8901, Data_Socket, Data_Channel); put_debug ("__INFO__ :: Data socket connected."); Server_Start_Listening ("127.0.0.1", 8903, Ack_Socket, Ack_Channel); put_debug ("__INFO__ :: Ack socket connected."); put_debug ("__INFO__ :: Waiting for simulation start..."); Create_Selector (Input_Selector); Empty (Input_Set); Empty (WSet); end Initialize_Sockets; ----------------------------------------- -- Command_Communication -- ----------------------------------------- procedure Command_Communication (Slice_Size : in out Natural; Last_Time_Mod : in out Natural; Speed : in out Duration; SpeedFactor : in Duration; Exit_Simulation : in out Boolean) is begin case Current_Communication_State is when starting => Command_Start_State_Communication (Slice_Size, Last_Time_Mod, Speed, SpeedFactor, Exit_Simulation); when running => Command_Run_State_Communication (Slice_Size, Last_Time_Mod, Speed, SpeedFactor, Exit_Simulation); when ending => Command_End_State_Communication (Slice_Size, Last_Time_Mod, Speed, SpeedFactor, Exit_Simulation); when others => null; end case; end Command_Communication; ------------------------------- -- Start_State_Communication -- ------------------------------- procedure Command_Start_State_Communication (Slice_Size : in out Natural; Last_Time_Mod : in out Natural; Speed : in out Duration; SpeedFactor : in Duration; Exit_Simulation : in out Boolean) is Message_Received : Unbounded_String; Message_To_Send : Unbounded_String; begin -- Initialization ended, waiting for a socket message: Message_Received := Sockets_Overlay.Read (Command_Socket, Command_Channel); put_debug ("__INFO__ :: Message_Received:" & Message_Received); while (Index (Message_Received, "simulator play") <= 0) loop if (Index (Message_Received, "slice") > 0) then Slice_Size := Integer'value (Get_Command_Value (Message_Received)); Last_Time_Mod := Slice_Size; elsif (Index (Message_Received, "speed") > 0) then Message_To_Send := To_Unbounded_String ("Change time between tick OK :*"); Write_Channel (Ack_Channel, Message_To_Send & Character'val (10)); Speed := SpeedFactor * Duration'value (Get_Command_Value (Message_Received)); elsif (Index (Message_Received, "get_tasks_capacities") > 0) then put_debug ("__INFO__ :: Request for table of tasks capacities"); -- Message_To_Send := Encode_Task_Capacities(Si); end if; Message_Received := Sockets_Overlay.Read (Command_Socket, Command_Channel); end loop; end Command_Start_State_Communication; ----------------------------- -- Run_State_Communication -- ----------------------------- procedure Command_Run_State_Communication (Slice_Size : in out Natural; Last_Time_Mod : in out Natural; Speed : in out Duration; SpeedFactor : in Duration; Exit_Simulation : in out Boolean) is Message_Received : Unbounded_String; Message_To_Send : Unbounded_String; begin Message_Received := Sockets_Overlay.Read (Command_Socket, Command_Channel); if (To_String (Message_Received) = "simulator pause") then Message_To_Send := To_Unbounded_String ("pause OK"); Write_Channel (Ack_Channel, Message_To_Send & Character'val (10)); while (To_String (Message_Received) /= "simulator resume") loop Message_Received := Sockets_Overlay.Read (Command_Socket, Command_Channel); if (Index (Message_Received, "slice") > 0) then Slice_Size := Integer'value (Get_Command_Value (Message_Received)); Last_Time_Mod := Last_Time_Mod + Slice_Size; elsif (Index (Message_Received, "speed") > 0) then Message_To_Send := To_Unbounded_String ("Change time between tick OK :*"); Write_Channel (Ack_Channel, Message_To_Send & Character'val (10)); Speed := SpeedFactor * Duration'value (Get_Command_Value (Message_Received)); end if; end loop; Message_To_Send := To_Unbounded_String ("resume OK"); Write_Channel (Ack_Channel, Message_To_Send & Character'val (10)); elsif (Index (Message_Received, "slice") > 0) then Slice_Size := Integer'value (Get_Command_Value (Message_Received)); Last_Time_Mod := Last_Time_Mod + Slice_Size; elsif (Index (Message_Received, "speed") > 0) then Message_To_Send := To_Unbounded_String ("Change time between tick OK :*"); Write_Channel (Ack_Channel, Message_To_Send & Character'val (10)); Speed := SpeedFactor * Duration'value (Get_Command_Value (Message_Received)); elsif To_String (Message_Received) = "simulator stop" then Exit_Simulation := True; end if; end Command_Run_State_Communication; ----------------------------- -- End_State_Communication -- ----------------------------- procedure Command_End_State_Communication (Slice_Size : in out Natural; Last_Time_Mod : in out Natural; Speed : in out Duration; SpeedFactor : in Duration; Exit_Simulation : in out Boolean) is Message_Received : Unbounded_String; Message_To_Send : Unbounded_String; begin Message_Received := Sockets_Overlay.Read (Command_Socket, Command_Channel); while (To_String (Message_Received) /= "simulator play") loop if (Index (Message_Received, "slice") > 0) then Slice_Size := Integer'value (Get_Command_Value (Message_Received)); end if; if (Index (Message_Received, "speed") > 0) then Message_To_Send := To_Unbounded_String ("Change time between tick OK :*"); Write_Channel (Ack_Channel, Message_To_Send & Character'val (10)); Speed := SpeedFactor * Duration'value (Get_Command_Value (Message_Received)); end if; if To_String (Message_Received) = "simulator stop" then Exit_Simulation := True; end if; exit when To_String (Message_Received) = "simulator stop"; Message_Received := Sockets_Overlay.Read (Command_Socket, Command_Channel); end loop; Last_Time_Mod := Last_Time_Mod + Slice_Size; end Command_End_State_Communication; ------------------- -- Write_Channel -- ------------------- procedure Write_Channel (Channel : in out GNAT.Sockets.Stream_Access; Data : in Unbounded_String) is begin String'output (Channel, To_String (Data)); end Write_Channel; end Sockets_Overlay;