Commits (2)
-- ************************ TASTE AADL Parser ************************** --
-- Based on Ocarina **************************************************** --
-- (c) 2019-2020 Maxime Perrotin / ESA - maxime.perrotin@esa.int
-- (c) 2019-2021 Maxime Perrotin / ESA - maxime.perrotin@esa.int
-- ********************************************************************* --
--
with System.Assertions,
......@@ -343,12 +343,13 @@ package body TASTE.AADL_Parser is
-- Find the output ports of a thread by following the connections
function Get_Output_Ports (Model : TASTE_Model;
F : Taste_Terminal_Function) return Ports.Map
F : Taste_Terminal_Function)
return Ports.Vector
is
Result : Ports.Map;
Result : Ports.Vector;
Visited_Functions : String_Sets.Set;
procedure Rec_Find_Thread (Ports_Map : in out Ports.Map;
procedure Rec_Find_Thread (Ports_List : in out Ports.Vector;
Visited : in out String_Sets.Set;
Func : Taste_Terminal_Function) is
use String_Sets;
......@@ -374,9 +375,9 @@ package body TASTE.AADL_Parser is
if RI.RCM = Unprotected_Operation or RI.RCM = Protected_Operation
then
Rec_Find_Thread (Ports_Map => Ports_Map,
Visited => Visited,
Func =>
Rec_Find_Thread (Ports_List => Ports_List,
Visited => Visited,
Func =>
Model.Interface_View.Flat_Functions
(To_String
(RI.Remote_Interfaces.First_Element.Function_Name)));
......@@ -390,24 +391,29 @@ package body TASTE.AADL_Parser is
Remote_Thread_Name : constant Unbounded_String :=
To_Lower (To_String (Dist.Function_Name))
& "_" & Dist.Interface_Name;
Port_Name : constant Unbounded_String := RI.Name;
-- The port name cannot be RI.Name because that could
-- cause multiple ports with the same name if more than
-- one function connected through a chain of sync calls
-- have a RI of that name.
-- Port_Name : constant Unbounded_String := RI.Name;
Port_Name : constant Unbounded_String :=
Dist.Function_Name & "_" & RI.Name;
New_P : constant Thread_Port :=
(Name => Port_Name,
Remote_Thread => Remote_Thread_Name,
Remote_PI => Dist.Interface_Name,
RI => RI);
begin
Ports_Map.Include (Key => To_String (Port_Name),
New_Item => New_P);
Ports_List.Append (New_Item => New_P);
end;
end if;
<<Continue>>
end loop;
end Rec_Find_Thread;
begin
Rec_Find_Thread (Ports_Map => Result,
Visited => Visited_Functions,
Func => F);
Rec_Find_Thread (Ports_List => Result,
Visited => Visited_Functions,
Func => F);
return Result;
end Get_Output_Ports;
......@@ -637,7 +643,8 @@ package body TASTE.AADL_Parser is
Partition.Out_Ports.Insert
(Key => To_String (Out_Port.RI.Name),
New_Item => (Port_Name =>
Out_Port.RI.Name,
-- Out_Port.RI.Name,
Out_Port.Name,
Connected_Threads =>
String_Vectors.Empty_Vector
& To_String (T.Name),
......
......@@ -5,6 +5,7 @@
-- Model of the Concurrency View
with Ada.Containers.Indefinite_Ordered_Maps,
Ada.Containers.Indefinite_Vectors,
Ada.Strings.Unbounded,
Ada.Strings.Equal_Case_Insensitive,
Ada.Strings.Less_Case_Insensitive,
......@@ -72,7 +73,7 @@ package TASTE.Concurrency_View is
RI : Taste_Interface;
end record;
package Ports is new Indefinite_Ordered_Maps (String, Thread_Port);
package Ports is new Indefinite_Vectors (Natural, Thread_Port);
type AADL_Thread is tagged
record
......@@ -82,7 +83,7 @@ package TASTE.Concurrency_View is
Need_Mutex : Boolean := False;
Entry_Port_Name : Unbounded_String;
Protected_Block_Name : Unbounded_String;
Output_Ports : Ports.Map;
Output_Ports : Ports.Vector;
Node : Option_Node.Option;
Priority,
Dispatch_Offset_Ms,
......
......@@ -774,7 +774,7 @@ package body TASTE.Deployment_View is
-- Update the information in the deployment view
C_DV.Source_Function := C_IV.Caller;
C_DV.Source_Port := C_IV.RI_Name;
C_DV.Source_Port := C_IV.Callee & "_" & C_IV.RI_Name;
C_DV.Dest_Function := C_IV.Callee;
C_DV.Dest_Port := C_IV.PI_Name;
end if;
......
......@@ -144,6 +144,26 @@ package body TASTE.Parser_Utils is
Sep => Sep));
end Join_Strings;
function Filter_First_Elem
(unused_Value, Parameters : String;
Context : Filter_Context) return String
is
Assoc : Association;
Table : Tag;
begin
Assoc := Get (Context.Translations, Parameters);
if Assoc = Null_Association then
return "";
end if;
Table := Get (Assoc);
return Item (Table, 1);
exception
when Constraint_Error =>
-- If Association is not a Tag (table) or if zero elements
return "";
end Filter_First_Elem;
function Filter_Uniq
(Value, Parameters : String;
unused_Context : Filter_Context) return String
......@@ -500,4 +520,5 @@ package body TASTE.Parser_Utils is
end Join_Sets;
begin
Register_Filter ("UNIQ", Filter_Uniq'Access);
Register_Filter ("FIRST_ELEM", Filter_First_Elem'Access);
end TASTE.Parser_Utils;
......@@ -85,6 +85,12 @@ package TASTE.Parser_Utils is
(Value, Parameters : String;
unused_Context : Filter_Context) return String;
-- Return the first value in a table
-- @_FIRST_ELEM(Tag_Name):Vector_Tag_@
function Filter_First_Elem
(unused_Value, Parameters : String;
Context : Filter_Context) return String;
-- Generate documentation for a translate set
-- Template_Category enumerants reflect the path containing the template
......
......@@ -38,22 +38,22 @@ begin
when @_Partition_Name_@_@_Calling_Threads_@_k =>
declare
Value : @_Calling_Threads_@_Thread_@_Calling_Threads_@_others_Interface
(@_Calling_Threads_@_Thread_@_Calling_Threads_@_others_Port_Type'(OUTPORT_@_Name_@));
(@_Calling_Threads_@_Thread_@_Calling_Threads_@_others_Port_Type'(OUTPORT_@_FIRST_ELEM(Remote_Function_Names):""_@_@_Name_@));
Err : PolyORB_Hi.Errors.Error_Kind with Unreferenced;
use type PolyORB_HI.Errors.Error_Kind;
begin
@@IF@@ not @_No_Param_@
@@TABLE@@
for I in 1 .. @_Param_Names_@_Size loop
Value.OUTPORT_@_Name_@_DATA.Buffer (I) :=
Value.OUTPORT_@_FIRST_ELEM(Remote_Function_Names):""_@_@_Name_@_DATA.Buffer (I) :=
PolyORB_HI_Generated.Types.Stream_Element_Buffer (@_Param_Names_@ (Interfaces.C.size_t (I - 1)));
end loop;
Value.OUTPORT_@_Name_@_DATA.Length := PolyORB_HI_Generated.Types.Unsigned_32 (@_Param_Names_@_Size);
Value.OUTPORT_@_FIRST_ELEM(Remote_Function_Names):""_@_@_Name_@_DATA.Length := PolyORB_HI_Generated.Types.Unsigned_32 (@_Param_Names_@_Size);
@@END_TABLE@@
@@END_IF@@ @@-- Has param
Put_Value (@_Partition_Name_@_@_Calling_Threads_@_k, Value);
Send_Output (@_Partition_Name_@_@_Calling_Threads_@_k,
@_Calling_Threads_@_Thread_@_Calling_Threads_@_others_Port_Type'(OUTPORT_@_Name_@),
@_Calling_Threads_@_Thread_@_Calling_Threads_@_others_Port_Type'(OUTPORT_@_FIRST_ELEM(Remote_Function_Names):""_@_@_Name_@),
Err);
-- TODO : Report the error if any
end;
......
......@@ -13,6 +13,11 @@
@@-- @_Remote_Interface_Names_@ : |_ callee's interface name
@@-- @_Remote_Languages_@ : |_ callee's function language
@@-- @_Calling_Threads_@ : Calling threads of the containing block
@@MACRO(PORT_NAME)@@
@@-- For async RIs, build the global output port name
@@-- $1 = calling thread name, $2=local or global, $3=callee function name
@_$1_@_@_$2_@_outport_@_FIRST_ELEM(Remote_Function_Names):""_@_@_Name_@
@@END_MACRO@@
// Required interface @_Name_@ in function @_Parent_Function_@
@@IF@@ @_Param_Names'Length_@ = 0
@@SET@@ No_Param=True
......@@ -54,23 +59,23 @@ void vm_@_LOWER:Parent_Function_@_@_LOWER:Name_@
@@IF@@ not @_No_Param_@
@@INLINE( )( \n )(\n)@@
__po_hi_request_t request;
__po_hi_copy_array(&(request.vars.@_LOWER:Calling_Threads_@_global_outport_@_LOWER:Name_@.@_LOWER:Calling_Threads_@_global_outport_@_LOWER:Name_@.buffer),
__po_hi_copy_array(&(request.vars.@_LOWER:PORT_NAME(@_Calling_Threads_@,global)_@.@_LOWER:PORT_NAME(@_Calling_Threads_@,global)_@.buffer),
@@TABLE@@
(void *)IN_buf_@_LOWER:Param_Names_@, size_IN_buf_@_LOWER:Param_Names_@);
@@END_TABLE@@
request.vars.@_LOWER:Calling_Threads_@_global_outport_@_LOWER:Name_@.@_LOWER:Calling_Threads_@_global_outport_@_LOWER:Name_@.length =
request.vars.@_LOWER:PORT_NAME(@_Calling_Threads_@,global)_@.@_LOWER:PORT_NAME(@_Calling_Threads_@,global)_@.length =
@@TABLE@@
size_IN_buf_@_LOWER:Param_Names_@;
@@END_TABLE@@
request.port = @_LOWER:Calling_Threads_@_global_outport_@_LOWER:Name_@;
__po_hi_gqueue_store_out(@_LOWER:Partition_Name_@_@_LOWER:Calling_Threads_@_k, @_LOWER:Calling_Threads_@_local_outport_@_LOWER:Name_@, &request);
__po_hi_send_output(@_LOWER:Partition_Name_@_@_LOWER:Calling_Threads_@_k, @_LOWER:Calling_Threads_@_global_outport_@_LOWER:Name_@);
request.port = @_LOWER:PORT_NAME(@_Calling_Threads_@,global)_@;
__po_hi_gqueue_store_out(@_LOWER:Partition_Name_@_@_LOWER:Calling_Threads_@_k, @_LOWER:PORT_NAME(@_Calling_Threads_@,local)_@, &request);
__po_hi_send_output(@_LOWER:Partition_Name_@_@_LOWER:Calling_Threads_@_k, @_LOWER:PORT_NAME(@_Calling_Threads_@,global)_@);
@@END_INLINE@@
@@ELSE@@ @@-- No param
__po_hi_request_t request;
request.port = @_LOWER:Calling_Threads_@_global_outport_@_LOWER:Name_@;
__po_hi_gqueue_store_out(@_LOWER:Partition_Name_@_@_LOWER:Calling_Threads_@_k, @_LOWER:Calling_Threads_@_local_outport_@_LOWER:Name_@, &request);
__po_hi_send_output(@_LOWER:Partition_Name_@_@_LOWER:Calling_Threads_@_k, @_LOWER:Calling_Threads_@_global_outport_@_LOWER:Name_@);
request.port = @_LOWER:PORT_NAME(@_Calling_Threads_@,global)_@;
__po_hi_gqueue_store_out(@_LOWER:Partition_Name_@_@_LOWER:Calling_Threads_@_k, @_LOWER:PORT_NAME(@_Calling_Threads_@,local)_@, &request);
__po_hi_send_output(@_LOWER:Partition_Name_@_@_LOWER:Calling_Threads_@_k, @_LOWER:PORT_NAME(@_Calling_Threads_@,global)_@);
@@END_IF@@
return;
}
......