Commit a4a1c77c authored by yoogx's avatar yoogx

* Remove dependency on secondary stack on the formatting of

          debug strings

          For openaadl/ocarina#134
parent 270f0633
......@@ -50,7 +50,7 @@ package body Ping is
begin
Order := not Order;
Data_Source := Order;
Put_Line ("Sending ORDER: " + Opaque_Type'Image (Order));
Put_Line ("Sending ORDER: ", Opaque_Type'Image (Order));
end Do_Ping_Spg;
--------------------
......@@ -62,14 +62,14 @@ package body Ping is
Data_Source : out Simple_type)
is
begin
Put_Line ("ORDER: " + Opaque_Type'Image (Data_Sink));
Put_Line ("ORDER: ", Opaque_Type'Image (Data_Sink));
if Data_Sink then
Var := Var + 1;
Put_Line ("Sending (+1) PING" + Simple_Type'Image (Var));
Put_Line ("Sending (+1) PING", Simple_Type'Image (Var));
else
Var := Var + 5;
Put_Line ("Sending (+5) PING" + Simple_Type'Image (Var));
Put_Line ("Sending (+5) PING", Simple_Type'Image (Var));
end if;
Data_Source := Var;
......
......@@ -59,34 +59,34 @@ package body PolyORB_HI.Aperiodic_Task is
-- Wait for the network initialization to be finished
pragma Debug (Verbose,
Put_Line ("Aperiodic Task "
+ Entity_Image (Entity)
+ ": Wait initialization"));
Put_Line ("Aperiodic Task ",
Entity_Image (Entity),
": Wait initialization"));
Suspend_Until_True (Task_Suspension_Objects (Entity));
delay until System_Startup_Time;
pragma Debug (Verbose,
Put_Line ("Aperiodic task initialized for entity "
+ Entity_Image (Entity)));
Put_Line ("Aperiodic task initialized for entity ",
Entity_Image (Entity)));
-- Main task loop
loop
pragma Debug (Verbose,
Put_Line ("Aperiodic Task "
+ Entity_Image (Entity)
+ ": New Dispatch"));
Put_Line ("Aperiodic Task ",
Entity_Image (Entity),
": New Dispatch"));
-- Block until an event is received
Wait_For_Incoming_Events (Entity, Port);
pragma Debug (Verbose,
Put_Line ("Aperiodic Task "
+ Entity_Image (Entity)
+ ": received event"));
Put_Line ("Aperiodic Task ",
Entity_Image (Entity),
": received event"));
-- Execute the job
......
......@@ -55,20 +55,20 @@ package body PolyORB_HI.Background_Task is
-- Wait for the network initialization to be finished
pragma Debug (Verbose,
Put_Line ("Background Task "
+ Entity_Image (Entity)
+ ": Wait initialization"));
Put_Line ("Background Task ",
Entity_Image (Entity),
": Wait initialization"));
Block_Task (Entity);
delay until System_Startup_Time;
pragma Debug (Verbose,
Put_Line ("Background task initialized for entity "
+ Entity_Image (Entity)));
Put_Line ("Background task initialized for entity ",
Entity_Image (Entity)));
pragma Debug (Verbose,
Put_Line ("Background Task " + Entity_Image (Entity)
+ ": Run job"));
Put_Line ("Background Task ", Entity_Image (Entity),
": Run job"));
Job (Error);
......
......@@ -62,17 +62,15 @@ package body PolyORB_HI.Hybrid_Task is
pragma Debug
(Put_Line
(Verbose,
"Hybrid Task "
+ Entity_Image (Entity)
+ ": Wait initialization"));
"Hybrid Task ", Entity_Image (Entity), ": Wait initialization"));
Suspend_Until_True (Task_Suspension_Objects (Entity));
delay until System_Startup_Time;
pragma Debug (Put_Line
(Verbose,
"Hybrid task initialized for entity "
+ Entity_Image (Entity)));
"Hybrid task initialized for entity ",
Entity_Image (Entity)));
-- Run the initialize entrypoint (if any)
......@@ -84,9 +82,7 @@ package body PolyORB_HI.Hybrid_Task is
pragma Debug
(Put_Line
(Verbose,
"Hybrid Task "
+ Entity_Image (Entity)
+ ": New Dispatch"));
"Hybrid Task ", Entity_Image (Entity), ": New Dispatch"));
-- Block until an event is received
......@@ -95,9 +91,7 @@ package body PolyORB_HI.Hybrid_Task is
pragma Debug
(Put_Line
(Verbose,
"Hybrid Task "
+ Entity_Image (Entity)
+ ": received event"));
"Hybrid Task ", Entity_Image (Entity), ": received event"));
-- Calculate the next deadline according to the minimal
-- inter-arrival time.
......
......@@ -59,21 +59,17 @@ package body PolyORB_HI.Null_Task is
pragma Debug
(Put_Line
(Verbose,
"Null Task "
+ Entity_Image (Entity)
+ ": Wait initialization"));
"Null Task ", Entity_Image (Entity), ": Wait initialization"));
pragma Debug (Put_Line
(Verbose,
"Null task initialized for entity "
+ Entity_Image (Entity)));
"Null task initialized for entity ",
Entity_Image (Entity)));
pragma Debug
(Put_Line
(Verbose,
"Null Task "
+ Entity_Image (Entity)
+ ": Run job"));
(Verbose,
"Null Task ", Entity_Image (Entity), ": Run job"));
Job (Error);
......
......@@ -42,9 +42,6 @@ package body PolyORB_HI.Output is
use Ada.Real_Time;
procedure Unprotected_Put_Line (Text : in String);
-- Not thread-safe Put_Line function
procedure Unprotected_Put (Text : in String);
-- Not thread-safe Put function
......@@ -54,7 +51,11 @@ package body PolyORB_HI.Output is
package Output_Lock is
procedure Put_Line (Text : in String);
procedure Put_Line (Text : in String;
C1 : in String := "";
C2 : in String := "";
C3 : in String := ""
);
-- As above but always displays the message
procedure Put (Text : in String);
......@@ -69,7 +70,11 @@ package body PolyORB_HI.Output is
procedure Put (Text : in String);
procedure Put_Line (Text : in String);
procedure Put_Line (Text : in String;
C1 : in String := "";
C2 : in String := "";
C3 : in String := ""
);
private
pragma Priority (System.Priority'Last);
......@@ -81,9 +86,23 @@ package body PolyORB_HI.Output is
-- Put_Line --
--------------
procedure Put_Line (Text : in String) is
procedure Put_Line (Text : in String;
C1 : in String := "";
C2 : in String := "";
C3 : in String := ""
) is
begin
Unprotected_Put_Line (Text);
Unprotected_Put (Text);
if C1 /= "" then
Unprotected_Put (C1);
end if;
if C2 /= "" then
Unprotected_Put (C2);
end if;
if C3 /= "" then
Unprotected_Put (C3);
end if;
PolyORB_HI.Output_Low_Level.New_Line;
end Put_Line;
---------
......@@ -96,9 +115,13 @@ package body PolyORB_HI.Output is
end Put;
end Lock;
procedure Put_Line (Text : in String) is
procedure Put_Line (Text : in String;
C1 : in String := "";
C2 : in String := "";
C3 : in String := ""
) is
begin
Lock.Put_Line (Text);
Lock.Put_Line (Text, C1, C2, C3);
end Put_Line;
procedure Put (Text : in String) is
......@@ -112,9 +135,13 @@ package body PolyORB_HI.Output is
-- Put_Line --
--------------
procedure Put_Line (Text : in String) is
procedure Put_Line (Text : in String;
C1 : in String := "";
C2 : in String := "";
C3 : in String := ""
) is
begin
Output_Lock.Put_Line (Text);
Output_Lock.Put_Line (Text, C1, C2, C3);
end Put_Line;
---------
......@@ -126,16 +153,6 @@ package body PolyORB_HI.Output is
Output_Lock.Put (Text);
end Put;
--------------------------
-- Unprotected_Put_Line --
--------------------------
procedure Unprotected_Put_Line (Text : in String) is
begin
Unprotected_Put (Text);
PolyORB_HI.Output_Low_Level.New_Line;
end Unprotected_Put_Line;
---------------------
-- Unprotected_Put --
---------------------
......@@ -195,17 +212,4 @@ package body PolyORB_HI.Output is
end if;
end Dump;
---------
-- "+" --
---------
function "+" (S1 : String; S2 : String) return String is
S : String (1 .. S1'Length + S2'Length) := (others => ' ');
begin
S (1 .. S1'Length) := S1 (S1'First .. S1'Last);
S (S1'Length + 1 .. S'Last) := S2 (S2'First .. S2'Last);
return S;
end "+";
end PolyORB_HI.Output;
......@@ -60,7 +60,11 @@ package PolyORB_HI.Output is
Normal : constant Boolean := Current_Mode >= Normal_L;
Error : constant Boolean := Current_Mode >= Error_L;
procedure Put_Line (Text : in String);
procedure Put_Line (Text : in String;
C1 : in String := "";
C2 : in String := "";
C3 : in String := ""
);
-- As above but always displays the message
procedure Put (Text : in String);
......@@ -70,8 +74,6 @@ package PolyORB_HI.Output is
Mode : Verbosity := Verbose_L);
-- Dump the content of Stream in an hexadecimal format
function "+" (S1 : String; S2 : String) return String;
private
pragma Inline (Put_Line);
......
......@@ -65,9 +65,9 @@ package body PolyORB_HI.Periodic_Task is
-- Wait for the network initialization to be finished
pragma Debug (Verbose,
Put_Line ("Periodic Task "
+ Entity_Image (Entity)
+ ": Wait initialization"));
Put_Line ("Periodic Task ",
Entity_Image (Entity),
": Wait initialization"));
Block_Task (Entity);
Next_Start := System_Startup_Time + Dispatch_Offset;
......@@ -82,8 +82,9 @@ package body PolyORB_HI.Periodic_Task is
loop
pragma Debug (Verbose,
Put_Line ("Periodic Task "
+ Entity_Image (Entity) + ": New Cycle"));
Put_Line ("Periodic Task ",
Entity_Image (Entity),
": New Cycle"));
-- Execute the task's job
......@@ -101,8 +102,9 @@ package body PolyORB_HI.Periodic_Task is
-- Duration'Image (To_Duration (Next_Start - T)));
-- end if;
pragma Debug (Verbose,
Put_Line ("Periodic Task " + Entity_Image (Entity)
+ ": End of Cycle"));
Put_Line ("Periodic Task ",
Entity_Image (Entity),
": End of Cycle"));
delay until Next_Start;
Next_Start := Next_Start + Task_Period;
......
......@@ -66,33 +66,33 @@ package body PolyORB_HI.Sporadic_Task is
pragma Debug
(Verbose,
Put_Line ("Sporadic Task "
+ Entity_Image (Entity)
+ ": Wait initialization"));
Put_Line ("Sporadic Task ",
Entity_Image (Entity),
": Wait initialization"));
Block_Task (Entity);
delay until System_Startup_Time;
pragma Debug (Verbose,
Put_Line ("Sporadic task initialized for entity "
+ Entity_Image (Entity)));
Put_Line ("Sporadic task initialized for entity ",
Entity_Image (Entity)));
-- Main task loop
loop
pragma Debug (Verbose,
Put_Line ("Sporadic Task "
+ Entity_Image (Entity)
+ ": New Dispatch"));
Put_Line ("Sporadic Task ",
Entity_Image (Entity),
": New Dispatch"));
-- Block until an event is received
Wait_For_Incoming_Events (Entity, Port);
pragma Debug (Verbose,
Put_Line ("Sporadic Task "
+ Entity_Image (Entity)
+ ": received event"));
Put_Line ("Sporadic Task ",
Entity_Image (Entity),
": received event"));
-- Calculate the next start time according to the minimal
-- inter-arrival time.
......
......@@ -158,8 +158,9 @@ package body PolyORB_HI.Thread_Interrogators is
pragma Debug
(Verbose,
Put_Line (CE + ": Wait_Event: oldest unread event port = "
+ Thread_Port_Images (P)));
Put_Line (Entity_Image (Current_Entity),
": Wait_Event: oldest unread event port = ",
Thread_Port_Images (P)));
end Wait_Event;
----------------
......@@ -279,16 +280,18 @@ package body PolyORB_HI.Thread_Interrogators is
Error : Error_Kind := Error_None;
begin
pragma Debug (Verbose,
Put_Line (CE + ": Send_Output: port "
+ Thread_Port_Images (Port)));
Put_Line (Entity_Image (Current_Entity),
": Send_Output: port ",
Thread_Port_Images (Port)));
-- If no valid value is to be sent, quit
if Global_Queue.Is_Invalid (Port) then
pragma Debug (Verbose,
Put_Line
(CE + ": Send_Output: Invalid value in port "
+ Thread_Port_Images (Port)));
(Entity_Image (Current_Entity),
": Send_Output: Invalid value in port ",
Thread_Port_Images (Port)));
null;
else
-- Mark the port value as invalid to impede future sendings
......@@ -318,10 +321,9 @@ package body PolyORB_HI.Thread_Interrogators is
pragma Debug
(Verbose,
Put_Line
(CE + ": Send_Output: to port "
+ PolyORB_HI_Generated.Deployment.Port_Image (Dst (To))
+ " of "
+ Entity_Image (Port_Table (Dst (To)))));
(Entity_Image (Current_Entity), ": Send_Output: to port ",
PolyORB_HI_Generated.Deployment.Port_Image (Dst (To)),
Entity_Image (Port_Table (Dst (To)))));
Error := Send (Current_Entity, Port_Table (Dst (To)), Message);
PolyORB_HI.Messages.Reallocate (Message);
......@@ -333,9 +335,9 @@ package body PolyORB_HI.Thread_Interrogators is
pragma Debug (Verbose,
Put_Line
(CE + ": Send_Output: port "
+ Thread_Port_Images (Port)
+ ". End."));
(Entity_Image (Current_Entity), ": Send_Output: port ",
Thread_Port_Images (Port),
". End."));
end if;
return Error;
......@@ -347,7 +349,8 @@ package body PolyORB_HI.Thread_Interrogators is
procedure Put_Value (Thread_Interface : Thread_Interface_Type) is
begin
pragma Debug (Verbose, Put_Line (CE + ": Put_Value"));
pragma Debug (Verbose, Put_Line (Entity_Image (Current_Entity),
": Put_Value"));
Global_Queue.Store_Out
((Current_Entity, Interface_To_Stream (Thread_Interface)),
......@@ -373,9 +376,9 @@ package body PolyORB_HI.Thread_Interrogators is
T_Port : constant Thread_Interface_Type := Stream_To_Interface (Stream);
begin
pragma Debug (Verbose,
Put_Line (CE + ": Get_Value: Value of port "
+ Thread_Port_Images (Port)
+ " got"));
Put_Line (Entity_Image (Current_Entity),
": Get_Value: Value of port ",
Thread_Port_Images (Port), " got"));
return T_Port;
end Get_Value;
......@@ -387,10 +390,11 @@ package body PolyORB_HI.Thread_Interrogators is
Sender : constant Entity_Type := Global_Queue.Read_In (Port).From;
begin
pragma Debug (Verbose,
Put_Line (CE + ": Get_Sender: Value of sender to port "
+ Thread_Port_Images (Port)
+ " = "
+ Entity_Image (Sender)));
Put_Line (Entity_Image (Current_Entity),
": Get_Sender: Value of sender to port ",
Thread_Port_Images (Port),
Entity_Image (Sender)));
return Sender;
end Get_Sender;
......@@ -403,10 +407,9 @@ package body PolyORB_HI.Thread_Interrogators is
begin
pragma Debug (Verbose,
Put_Line
(CE + ": Get_Count: port "
+ Thread_Port_Images (Port)
+ " ="
+ Integer'Image (Count)));
(Entity_Image (Current_Entity), ": Get_Count: port ",
Thread_Port_Images (Port),
Integer'Image (Count)));
return Count;
end Get_Count;
......@@ -419,10 +422,11 @@ package body PolyORB_HI.Thread_Interrogators is
P : Port_Stream_Entry;
begin
pragma Debug (Verbose,
Put_Line (CE + ": Next_Value for port "
+ Thread_Port_Images (Port)));
Put_Line (Entity_Image (Current_Entity),
": Next_Value for port ",
Thread_Port_Images (Port)));
Global_Queue.Dequeue (Port, P);
Global_Queue.Dequeue (Port, P);
end Next_Value;
------------------------------
......@@ -431,15 +435,16 @@ package body PolyORB_HI.Thread_Interrogators is
procedure Wait_For_Incoming_Events (Port : out Port_Type) is
begin
pragma Debug (Verbose, Put_Line (CE + ": Wait_For_Incoming_Events"));
pragma Debug (Verbose, Put_Line (Entity_Image (Current_Entity),
": Wait_For_Incoming_Events"));
Global_Queue.Wait_Event (Port);
pragma Debug (Verbose,
Put_Line (CE
+ ": Wait_For_Incoming_Events: reception of"
+ " event [Data] message on port "
+ Thread_Port_Images (Port)));
Put_Line (Entity_Image (Current_Entity),
": Wait_For_Incoming_Events: reception of",
" event [Data] message on port ",
Thread_Port_Images (Port)));
end Wait_For_Incoming_Events;
--------------------
......@@ -456,15 +461,16 @@ package body PolyORB_HI.Thread_Interrogators is
if Valid then
pragma Debug (Verbose,
Put_Line
(CE
+ ": Get_Next_Event: read event [data] message"
+ " for port "
+ Thread_Port_Images (Port)));
(Entity_Image (Current_Entity),
": Get_Next_Event: read event [data] message",
" for port ", Thread_Port_Images (Port)));
null;
else
pragma Debug (Verbose,
Put_Line
(CE + ": Get_Next_Event: Nothing to read."));
(Entity_Image (Current_Entity),
": Get_Next_Event: Nothing to read."));
null;
end if;
end Get_Next_Event;
......@@ -479,7 +485,9 @@ package body PolyORB_HI.Thread_Interrogators is
Time_Stamp : Ada.Real_Time.Time := Ada.Real_Time.Clock)
is
begin
pragma Debug (Verbose, Put_Line (CE + ": Store_Received_Message"));
pragma Debug (Verbose,
Put_Line (Entity_Image (Current_Entity),
": Store_Received_Message"));
Global_Queue.Store_In
((From, Interface_To_Stream (Thread_Interface)), Time_Stamp);
......
......@@ -160,8 +160,8 @@ package body PolyORB_HI.Transport_Low_Level is
Listen_Socket (Nodes (My_Node).Socket_Receive);
pragma Debug (Verbose,
Put_Line ("Local socket created for "
+ Image (Nodes (My_Node).Address)));
Put_Line ("Local socket created for ",
Image (Nodes (My_Node).Address)));
end if;
-- Start the protocol handler task
......@@ -180,8 +180,8 @@ package body PolyORB_HI.Transport_Low_Level is
Next_Time := Clock + Milliseconds (200);
begin
pragma Debug (Verbose,
Put_Line ("Try to connect to "
+ Image (Nodes (N).Address)));
Put_Line ("Try to connect to ",
Image (Nodes (N).Address)));
delay until Next_Time;
......@@ -199,8 +199,8 @@ package body PolyORB_HI.Transport_Low_Level is
Send_Socket (Nodes (N).Socket_Send, SEC, SEO);
pragma Debug (Verbose,
Put_Line ("Connected to "
+ Image (Nodes (N).Address)));
Put_Line ("Connected to ",
Image (Nodes (N).Address)));
end if;
end loop;
......@@ -208,8 +208,8 @@ package body PolyORB_HI.Transport_Low_Level is
Suspend_Until_True (Other_Nodes_Init);
pragma Debug (Verbose,
Put_Line ("Initialization of socket subsystem"
+ " is complete"));
Put_Line
("Initialization of socket subsystem is complete"));
-- Unblock the receiver task
......@@ -247,8 +247,8 @@ package body PolyORB_HI.Transport_Low_Level is
if Nodes (My_Node).Address.Addr /= No_Inet_Addr then
pragma Debug (Verbose,
Put_Line ("Waiting on "
+ Image (Nodes (My_Node).Address)));
Put_Line ("Waiting on ",
Image (Nodes (My_Node).Address)));
for N in Nodes'Range loop
if N /= My_Node then
......@@ -266,8 +266,8 @@ package body PolyORB_HI.Transport_Low_Level is
Node := Corresponding_Node (Unsigned_8 (SEC (SEC'First)));
Nodes (Node).Socket_Receive := Socket;
pragma Debug (Verbose,
Put_Line ("Connection from node "
+ Node_Image (Node)));
Put_Line ("Connection from node ",
Node_Image (Node)));
end if;
end loop;
end if;
......@@ -308,24 +308,25 @@ package body PolyORB_HI.Transport_Low_Level is
Receive_Socket (Nodes (N).Socket_Receive, SEL, SEO);
pragma Debug (Verbose,
Put_Line ("SEL " + SEL'Length'Img
+ "MLS" + Message_Length_Size'Img));
Put_Line ("SEL ", SEL'Length'Img,
"MLS", Message_Length_Size'Img));
-- Receiving zero byte means that peer is dead
if SEO = 0 then
pragma Debug (Verbose,
Put_Line ("Node " + Node_Image (N)
+ " is dead"));
Put_Line
("Node ", Node_Image (N), " is dead"));
exit Main_Loop;
end if;
SEO := AS.Stream_Element_Offset
(To_Length (To_PO_HI_Message_Length_Stream (SEL)));
pragma Debug (Verbose,
Put_Line ("received"
+ AS.Stream_Element_Offset'Image (SEO)
+ " bytes from node "
+ Node_Image (N)));
Put_Line ("received",
AS.Stream_Element_Offset'Image (SEO),
" bytes from node ",
Node_Image (N)));
-- Get the message and preserve message length to keep
-- compatible with a local message delivery.
......@@ -348,11 +349,11 @@ package body PolyORB_HI.Transport_Low_Level is
exception
when E : others =>