Commit 80b74ef8 authored by Maxime Perrotin's avatar Maxime Perrotin
Browse files

Work on the concurrency view

parent 5580af77
......@@ -13,9 +13,7 @@ begin
begin
if Transformed.Configuration.Glue then
Transformed.Add_Concurrency_View;
Transformed.Concurrency_View.Generate_CV
(Base_Template_Path => Model.Configuration.Binary_Path.Element,
Base_Output_Path => Model.Configuration.Output_Dir.Element);
Transformed.Concurrency_View.Generate_CV;
end if;
Transformed.Dump;
Transformed.Generate_Build_Script;
......
......@@ -250,22 +250,22 @@ package body TASTE.AADL_Parser is
return Nothing;
end Find_Binding;
procedure Set_Calling_Threads (CV : in out Taste_Concurrency_View) is
procedure Set_Calling_Threads (Partition : in out CV_Partition) is
procedure Rec_Add_Calling_Thread (Thread_Id : String;
Block_Id : String) is
begin
-- First add thread to its corresponding protected function
-- Stop recursion if thread is already there...
if not String_Sets.To_Set (Thread_Id).Is_Subset
(Of_Set => CV.Blocks (Block_Id).Calling_Threads)
(Of_Set => Partition.Blocks (Block_Id).Calling_Threads)
then
CV.Blocks (Block_Id).Calling_Threads.Insert (Thread_Id);
Partition.Blocks (Block_Id).Calling_Threads.Insert (Thread_Id);
else
return;
end if;
-- Then recurse on its (Un)protected RIs.
for RI of CV.Blocks (Block_Id).Required loop
for RI of Partition.Blocks (Block_Id).Required loop
if RI.RCM = Protected_Operation or RI.RCM = Unprotected_Operation
then
for Remote of RI.Remote_Interfaces loop
......@@ -277,7 +277,7 @@ package body TASTE.AADL_Parser is
end loop;
end Rec_Add_Calling_Thread;
begin
for Each of CV.Threads loop
for Each of Partition.Threads loop
Rec_Add_Calling_Thread (Thread_Id => To_String (Each.Name),
Block_Id => To_String
(Each.Protected_Block_Name));
......@@ -350,20 +350,61 @@ package body TASTE.AADL_Parser is
end Get_Output_Ports;
procedure Add_Concurrency_View (Model : in out TASTE_Model) is
Result : Taste_Concurrency_View;
CV : Taste_Concurrency_View :=
(Base_Template_Path => Model.Configuration.Binary_Path,
Base_Output_Path => Model.Configuration.Output_Dir,
others => <>);
begin
-- Initialize the lists of nodes and partitions based on the DV
for Node of Model.Deployment_View.Nodes loop
declare
New_Node : CV_Node;
begin
for Partition of Node.Partitions loop
declare
New_Partition : CV_Partition;
begin
New_Node.Partitions.Insert
(Key => To_String (Partition.Name),
New_Item => New_Partition);
end;
end loop;
CV.Nodes.Insert (Key => To_String (Node.Name),
New_Item => New_Node);
end;
end loop;
-- Create one thread per Cyclic and Sporadic interface
-- Create one protected block per application code
-- and map them on the Concurrency View nodes/partitions
for F of Model.Interface_View.Flat_Functions loop
if F.Is_Type then
goto Continue;
end if;
declare
Function_Name : constant String := To_String (F.Name);
Node : constant Option_Node.Option :=
Model.Deployment_View.Find_Node (Function_Name);
Node_Name : constant String :=
(if Node.Has_Value
then To_String (Node.Unsafe_Just.Name)
else "");
Partition_Name : constant String :=
(if Node.Has_Value
then To_String (Node.Unsafe_Just.Find_Partition
(Function_Name).Unsafe_Just.Name)
else "");
Block : Protected_Block :=
(Name => F.Name,
Node => Model.Deployment_View.Find_Node (To_String (F.Name)),
Node => Node,
others => <>);
begin
if not Node.Has_Value then
-- Ignore functions that are not mapped to a node/partition
goto Continue;
end if;
for PI of F.Provided loop
declare
New_PI : Protected_Block_PI := (Name => PI.Name,
......@@ -406,7 +447,8 @@ package body TASTE.AADL_Parser is
Node => Block.Node,
Output_Ports => Get_Output_Ports (Model, F));
begin
Result.Threads.Include
CV.Nodes
(Node_Name).Partitions (Partition_Name).Threads.Include
(Key => To_String (Thread.Name),
New_Item => Thread);
end;
......@@ -414,15 +456,20 @@ package body TASTE.AADL_Parser is
end loop;
Block.Required := F.Required;
-- Add the block to the Concurrency View
Result.Blocks.Insert (Key => To_String (Block.Name),
New_Item => Block);
CV.Nodes (Node_Name).Partitions (Partition_Name).Blocks.Insert
(Key => To_String (Block.Name),
New_Item => Block);
end;
<<Continue>>
end loop;
-- Find and set protected blocks calling threads
Set_Calling_Threads (Result);
for Node of CV.Nodes loop
for Partition of Node.Partitions loop
Set_Calling_Threads (Partition);
end loop;
end loop;
Model.Concurrency_View := Result;
Model.Concurrency_View := CV;
end Add_Concurrency_View;
procedure Dump (Model : TASTE_Model) is
......
......@@ -13,53 +13,64 @@ use Ada.Directories;
package body TASTE.Concurrency_View is
procedure Debug_Dump (CV : Taste_Concurrency_View; Output : File_Type) is
begin
for Block of CV.Blocks loop
Put_Line (Output, "Protected Block : " & To_String (Block.Name));
for Provided of Block.Provided loop
Put_Line (Output, " |_ PI : " & To_String (Provided.Name));
end loop;
for Required of Block.Required loop
Put_Line (Output, " |_ RI : " & To_String (Required.Name));
end loop;
for Thread of Block.Calling_Threads loop
Put_Line (Output, " |_ Calling_Thread : " & Thread);
procedure Dump_Partition (Partition : CV_Partition) is
begin
for Block of Partition.Blocks loop
Put_Line (Output, "Protected Block : " & To_String (Block.Name));
for Provided of Block.Provided loop
Put_Line (Output, " |_ PI : " & To_String (Provided.Name));
end loop;
for Required of Block.Required loop
Put_Line (Output, " |_ RI : " & To_String (Required.Name));
end loop;
for Thread of Block.Calling_Threads loop
Put_Line (Output, " |_ Calling_Thread : " & Thread);
end loop;
if Block.Node.Has_Value then
Put_Line (Output, " |_ Node : "
& To_String (Block.Node.Unsafe_Just.Name));
declare
P : constant Taste_Partition :=
Block.Node.Unsafe_Just.Find_Partition
(To_String (Block.Name)).Unsafe_Just;
begin
Put_Line (Output, " |_ Partition : " & To_String (P.Name));
Put_Line (Output, " |_ Coverage : "
& P.Coverage'Img);
Put_Line (Output, " |_ Package : "
& To_String (P.Package_Name));
Put_Line (Output, " |_ CPU Name : "
& To_String (P.CPU_Name));
Put_Line (Output, " |_ CPU Platform : "
& P.CPU_Platform'Img);
Put_Line (Output, " |_ CPU Classifier : "
& To_String (P.CPU_Classifier));
end;
end if;
end loop;
if Block.Node.Has_Value then
Put_Line (Output, " |_ Node : "
& To_String (Block.Node.Unsafe_Just.Name));
declare
P : constant Taste_Partition :=
Block.Node.Unsafe_Just.Find_Partition
(To_String (Block.Name)).Unsafe_Just;
begin
Put_Line (Output, " |_ Partition : " & To_String (P.Name));
Put_Line (Output, " |_ Coverage : " & P.Coverage'Img);
Put_Line (Output, " |_ Package : "
& To_String (P.Package_Name));
Put_Line (Output, " |_ CPU Name : "
& To_String (P.CPU_Name));
Put_Line (Output, " |_ CPU Platform : "
& P.CPU_Platform'Img);
Put_Line (Output, " |_ CPU Classifier : "
& To_String (P.CPU_Classifier));
end;
end if;
end loop;
for Thread of CV.Threads loop
Put_Line (Output, "Thread : " & To_String (Thread.Name));
Put_Line (Output, " |_ Port : " & To_String (Thread.Entry_Port_Name));
Put_Line (Output, " |_ Protected Block : "
& To_String (Thread.Protected_Block_Name));
Put_Line (Output, " |_ Node : "
& To_String (Thread.Node.Value_Or
(Taste_Node'(Name => US ("(none)"), others => <>)).Name));
for Out_Port of Thread.Output_Ports loop
Put_Line (Output, " |_ Output port remote thread : "
& To_String (Out_Port.Remote_Thread));
Put_Line (Output, " |_ Output port remote PI : "
& To_String (Out_Port.Remote_PI));
for Thread of Partition.Threads loop
Put_Line (Output, "Thread : " & To_String (Thread.Name));
Put_Line (Output, " |_ Port : "
& To_String (Thread.Entry_Port_Name));
Put_Line (Output, " |_ Protected Block : "
& To_String (Thread.Protected_Block_Name));
Put_Line (Output, " |_ Node : "
& To_String (Thread.Node.Value_Or
(Taste_Node'(Name => US ("(none)"),
others => <>)).Name));
for Out_Port of Thread.Output_Ports loop
Put_Line (Output, " |_ Output port remote thread : "
& To_String (Out_Port.Remote_Thread));
Put_Line (Output, " |_ Output port remote PI : "
& To_String (Out_Port.Remote_PI));
end loop;
end loop;
end Dump_Partition;
begin
for Node of CV.Nodes loop
for Partition of Node.Partitions loop
Dump_Partition (Partition);
end loop;
end loop;
end Debug_Dump;
......@@ -114,38 +125,22 @@ package body TASTE.Concurrency_View is
& Assoc ("Remote_PIs", Remote_PI));
end To_Template;
function Concurrency_View_Template (CV : Taste_Concurrency_View)
return CV_As_Template
-- Generate the output file for one node
procedure Generate_Node (CV : Taste_Concurrency_View; Node_Name : String)
is
Result : CV_As_Template;
begin
for Thread of CV.Threads loop
Result.Threads.Append (Thread.To_Template);
end loop;
for Pro of CV.Blocks loop
Result.Blocks.Append (Pro.To_Template);
end loop;
return Result;
end Concurrency_View_Template;
-- Parse the template files to generate the CV output with Templates_parser
procedure Generate_CV (CV : Taste_Concurrency_View;
Base_Template_Path : String;
Base_Output_Path : String)
is
Prefix : constant String := Base_Template_Path
Prefix : constant String := CV.Base_Template_Path.Element
& "templates/concurrency_view";
Template : constant CV_As_Template := CV.Concurrency_View_Template;
-- To iterate over template folders
ST : Search_Type;
Current : Directory_Entry_Type;
Filter : constant Filter_Type := (Directory => True,
others => False);
Output_File : File_Type;
Output_Dir : constant String := Base_Output_Path & "/concurrency_view/";
Output_Dir : constant String :=
CV.Base_Output_Path.Element & "/concurrency_view/" & Node_Name;
begin
Put_Info ("Generating Concurrency View");
-- All files are created in the same folder - create it
Put_Info ("Generating Concurrency View for node " & Node_Name);
-- All files for one node are created in the same folder - create it
Create_Path (Output_Dir);
Start_Search (Search => ST,
......@@ -171,7 +166,7 @@ package body TASTE.Concurrency_View is
end if;
declare
Path : constant String := Full_Name (Current);
Path : constant String := Full_Name (Current);
Do_It : constant Boolean := Exists (Path & "/filename.tmplt");
-- Get output file name from template
File_Name : constant String :=
......@@ -187,45 +182,62 @@ package body TASTE.Concurrency_View is
(Exists (Path & "/trigger.tmplt") and then
Strip_String
(Parse (Path & "/trigger.tmplt", Trig_Tmpl)) = "TRUE");
function Generate_Partition (Partition : CV_Partition)
return Translate_Set
is
Threads : Tag;
Blocks : Tag;
begin
for Thread of Partition.Threads loop
-- Render each thread
Threads := Threads & "This_Thread";
-- & String'(Parse (Path & "/thread.tmplt", Thread_Assoc));
end loop;
for Block of Partition.Blocks loop
-- Render each block
Blocks := Blocks & "This block";
-- String'(Parse (Path & "/block.tmplt", Block_Assoc));
end loop;
return Translate_Set'(+Assoc ("Threads", Threads)
& Assoc ("Blocks", Blocks));
end Generate_Partition;
begin
-- We have threads and blocks
-- Threads: it is a vector of translate set meaning that we can
-- render them directly from a template and keep them in a vector
-- of strings.
-- A node contains partitions, we must render them all separately
-- using their own templates (threads and blocks), and then call
-- use the node template with these tags.
if Trigger then
declare
Threads : Tag;
Blocks : Tag;
Result : Translate_Set;
begin
Put_Info ("Generating from " & Path);
for Thread of Template.Threads loop
-- Render each thread
Threads := Threads
& String'(Parse (Path & "/thread.tmplt", Thread));
end loop;
for Block of Template.Blocks loop
-- Render each block
null;
end loop;
Result := +Assoc ("Threads", Threads)
& Assoc ("Blocks", Blocks);
Create (File => Output_File,
Mode => Out_File,
Name => Output_Dir & File_Name);
Put_Line (Output_File, Parse (Path & "/cv.tmplt", Result));
Close (Output_File);
end;
for Partition of CV.Nodes (Node_Name).Partitions loop
declare
Partition_Assoc : constant Translate_Set :=
Generate_Partition (Partition);
begin
Put_Info ("Generating from " & Path);
Create (File => Output_File,
Mode => Out_File,
Name => Output_Dir & File_Name);
Put_Line (Output_File,
Parse (Path & "/node.tmplt", Partition_Assoc));
Close (Output_File);
end;
end loop;
end if;
end;
<<continue>>
end loop;
End_Search (ST);
end Generate_Node;
procedure Generate_CV (CV : Taste_Concurrency_View) is
begin
for Node in CV.Nodes.Iterate loop
CV.Generate_Node (CV_Nodes.Key (Node));
end loop;
exception
when Error : Concurrency_View_Error | Ada.IO_Exceptions.Name_Error =>
Put_Error ("Concurrency View : "
& Ada.Exceptions.Exception_Message (Error));
raise Quit_Taste;
end Generate_CV;
end TASTE.Concurrency_View;
......@@ -52,6 +52,7 @@ package TASTE.Concurrency_View is
Required : Translate_Sets.Vector;
end record;
function To_Template (B : Protected_Block) return Block_As_Template;
package ST_Blocks is new Indefinite_Vectors (Natural, Block_As_Template);
package Protected_Blocks is new Indefinite_Ordered_Maps
(String, Protected_Block);
......@@ -77,31 +78,46 @@ package TASTE.Concurrency_View is
package AADL_Threads is new Indefinite_Ordered_Maps (String, AADL_Thread);
type Taste_Concurrency_View is tagged
-- a Partition is eventually a process (binaray) or a TSP partition
type CV_Partition_As_Template is
record
Threads : Translate_Sets.Vector;
Blocks : ST_Blocks.Vector;
end record;
type CV_Partition is tagged
record
Threads : AADL_Threads.Map;
Blocks : Protected_Blocks.Map;
end record;
procedure Debug_Dump (CV : Taste_Concurrency_View;
Output : File_Type);
package CV_Partitions is new Indefinite_Ordered_Maps (String, CV_Partition);
-- Set of constructs for transforming the AST into Template entities
package ST_Blocks is new Indefinite_Vectors (Natural, Block_As_Template);
-- A node may contain several partitions (in case of TSP)
type CV_Node is tagged
record
Partitions : CV_Partitions.Map;
end record;
type CV_As_Template is
package CV_Nodes is new Indefinite_Ordered_Maps (String, CV_Node);
-- CV is made of a list of nodes, each containing a list of partitions
-- Partitions contain threads and passive functions as created during
-- Vertical transformation
-- Nodes contain drivers, and nodes are connected via busses, but this
-- information is already in the deployment view. It is not repeated here.
type Taste_Concurrency_View is tagged
record
Threads : Translate_Sets.Vector;
Blocks : ST_Blocks.Vector;
Nodes : CV_Nodes.Map;
Base_Template_Path : String_Holder;
Base_Output_Path : String_Holder;
end record;
function Concurrency_View_Template (CV : Taste_Concurrency_View)
return CV_As_Template;
procedure Debug_Dump (CV : Taste_Concurrency_View;
Output : File_Type);
-- Function to generate the concurrency view
-- Base_Template_Path comes from Model.Configuration.Binary.Path
procedure Generate_CV (CV : Taste_Concurrency_View;
Base_Template_Path : String;
Base_Output_Path : String);
-- Functions to generate the concurrency view
procedure Generate_Node (CV : Taste_Concurrency_View; Node_Name : String);
procedure Generate_CV (CV : Taste_Concurrency_View);
end TASTE.Concurrency_View;
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