Commit a0e3f7a9 authored by Maxime Perrotin's avatar Maxime Perrotin
parents c6cb9e9a 53cc708b
Jerome Hugues <jerome.hugues@enst.fr>
Stephane Lanarre <stephane.lanarre@enst.fr>
Laurent Pautet <laurent.pautet@enst.fr>
Bechir Zalila <bechir.zalila@enst.fr>
Current maintainer is
- Jerome Hugues
Contributor
- Stephane Lanarre (2009)
The initial design team of PolyORB-HI/C was
- Jerome Hugues
- Laurent Pautet (up to 2009)
- Bechir Zalila (up to 2008)
......@@ -26,8 +26,8 @@ end Array_Type;
data implementation Array_Type.I
properties
Data_Model::Data_Representation => array;
Data_Model::Dimension => (4);
Data_Model::Base_Type => (classifier (Software::Integer_Type));
Data_Model::Dimension => (4_000);
Data_Model::Base_Type => (classifier (Software::Integer_Type));
end Array_Type.I;
data String_Type
......@@ -117,7 +117,7 @@ features
end Emitter_Wrapper;
subprogram implementation Emitter_Wrapper.Impl
calls
calls
Mycalls : {
B_Spg : subprogram Emit_Boolean;
I_Spg : subprogram Emit_Integer;
......@@ -144,7 +144,7 @@ features
end Emitter;
thread implementation Emitter.Impl
calls
calls
Mycall : {
Emitter_Wrapper : subprogram Emitter_Wrapper.Impl;
};
......@@ -164,7 +164,7 @@ features
end Boolean_Receiver;
thread implementation Boolean_Receiver.Impl
calls
calls
Mycall : {
B_Spg : subprogram Receive_Boolean;
};
......@@ -181,7 +181,7 @@ features
end Integer_Receiver;
thread implementation Integer_Receiver.Impl
calls
calls
Mycall : {
I_Spg : subprogram Receive_Integer;
};
......@@ -198,7 +198,7 @@ features
end Array_Receiver;
thread implementation Array_Receiver.Impl
calls
calls
Mycall : {
I_Spg : subprogram Receive_Array;
};
......@@ -215,7 +215,7 @@ features
end String_Receiver;
thread implementation String_Receiver.Impl
calls
calls
Mycall : {
S_Spg : subprogram Receive_String;
};
......
......@@ -40,7 +40,7 @@ package body Some_Types_Pkg is
Boolean_Type_Var : Boolean_Type := False;
Integer_Type_Var : Integer_Type := 0;
Array_Type_I_Var : Array_Type_I := (1, 2, 3, 4);
Array_Type_I_Var : Array_Type_I := (1, 2, 3, 4, others => 0);
String_Array : constant array (Integer range <>) of String_Type :=
(To_Bounded_String ("Bounded string message"),
To_Bounded_String ("Longer bounded string message"),
......@@ -99,10 +99,12 @@ package body Some_Types_Pkg is
procedure Emit_Array (Data_Source : out Array_Type_I) is
begin
Data_Source := Array_Type_I_Var;
Array_Type_I_Var := (Array_Type_I_Var (2),
Array_Type_I_Var (3),
Array_Type_I_Var (4),
Array_Type_I_Var (1));
Array_Type_I_Var (Array_Type_I_Var'First .. Array_Type_I_Var'First + 3)
:= (Array_Type_I_Var (2),
Array_Type_I_Var (3),
Array_Type_I_Var (4),
Array_Type_I_Var (1));
Put_Line
("***** Emitting Array : ("
& Integer_Type'Image (Data_Source (1))
......
......@@ -92,16 +92,16 @@ package body PolyORB_HI.Thread_Interrogators is
-- Same as 'Wait_Event' but without blocking. Valid is set to
-- False if there is nothing to receive.
procedure Dequeue (T : Port_Type; P : out Port_Stream_Entry);
procedure Dequeue (T : Port_Type);
-- Dequeue a value from the partial FIFO of port T. If there is
-- no enqueued value, return the latest dequeued value.
function Read_In (T : Port_Type) return Port_Stream_Entry;
procedure Read_In (T : Port_Type; P : out Port_Stream_Entry);
-- Read the oldest queued value on the partial FIFO of IN port
-- T without dequeuing it. If there is no queued value, return
-- the latest dequeued value.
function Read_Out (T : Port_Type) return Port_Stream_Entry;
procedure Read_Out (T : Port_Type; P : out Port_Stream_Entry);
-- Return the value put for OUT port T.
function Is_Invalid (T : Port_Type) return Boolean;
......@@ -116,7 +116,9 @@ package body PolyORB_HI.Thread_Interrogators is
-- function and functions cannot modify protected object
-- states.
procedure Store_In (P : Port_Stream_Entry; T : Time);
procedure Store_In (Thread_Interface : Thread_Interface_Type;
From : Entity_Type;
T : Time);
-- Stores a new incoming message in its corresponding
-- position. If this is an event [data] incoming message, then
-- stores it in the queue, updates its most recent value and
......@@ -126,7 +128,9 @@ package body PolyORB_HI.Thread_Interrogators is
-- indicates the instant from which the data of P becomes
-- deliverable.
procedure Store_Out (P : Port_Stream_Entry; T : Time);
procedure Store_Out (Thread_Interface : Thread_Interface_Type;
From : Entity_Type;
T : Time);
-- Store a value of an OUT port to be sent at the next call to
-- Send_Output and mark the value as valid.
......@@ -176,27 +180,27 @@ package body PolyORB_HI.Thread_Interrogators is
-- Dequeue --
-------------
procedure Dequeue (T : Port_Type; P : out Port_Stream_Entry) is
procedure Dequeue (T : Port_Type) is
begin
UQ.Dequeue (T, P, Not_Empty);
UQ.Dequeue (T, Not_Empty);
end Dequeue;
-------------
-- Read_In --
-------------
function Read_In (T : Port_Type) return Port_Stream_Entry is
procedure Read_In (T : Port_Type; P : out Port_Stream_Entry) is
begin
return UQ.Read_In (T);
UQ.Read_In (T, P);
end Read_In;
--------------
-- Read_Out --
--------------
function Read_Out (T : Port_Type) return Port_Stream_Entry is
procedure Read_Out (T : Port_Type; P : out Port_Stream_Entry) is
begin
return UQ.Read_Out (T);
UQ.Read_Out (T, P);
end Read_Out;
----------------
......@@ -221,18 +225,22 @@ package body PolyORB_HI.Thread_Interrogators is
-- Store_In --
--------------
procedure Store_In (P : Port_Stream_Entry; T : Time) is
procedure Store_In (Thread_Interface : Thread_Interface_Type;
From : Entity_Type;
T : Time) is
begin
UQ.Store_In (P, T, Not_Empty);
UQ.Store_In (Thread_Interface, From, T, Not_Empty);
end Store_In;
---------------
-- Store_Out --
---------------
procedure Store_Out (P : Port_Stream_Entry; T : Time) is
procedure Store_Out (Thread_Interface : Thread_Interface_Type;
From : Entity_Type;
T : Time) is
begin
UQ.Store_Out (P, T);
UQ.Store_Out (Thread_Interface, From, T);
end Store_Out;
-----------
......@@ -259,26 +267,33 @@ package body PolyORB_HI.Thread_Interrogators is
-- Send_Output --
-----------------
Send_Output_Message : PolyORB_HI.Messages.Message_Type;
-- This variable is used only by the Send_Output function,
-- protected by the protected object.
PSE : Port_Stream_Entry;
function Send_Output (Port : Port_Type) return Error_Kind is
type Port_Type_Array is array (Positive)
type Port_Type_Array is array (Positive)
of PolyORB_HI_Generated.Deployment.Port_Type;
type Port_Type_Array_Access is access Port_Type_Array;
type Port_Type_Array_Access is access Port_Type_Array;
function To_Pointer is new Ada.Unchecked_Conversion
function To_Pointer is new Ada.Unchecked_Conversion
(System.Address, Port_Type_Array_Access);
Dst : constant Port_Type_Array_Access :=
Dst : constant Port_Type_Array_Access :=
To_Pointer (Destinations (Port));
N_Dst : Integer renames N_Destinations (Port);
P_Kind : Port_Kind renames Thread_Port_Kinds (Port);
Message : PolyORB_HI.Messages.Message_Type;
Value : constant Thread_Interface_Type := Stream_To_Interface
(Global_Queue.Read_Out (Port).Payload);
N_Dst : Integer renames N_Destinations (Port);
P_Kind : Port_Kind renames Thread_Port_Kinds (Port);
Value : Thread_Interface_Type (Port);
Error : Error_Kind := Error_None;
begin
Global_Queue.Read_Out (Port, PSE);
Value := Stream_To_Interface (PSE.Payload);
pragma Debug (Verbose,
Put_Line (Entity_Image (Current_Entity),
": Send_Output: port ",
......@@ -304,19 +319,19 @@ package body PolyORB_HI.Thread_Interrogators is
-- First, we marshall the destination
Port_Type_Marshallers.Marshall
(Internal_Code (Dst (To)), Message);
(Internal_Code (Dst (To)), Send_Output_Message);
-- Then marshall the time stamp in case of a data port
if not Is_Event (P_Kind) then
Time_Marshallers.Marshall
(Global_Queue.Get_Time_Stamp (Port),
Message);
Send_Output_Message);
end if;
-- Then we marshall the value corresponding to the port
Marshall (Value, Message);
Marshall (Value, Send_Output_Message);
pragma Debug
(Verbose,
......@@ -325,8 +340,9 @@ package body PolyORB_HI.Thread_Interrogators is
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);
Error := Send (Current_Entity, Port_Table (Dst (To)),
Send_Output_Message);
PolyORB_HI.Messages.Reallocate (Send_Output_Message);
if Error /= Error_None then
return Error;
......@@ -353,8 +369,7 @@ package body PolyORB_HI.Thread_Interrogators is
": Put_Value"));
Global_Queue.Store_Out
((Current_Entity, Interface_To_Stream (Thread_Interface)),
Next_Deadline);
(Thread_Interface, Current_Entity, Next_Deadline);
end Put_Value;
-------------------
......@@ -371,15 +386,30 @@ package body PolyORB_HI.Thread_Interrogators is
-- Get_Value --
---------------
procedure Get_Value (Port : Port_Type;
Result : in out Thread_Interface_Type)
is
begin
Global_Queue.Read_In (Port, PSE);
pragma Debug (Verbose,
Put_Line (Entity_Image (Current_Entity),
": Get_Value: Value of port ",
Thread_Port_Images (Port), " got"));
Result := Stream_To_Interface (PSE.Payload);
end Get_Value;
function Get_Value (Port : Port_Type) return Thread_Interface_Type is
Stream : constant Port_Stream := Global_Queue.Read_In (Port).Payload;
T_Port : constant Thread_Interface_Type := Stream_To_Interface (Stream);
begin
Global_Queue.Read_In (Port, PSE);
pragma Debug (Verbose,
Put_Line (Entity_Image (Current_Entity),
": Get_Value: Value of port ",
Thread_Port_Images (Port), " got"));
return T_Port;
return Stream_To_Interface (PSE.Payload);
end Get_Value;
----------------
......@@ -387,15 +417,15 @@ package body PolyORB_HI.Thread_Interrogators is
----------------
function Get_Sender (Port : Port_Type) return Entity_Type is
Sender : constant Entity_Type := Global_Queue.Read_In (Port).From;
begin
Global_Queue.Read_In (Port, PSE);
pragma Debug (Verbose,
Put_Line (Entity_Image (Current_Entity),
": Get_Sender: Value of sender to port ",
Thread_Port_Images (Port),
Entity_Image (Sender)));
Entity_Image (PSE.From)));
return Sender;
return PSE.From;
end Get_Sender;
---------------
......@@ -419,14 +449,13 @@ package body PolyORB_HI.Thread_Interrogators is
----------------
procedure Next_Value (Port : Port_Type) is
P : Port_Stream_Entry;
begin
pragma Debug (Verbose,
Put_Line (Entity_Image (Current_Entity),
": Next_Value for port ",
Thread_Port_Images (Port)));
Global_Queue.Dequeue (Port, P);
Global_Queue.Dequeue (Port);
end Next_Value;
------------------------------
......@@ -490,7 +519,7 @@ package body PolyORB_HI.Thread_Interrogators is
": Store_Received_Message"));
Global_Queue.Store_In
((From, Interface_To_Stream (Thread_Interface)), Time_Stamp);
(Thread_Interface, From, Time_Stamp);
end Store_Received_Message;
--------------------
......
......@@ -159,6 +159,8 @@ package PolyORB_HI.Thread_Interrogators is
-- during the current dispatch. The parameter of the function has
-- the only utility to allow having one Receive_Input per thread.
procedure Get_Value (Port : Port_Type;
Result : in out Thread_Interface_Type);
function Get_Value (Port : Port_Type) return Thread_Interface_Type;
-- Return the value corresponding to a given port. A second call to
-- Get_Value returns always the same value unless Next_Value has
......
......@@ -36,6 +36,26 @@ package body PolyORB_HI.Unprotected_Queue is
use PolyORB_HI.Port_Kinds;
use PolyORB_HI.Output;
-- function Interface_To_Stream
-- (Input : Thread_Interface_Type)
-- return Port_Stream
-- is
-- Result : Port_Stream with
-- Import, Convention => Ada, Address => Input'Address;
-- begin
-- return Result;
-- end Interface_To_Stream;
-- function Stream_To_Interface
-- (Input : Port_Stream)
-- return Thread_Interface_Type
-- is
-- Result : Thread_Interface_Type (Port_Type'First) with
-- Import, Convention => Ada, Address => Input'Address;
-- begin
-- return Result;
-- end Stream_To_Interface;
----------------
-- Read_Event --
----------------
......@@ -65,7 +85,7 @@ package body PolyORB_HI.Unprotected_Queue is
procedure Dequeue
(T : Port_Type;
P : out Port_Stream_Entry;
-- P : out Port_Stream_Entry;
Not_Empty : out Boolean)
is
Is_Empty : Boolean renames Empties (T);
......@@ -90,7 +110,8 @@ package body PolyORB_HI.Unprotected_Queue is
": Dequeue: Empty queue for ",
Thread_Port_Images (T)));
P := Get_Most_Recent_Value (T);
-- P := Get_Most_Recent_Value (T);
null;
elsif FIFO_Size = 0 then
-- If the FIFO is empty or non-existent, return the
......@@ -102,7 +123,8 @@ package body PolyORB_HI.Unprotected_Queue is
": Dequeue: NO FIFO for ",
Thread_Port_Images (T)));
P := Get_Most_Recent_Value (T);
-- P := Get_Most_Recent_Value (T);
null;
else
pragma Debug (Verbose,
......@@ -121,7 +143,8 @@ package body PolyORB_HI.Unprotected_Queue is
Is_Empty := True;
end if;
P := Global_Data_Queue (First + Offset - 1);
-- P := Global_Data_Queue (First + Offset - 1);
null;
if First = FIFO_Size then
First := Default_Index_Value;
......@@ -144,8 +167,7 @@ package body PolyORB_HI.Unprotected_Queue is
-- Read_In --
-------------
function Read_In (T : Port_Type) return Port_Stream_Entry is
P : Port_Stream_Entry;
procedure Read_In (T : Port_Type; P : out Port_Stream_Entry) is
Is_Empty : Boolean renames Empties (T);
First : Integer renames Firsts (T);
FIFO_Size : Integer renames Thread_FIFO_Sizes (T);
......@@ -168,7 +190,7 @@ package body PolyORB_HI.Unprotected_Queue is
Thread_Port_Images (T),
". Reading the last stored value."));
P := Get_Most_Recent_Value (T);
Get_Most_Recent_Value (T, P);
else
pragma Debug (Verbose,
Put_Line
......@@ -189,14 +211,13 @@ package body PolyORB_HI.Unprotected_Queue is
(Entity_Image (Current_Entity),
": Read_In: Value read from port ",
Thread_Port_Images (T)));
return P;
end Read_In;
--------------
-- Read_Out --
--------------
function Read_Out (T : Port_Type) return Port_Stream_Entry is
procedure Read_Out (T : Port_Type; P : out Port_Stream_Entry) is
begin
-- There is no need here to go through the Get_ routine
-- since we are sending, not receiving.
......@@ -207,7 +228,7 @@ package body PolyORB_HI.Unprotected_Queue is
": Read_Out: Value read from port ",
Thread_Port_Images (T)));
return Most_Recent_Values (T);
P := Most_Recent_Values (T);
end Read_Out;
----------------
......@@ -238,11 +259,12 @@ package body PolyORB_HI.Unprotected_Queue is
-- Store_In --
--------------
procedure Store_In (P : Port_Stream_Entry;
Store_In_Stream : Port_Stream;
procedure Store_In (Thread_Interface : Thread_Interface_Type;
From : Entity_Type;
T : Time;
Not_Empty : out Boolean) is
Thread_Interface : constant Thread_Interface_Type
:= Stream_To_Interface (P.Payload);
PT : Port_Type renames Thread_Interface.Port;
Is_Empty : Boolean renames Empties (PT);
First : Integer renames Firsts (PT);
......@@ -282,7 +304,12 @@ package body PolyORB_HI.Unprotected_Queue is
when DropOldest =>
-- Drop the oldest element in the FIFO
Global_Data_Queue (First + Offset - 1) := P;
Store_In_Stream :=
Interface_To_Stream (Thread_Interface);
Global_Data_Queue (First + Offset - 1).From := From;
Global_Data_Queue (First + Offset - 1).Payload
:= Store_In_Stream;
pragma Debug
(Verbose,
Put_Line
......@@ -333,7 +360,10 @@ package body PolyORB_HI.Unprotected_Queue is
when DropNewest =>
-- Drop the newest element in the FIFO
Global_Data_Queue (Last + Offset - 1) := P;
Global_Data_Queue (First + Offset - 1).From := From;
Global_Data_Queue (First + Offset - 1).Payload
:= Interface_To_Stream (Thread_Interface);
pragma Debug
(Verbose,
Put_Line
......@@ -368,7 +398,7 @@ package body PolyORB_HI.Unprotected_Queue is
Put_Line
(Entity_Image (Current_Entity),
": Store_In: FIFO is full");
-- XXX SHould raise an exception there !
-- XXX SHould raise an exception there !
end case;
-- Remove event in the history and shift
......@@ -418,7 +448,10 @@ package body PolyORB_HI.Unprotected_Queue is
Last := Big_Port_Index_Type'Succ (Last);
end if;
Global_Data_Queue (Last + Offset - 1) := P;
Global_Data_Queue (First + Offset - 1).From := From;
Global_Data_Queue (First + Offset - 1).Payload
:= Interface_To_Stream (Thread_Interface);
pragma Debug (Verbose,
Put_Line
(Entity_Image (Current_Entity),
......@@ -502,7 +535,7 @@ package body PolyORB_HI.Unprotected_Queue is
-- Update the most recent value corresponding to port PT
Set_Most_Recent_Value (PT, P, T);
Set_Most_Recent_Value (PT, From, Thread_Interface, T);
pragma Debug (Verbose,
Put_Line
......@@ -527,7 +560,7 @@ package body PolyORB_HI.Unprotected_Queue is
": Store_In: Storing Data message in DATA port ",
Thread_Port_Images (PT)));
Set_Most_Recent_Value (PT, P, T);
Set_Most_Recent_Value (PT, From, Thread_Interface, T);
pragma Debug (Verbose,
Put_Line
......@@ -542,9 +575,10 @@ package body PolyORB_HI.Unprotected_Queue is
-- Store_Out --
---------------
procedure Store_Out (P : Port_Stream_Entry; T : Time) is
Thread_Interface : constant Thread_Interface_Type
:= Stream_To_Interface (P.Payload);
procedure Store_Out (Thread_Interface : Thread_Interface_Type;
From : Entity_Type;
T : Time)
is
PT : Port_Type renames Thread_Interface.Port;
begin
pragma Debug (Verbose,
......@@ -566,11 +600,12 @@ package body PolyORB_HI.Unprotected_Queue is
-- No need to go through the Set_ routine since we are
-- sending, not receiving.
Most_Recent_Values (PT) := P;
Most_Recent_Values (PT).From := From;
Most_Recent_Values (PT).Payload := Interface_To_Stream (Thread_Interface);
Time_Stamps (PT) := T; -- overwritten below
-- Maxime workaround for backdoor accesses
Time_Stamps (PT) := Ada.Real_time.clock;
Time_Stamps (PT) := Ada.Real_Time.clock;
end Store_Out;
-----------
......@@ -650,9 +685,9 @@ package body PolyORB_HI.Unprotected_Queue is
-- Get_Most_Recent_Value --
---------------------------
function Get_Most_Recent_Value
(P : Port_Type)
return Port_Stream_Entry
procedure Get_Most_Recent_Value
(P : Port_Type;
S : out Port_Stream_Entry)
is
First : Integer renames Firsts (P);
Last : Integer renames Lasts (P);
......@@ -660,7 +695,7 @@ package body PolyORB_HI.Unprotected_Queue is
FIFO_Size : Integer renames Thread_FIFO_Sizes (P);
Offset : Integer renames Thread_FIFO_Offsets (P);
T : constant Time := Clock;
S : Port_Stream_Entry;
begin
if Has_Event_Ports then
if Is_Event (P_Kind) then
......@@ -674,6 +709,7 @@ package body PolyORB_HI.Unprotected_Queue is
S := Most_Recent_Values (P);
end if;
end if;
if not Is_Event (P_Kind) then
if FIFO_Size = 1 then
-- Immediate connection
......@@ -717,7 +753,7 @@ package body PolyORB_HI.Unprotected_Queue is
Put_Line
(Entity_Image (Current_Entity),
": Get_Most_Recent_Value: Most recent value for data port ",
Thread_Port_Images (P), " got. Immediate connection"));
Thread_Port_Images (P), " got. Immediate connection"));
else
-- Delayed connection: The element indexed by First is
......@@ -780,8 +816,6 @@ package body PolyORB_HI.Unprotected_Queue is
" got. Delayed connection"));
end if;
end if;
return S;
end Get_Most_Recent_Value;
---------------------------
......@@ -790,7 +824,8 @@ package body PolyORB_HI.Unprotected_Queue is
procedure Set_Most_Recent_Value
(P : Port_Type;
S : Port_Stream_Entry;
From : Entity_Type;
Thread_Interface : Thread_Interface_Type;
T : Time)
is
First : Big_Port_Index_Type renames Firsts (P);
......@@ -817,7 +852,9 @@ package body PolyORB_HI.Unprotected_Queue is
": Set_Most_Recent_Value: event [data] port ",