Commit ba9eda38 authored by yoogx's avatar yoogx

* Change functions to procedure to reduce stack space

        For openaadl/ocarina#158
parent 9c9e7f1f
......@@ -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 ",
Thread_Port_Images (P)));
Most_Recent_Values (P) := S;
Most_Recent_Values (P).From := From;
Most_Recent_Values (P).Payload :=
Interface_To_Stream (Thread_Interface);
pragma Debug (Verbose,
Put_Line
......@@ -826,6 +863,7 @@ package body PolyORB_HI.Unprotected_Queue is
Thread_Port_Images (P), ". Done."));
end if;
end if;
if not Is_Event (P_Kind) then
Time_Stamps (P) := T;
......@@ -863,7 +901,9 @@ package body PolyORB_HI.Unprotected_Queue is
": Set_Most_Recent_Value: Global_Data_Queue_Size = ",
Integer'Image (Global_Data_Queue_Size)));
Global_Data_Queue (First + Offset - 1) := S;
Global_Data_Queue (First + Offset - 1).From := From;
Global_Data_Queue (First + Offset - 1).Payload :=
Interface_To_Stream (Thread_Interface);
pragma Debug
(Verbose,
......@@ -909,7 +949,10 @@ package body PolyORB_HI.Unprotected_Queue is
Global_Data_Queue (First + Offset - 1) :=
Global_Data_Queue (Last + Offset - 1);
Global_Data_Queue (Last + Offset - 1) := S;
Global_Data_Queue (Last + Offset - 1).From := From;
Global_Data_Queue (Last + Offset - 1).Payload :=
Interface_To_Stream (Thread_Interface);
pragma Debug
(Verbose,
......
......@@ -132,9 +132,16 @@ package PolyORB_HI.Unprotected_Queue is
-- Number of ports in the thread
function Interface_To_Stream is
new Ada.Unchecked_Conversion (Thread_Interface_Type, Port_Stream);
new Ada.Unchecked_Conversion (Thread_Interface_Type, Port_Stream);
-- function Interface_To_Stream (Input : Thread_Interface_Type)
-- return Port_Stream;
function Stream_To_Interface is
new Ada.Unchecked_Conversion (Port_Stream, Thread_Interface_Type);
new Ada.Unchecked_Conversion (Port_Stream, Thread_Interface_Type);
-- function Stream_To_Interface (Input : Port_Stream)
-- return Thread_Interface_Type;
type Port_Stream_Array is array (Port_Type) of Port_Stream_Entry;
......@@ -172,16 +179,16 @@ package PolyORB_HI.Unprotected_Queue is
-- False if there is nothing to receive.
procedure Dequeue
(T : Port_Type; P : out Port_Stream_Entry; Not_Empty : out Boolean);
(T : Port_Type; Not_Empty : out Boolean);
-- 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;
......@@ -197,7 +204,9 @@ package PolyORB_HI.Unprotected_Queue is
-- states.
procedure Store_In
(P : Port_Stream_Entry; T : Time; Not_Empty : out Boolean);
(Thread_Interface : Thread_Interface_Type;
From : Entity_Type;
T : Time; Not_Empty : out Boolean);
-- 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
......@@ -207,7 +216,9 @@ package PolyORB_HI.Unprotected_Queue 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.
......@@ -219,10 +230,14 @@ package PolyORB_HI.Unprotected_Queue is
-- The following are accessors to some internal data of the event queue