Skip to content

GitLab

P
PolyORB-HI-Ada
Commit eb5bfccc authored by yoogx's avatar yoogx
Browse files
Options

* Implement a "+" operator for string for concatenation, as 

          the regular "&" operator for concatenation is not (yet)
          supported by GNATProve as of version GPL2013
parent a947db2f
Expand all Show whitespace changes
Inline Side-by-side
Showing with 257 additions and 238 deletions
examples/aadlv2/ping/ping.adb
View file @ eb5bfccc
......@@ -51,7 +51,7 @@ package body Ping is
begin
Order := not Order;
Data_Source := Order;
Put_Line (Normal, "Sending ORDER: " & Opaque_Type'Image (Order));
Put_Line (Normal, "Sending ORDER: " + Opaque_Type'Image (Order));
end Do_Ping_Spg;
--------------------
......@@ -63,14 +63,14 @@ package body Ping is
Data_Source : out Simple_type)
is
begin
Put_Line (Normal, "ORDER: " & Opaque_Type'Image (Data_Sink));
Put_Line (Normal, "ORDER: " + Opaque_Type'Image (Data_Sink));
if Data_Sink then
Var := Var + 1;
Put_Line (Normal, "Sending (+1) PING" & Simple_Type'Image (Var));
Put_Line (Normal, "Sending (+1) PING" + Simple_Type'Image (Var));
else
Var := Var + 5;
Put_Line (Normal, "Sending (+5) PING" & Simple_Type'Image (Var));
Put_Line (Normal, "Sending (+5) PING" + Simple_Type'Image (Var));
end if;
Data_Source := Var;
......
src/polyorb_hi-aperiodic_task.adb
View file @ eb5bfccc
......@@ -64,8 +64,8 @@ package body PolyORB_HI.Aperiodic_Task is
(Put_Line
(Verbose,
"Aperiodic Task "
& Entity_Image (Entity)
& ": Wait initialization"));
+ Entity_Image (Entity)
+ ": Wait initialization"));
Suspend_Until_True (Task_Suspension_Objects (Entity));
delay until System_Startup_Time;
......@@ -73,7 +73,7 @@ package body PolyORB_HI.Aperiodic_Task is
pragma Debug (Put_Line
(Verbose,
"Aperiodic task initialized for entity "
& Entity_Image (Entity)));
+ Entity_Image (Entity)));
-- Main task loop
......@@ -83,8 +83,8 @@ package body PolyORB_HI.Aperiodic_Task is
(Put_Line
(Verbose,
"Aperiodic Task "
& Entity_Image (Entity)
& ": New Dispatch"));
+ Entity_Image (Entity)
+ ": New Dispatch"));
-- Block until an event is received
......@@ -94,8 +94,8 @@ package body PolyORB_HI.Aperiodic_Task is
(Put_Line
(Verbose,
"Aperiodic Task "
& Entity_Image (Entity)
& ": received event"));
+ Entity_Image (Entity)
+ ": received event"));
-- Execute the job
......
src/polyorb_hi-background_task.adb
View file @ eb5bfccc
......@@ -63,8 +63,8 @@ package body PolyORB_HI.Background_Task is
(Put_Line
(Verbose,
"Background Task "
& Entity_Image (Entity)
& ": Wait initialization"));
+ Entity_Image (Entity)
+ ": Wait initialization"));
Suspend_Until_True (Task_Suspension_Objects (Entity));
delay until System_Startup_Time;
......@@ -72,14 +72,14 @@ package body PolyORB_HI.Background_Task is
pragma Debug (Put_Line
(Verbose,
"Background task initialized for entity "
& Entity_Image (Entity)));
+ Entity_Image (Entity)));
pragma Debug
(Put_Line
(Verbose,
"Background Task "
& Entity_Image (Entity)
& ": Run job"));
+ Entity_Image (Entity)
+ ": Run job"));
Error := Job;
......
src/polyorb_hi-hybrid_task.adb
View file @ eb5bfccc
......@@ -65,8 +65,8 @@ package body PolyORB_HI.Hybrid_Task is
(Put_Line
(Verbose,
"Hybrid Task "
& Entity_Image (Entity)
& ": Wait initialization"));
+ Entity_Image (Entity)
+ ": Wait initialization"));
Suspend_Until_True (Task_Suspension_Objects (Entity));
delay until System_Startup_Time;
......@@ -74,7 +74,7 @@ package body PolyORB_HI.Hybrid_Task is
pragma Debug (Put_Line
(Verbose,
"Hybrid task initialized for entity "
& Entity_Image (Entity)));
+ Entity_Image (Entity)));
-- Run the initialize entrypoint (if any)
......@@ -87,8 +87,8 @@ package body PolyORB_HI.Hybrid_Task is
(Put_Line
(Verbose,
"Hybrid Task "
& Entity_Image (Entity)
& ": New Dispatch"));
+ Entity_Image (Entity)
+ ": New Dispatch"));
-- Block until an event is received
......@@ -98,8 +98,8 @@ package body PolyORB_HI.Hybrid_Task is
(Put_Line
(Verbose,
"Hybrid Task "
& Entity_Image (Entity)
& ": received event"));
+ Entity_Image (Entity)
+ ": received event"));
-- Calculate the next deadline according to the minimal
-- inter-arrival time.
......
src/polyorb_hi-hybrid_task_driver.adb
View file @ eb5bfccc
......@@ -104,7 +104,7 @@ package body PolyORB_HI.Hybrid_Task_Driver is
(Put_Line
(Verbose,
"Hybrid thread driver: Triggering task: "
& Entity_Image (T.The_Task)));
+ Entity_Image (T.The_Task)));
Trigger (T);
end if;
......@@ -144,7 +144,7 @@ package body PolyORB_HI.Hybrid_Task_Driver is
(Put_Line
(Verbose,
"Hybrid thread driver: Eligible task: "
& Entity_Image (T.The_Task)));
+ Entity_Image (T.The_Task)));
T.Eligible := True;
end if;
......
src/polyorb_hi-output.adb
View file @ eb5bfccc
......@@ -39,12 +39,23 @@ with System;
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
----------
-- Lock --
----------
protected Lock is
-- This lock has been defined to guarantee thread-safe output
-- display
procedure Put (Text : in String);
-- To guarantee thread-safe output display
procedure Put_Line (Text : in String);
-- To guarantee thread-safe output display
private
pragma Priority (System.Priority'Last);
......@@ -180,4 +191,17 @@ package body PolyORB_HI.Output is
Put_Line (Mode, Output);
end Dump;
---------
-- "+" --
---------
function "+" (S1 : String; S2 : String) return String is
S : String (1 .. S1'Length + S2'Length);
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;
src/polyorb_hi-output.ads
View file @ eb5bfccc
......@@ -63,25 +63,20 @@ package PolyORB_HI.Output is
procedure Put_Line (Text : in String);
-- As above but always displays the message
procedure Unprotected_Put_Line (Text : in String);
-- As above but this routine is not thread-safe
procedure Put (Mode : in Verbosity := Normal; Text : in String);
-- Display Text iff Mode is greater than Current_Mode. This
-- routine is thread-safe.
procedure Put (Text : in String);
-- As above but displays the message reguards less the mode
procedure Unprotected_Put (Text : in String);
-- As above but this routine is not thread-safe
-- As above but always displays the message
procedure Dump (Stream : Stream_Element_Array; Mode : Verbosity := Verbose);
-- Dump the content of Stream in an hexadecimal format
function "+" (S1 : String; S2 : String) return String;
private
pragma Inline (Put_Line);
pragma Inline (Unprotected_Put_Line);
end PolyORB_HI.Output;
src/polyorb_hi-periodic_task.adb
View file @ eb5bfccc
......@@ -63,8 +63,8 @@ package body PolyORB_HI.Periodic_Task is
(Put_Line
(Verbose,
"Periodic Task "
& Entity_Image (Entity)
& ": Wait initialization"));
+ Entity_Image (Entity)
+ ": Wait initialization"));
Suspend_Until_True (Task_Suspension_Objects (Entity));
Next_Start := System_Startup_Time + Dispatch_Offset;
......@@ -81,7 +81,7 @@ package body PolyORB_HI.Periodic_Task is
pragma Debug
(Put_Line
(Verbose,
"Periodic Task " & Entity_Image (Entity) & ": New Cycle"));
"Periodic Task " + Entity_Image (Entity) + ": New Cycle"));
-- Execute the task's job
......@@ -94,8 +94,8 @@ package body PolyORB_HI.Periodic_Task is
-- T := Ada.Real_Time.Clock;
-- if T > Next_Start then
-- Put_Line (Normal, "***** Overload detected in task "
-- & Entity_Image (Entity) & " *****");
-- Put_Line (Normal, "Lag: " &
-- + Entity_Image (Entity) + " *****");
-- Put_Line (Normal, "Lag: " +
-- Duration'Image (To_Duration (Next_Start - T)));
-- end if;
......
src/polyorb_hi-sporadic_task.adb
View file @ eb5bfccc
......@@ -67,8 +67,8 @@ package body PolyORB_HI.Sporadic_Task is
(Put_Line
(Verbose,
"Sporadic Task "
& Entity_Image (Entity)
& ": Wait initialization"));
+ Entity_Image (Entity)
+ ": Wait initialization"));
Suspend_Until_True (Task_Suspension_Objects (Entity));
-- delay until System_Startup_Time;
......@@ -76,7 +76,7 @@ package body PolyORB_HI.Sporadic_Task is
pragma Debug (Put_Line
(Verbose,
"Sporadic task initialized for entity "
& Entity_Image (Entity)));
+ Entity_Image (Entity)));
-- Main task loop
......@@ -86,8 +86,8 @@ package body PolyORB_HI.Sporadic_Task is
(Put_Line
(Verbose,
"Sporadic Task "
& Entity_Image (Entity)
& ": New Dispatch"));
+ Entity_Image (Entity)
+ ": New Dispatch"));
-- Block until an event is received
......@@ -97,8 +97,8 @@ package body PolyORB_HI.Sporadic_Task is
(Put_Line
(Verbose,
"Sporadic Task "
& Entity_Image (Entity)
& ": received event"));
+ Entity_Image (Entity)
+ ": received event"));
-- Calculate the next start time according to the minimal
-- inter-arrival time.
......
src/polyorb_hi-suspenders.adb
View file @ eb5bfccc
......@@ -72,15 +72,15 @@ package body PolyORB_HI.Suspenders is
pragma Debug
(Put_Line
(Verbose, "Unblocking task "
& PolyORB_HI_Generated.Deployment.Entity_Image (J)));
+ PolyORB_HI_Generated.Deployment.Entity_Image (J)));
Set_True (Task_Suspension_Objects (J));
pragma Debug
(Put_Line
(Verbose, "Task "
& PolyORB_HI_Generated.Deployment.Entity_Image (J)
& " unblocked"));
+ PolyORB_HI_Generated.Deployment.Entity_Image (J)
+ " unblocked"));
end loop;
end Unblock_All_Tasks;
......
src/polyorb_hi-thread_interrogators.adb
View file @ eb5bfccc
This diff is collapsed.
src/polyorb_hi-transport_low_level_sockets.adb
View file @ eb5bfccc
......@@ -158,7 +158,7 @@ package body PolyORB_HI.Transport_Low_Level is
pragma Debug (Put_Line
(Verbose,
"Local socket created for "
& Image (Nodes (My_Node).Address)));
+ Image (Nodes (My_Node).Address)));
end if;
-- Start the protocol handler task
......@@ -179,7 +179,7 @@ package body PolyORB_HI.Transport_Low_Level is
pragma Debug
(Put_Line
(Verbose,
"Try to connect to " & Image (Nodes (N).Address)));
"Try to connect to " + Image (Nodes (N).Address)));
delay until Next_Time;
......@@ -198,14 +198,14 @@ package body PolyORB_HI.Transport_Low_Level is
pragma Debug (Put_Line
(Verbose,
"Connected to " & Image (Nodes (N).Address)));
"Connected to " + Image (Nodes (N).Address)));
end if;
end loop;
Suspend_Until_True (Other_Nodes_Init);
pragma Debug (Put_Line (Verbose, "Initialization of socket subsystem"
& " is complete"));
+ " is complete"));
-- Unblock the receiver task
......@@ -244,7 +244,7 @@ package body PolyORB_HI.Transport_Low_Level is
if Nodes (My_Node).Address.Addr /= No_Inet_Addr then
pragma Debug (Put_Line
(Verbose, "Waiting on "
& Image (Nodes (My_Node).Address)));
+ Image (Nodes (My_Node).Address)));
for N in Nodes'Range loop
if N /= My_Node then
......@@ -262,7 +262,7 @@ package body PolyORB_HI.Transport_Low_Level is
Node := Corresponding_Node (Unsigned_8 (SEC (SEC'First)));
Nodes (Node).Socket_Receive := Socket;
pragma Debug (Put_Line (Verbose, "Connection from node "
& Node_Image (Node)));
+ Node_Image (Node)));
end if;
end loop;
......@@ -304,15 +304,15 @@ package body PolyORB_HI.Transport_Low_Level is
-- Receive message length
Receive_Socket (Nodes (N).Socket_Receive, SEL, SEO);
pragma Debug (Put_Line (Verbose, "SEL " & SEL'Length'Img
& "MLS" & Message_Length_Size'Img));
pragma Debug (Put_Line (Verbose, "SEL " + SEL'Length'Img
+ "MLS" + Message_Length_Size'Img));
-- Receiving zero byte means that peer is dead
if SEO = 0 then
pragma Debug (Put_Line
(Verbose,
"Node " & Node_Image (N)
& " is dead"));
"Node " + Node_Image (N)
+ " is dead"));
exit Main_Loop;
end if;
......@@ -321,8 +321,8 @@ package body PolyORB_HI.Transport_Low_Level is
pragma Debug (Put_Line
(Verbose,
"received"
& AS.Stream_Element_Offset'Image (SEO)
& " bytes from node " & Node_Image (N)));
+ 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.
......@@ -346,10 +346,10 @@ package body PolyORB_HI.Transport_Low_Level is
when E : others =>
pragma Debug (Put_Line
(Normal, "Exception "
& Ada.Exceptions.Exception_Name (E)));
+ Ada.Exceptions.Exception_Name (E)));
pragma Debug (Put_Line
(Normal, "Message "
& Ada.Exceptions.Exception_Message (E)));
+ Ada.Exceptions.Exception_Message (E)));
null;
end Receiver_Task;
......@@ -373,7 +373,7 @@ package body PolyORB_HI.Transport_Low_Level is
for Msg'Address use Message'Address;
begin
pragma Debug (Put_Line (Verbose, "Sending message, size:" & L'Img));
pragma Debug (Put_Line (Verbose, "Sending message, size:" + L'Img));
Send_Socket (Nodes (Node).Socket_Send, Msg, L);
return Error_Kind'(Error_None);
......@@ -381,10 +381,10 @@ package body PolyORB_HI.Transport_Low_Level is
when E : others =>
pragma Debug (Put_Line
(Normal, "Exception "
& Ada.Exceptions.Exception_Name (E)));
+ Ada.Exceptions.Exception_Name (E)));
pragma Debug (Put_Line
(Normal, "Message "
& Ada.Exceptions.Exception_Message (E)));
+ Ada.Exceptions.Exception_Message (E)));
return Error_Kind'(Error_Transport);
end Send;
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment