Commit dc546623 authored by Maxime Perrotin's avatar Maxime Perrotin
Browse files

Add missing parts to the deployment view parser

parent 6402696c
...@@ -2,47 +2,37 @@ ...@@ -2,47 +2,37 @@
-- Based on Ocarina **************************************************** -- -- Based on Ocarina **************************************************** --
-- (c) 2017 European Space Agency - maxime.perrotin@esa.int -- (c) 2017 European Space Agency - maxime.perrotin@esa.int
-- LGPL license, see LICENSE file -- LGPL license, see LICENSE file
pragma Warnings (Off);
with Ada.Strings.Unbounded, with Ada.Command_Line,
Ada.Command_Line,
Ada.Exceptions, Ada.Exceptions,
Ada.Text_IO, Ada.Text_IO,
Ada.Containers.Indefinite_Vectors,
GNAT.OS_Lib, GNAT.OS_Lib,
Errors, Errors,
Locations, Locations,
Ocarina.Namet, Ocarina.Namet,
Ocarina.Types, Ocarina.Types,
Ocarina.Analyzer, Ocarina.Analyzer,
Ocarina.Backends.Properties,
Ocarina.Configuration, Ocarina.Configuration,
Ocarina.Files, Ocarina.Files,
Ocarina.Options, Ocarina.Options,
Ocarina.Instances, Ocarina.Instances,
Ocarina.ME_AADL.AADL_Instances.Entities,
Ocarina.ME_AADL.AADL_Instances.Nodes, Ocarina.ME_AADL.AADL_Instances.Nodes,
Ocarina.ME_AADL.AADL_Instances.Nutils,
Ocarina.Parser, Ocarina.Parser,
Ocarina.FE_AADL.Parser, Ocarina.FE_AADL.Parser,
Parser_Utils, Parser_Utils,
Interface_View, Interface_View,
Deployment_View; Deployment_View;
use Ada.Strings.Unbounded, use Ada.Text_IO,
Ada.Text_IO,
Ada.Exceptions, Ada.Exceptions,
Locations, Locations,
Ocarina.Namet, Ocarina.Namet,
Ocarina.Types, Ocarina.Types,
Ocarina, Ocarina,
Ocarina.Analyzer, Ocarina.Analyzer,
Ocarina.Backends.Properties,
Ocarina.Instances, Ocarina.Instances,
Ocarina.ME_AADL, Ocarina.ME_AADL,
Ocarina.ME_AADL.AADL_Instances.Entities,
Ocarina.ME_AADL.AADL_Instances.Nodes, Ocarina.ME_AADL.AADL_Instances.Nodes,
Ocarina.ME_AADL.AADL_Instances.Nutils,
Ocarina.Backends.Properties,
Parser_Utils, Parser_Utils,
Interface_View, Interface_View,
Deployment_View, Deployment_View,
...@@ -56,20 +46,17 @@ procedure AADL_Parser is ...@@ -56,20 +46,17 @@ procedure AADL_Parser is
Deployment_root : Node_Id := No_Node; Deployment_root : Node_Id := No_Node;
Dataview_root : Node_ID := No_Node; Dataview_root : Node_ID := No_Node;
Success : Boolean; Success : Boolean;
OutDir : Integer := 0; -- OutDir : Integer := 0;
Stack_Val : Integer := 0; -- Stack_Val : Integer := 0;
Timer_Resolution : Integer := 0; -- Timer_Resolution : Integer := 0;
Interface_View : Integer := 0; Interface_View : Integer := 0;
Depl_View_Pos : Integer := 0; Depl_View_Pos : Integer := 0;
Data_View : Integer := 0; Data_View : Integer := 0;
Generate_glue : Boolean := false; Generate_glue : Boolean := false;
Keep_case : Boolean := false;
AADL_Version : AADL_Version_Type := Ocarina.AADL_V2; AADL_Version : AADL_Version_Type := Ocarina.AADL_V2;
procedure Parse_Command_Line; procedure Parse_Command_Line;
-- procedure Process_DataView (My_Root : Node_Id); -- procedure Process_DataView (My_Root : Node_Id);
procedure Browse_Deployment_View_System
(My_System : Node_Id; NodeName : String) with Unreferenced;
---------------------------- ----------------------------
-- Process_Interface_View -- -- Process_Interface_View --
...@@ -100,8 +87,8 @@ procedure AADL_Parser is ...@@ -100,8 +87,8 @@ procedure AADL_Parser is
-- Browse_Deployment_View_System -- -- Browse_Deployment_View_System --
----------------------------------- -----------------------------------
procedure Browse_Deployment_View_System -- procedure Browse_Deployment_View_System
(My_System : Node_Id; NodeName : String) is -- (My_System : Node_Id; NodeName : String) is
-- Processes : Node_Id; -- Processes : Node_Id;
-- Processes2 : Node_Id; -- Processes2 : Node_Id;
-- Tmp_CI : Node_Id; -- Tmp_CI : Node_Id;
...@@ -112,132 +99,6 @@ procedure AADL_Parser is ...@@ -112,132 +99,6 @@ procedure AADL_Parser is
-- Pkg_Name : Name_Id := No_Name; -- Pkg_Name : Name_Id := No_Name;
-- CPU_Classifier : Name_Id := No_Name; -- CPU_Classifier : Name_Id := No_Name;
-- CPU_Platform : Supported_Execution_Platform := Platform_None; -- CPU_Platform : Supported_Execution_Platform := Platform_None;
begin
null;
-- if not Is_Empty (Subcomponents (My_System)) then
-- C_New_Drivers_Section;
-- Processes := First_Node (Subcomponents (My_System));
--
-- while Present (Processes) loop
-- Tmp_CI := Corresponding_Instance (Processes);
--
-- if Get_Category_Of_Component (Tmp_CI) = CC_Process then
-- declare
-- Node_Coverage : Boolean := False;
-- begin
-- if Is_Defined_Property (Tmp_CI,
-- "taste_dv_properties::coverageenabled")
-- then
-- Node_Coverage := Get_Boolean_Property
-- (Tmp_CI,
-- Get_String_Name ("taste_dv_properties::coverageenabled"));
-- if Node_Coverage then
-- Put_Line ("Needs Coverage");
-- else
-- Put_Line ("Needs No coverage");
-- end if;
-- end if;
--
-- CPU := Get_Bound_Processor (Tmp_CI);
-- Set_Str_To_Name_Buffer ("");
-- CPU_Name := Name (Identifier (Parent_Subcomponent (CPU)));
--
-- CPU_Platform := Get_Execution_Platform (CPU);
--
-- if ATN.Namespace (Corresponding_Declaration (CPU)) /= No_Node
-- then
-- Set_Str_To_Name_Buffer ("");
-- Get_Name_String
-- (ATN.Name
-- (ATN.Identifier
-- (ATN.Namespace
-- (Corresponding_Declaration (CPU)))));
-- Pkg_Name := Name_Find;
-- C_Add_Package
-- (Get_Name_String (Pkg_Name),
-- Get_Name_String (Pkg_Name)'Length);
-- Set_Str_To_Name_Buffer ("");
-- Get_Name_String (Pkg_Name);
-- Add_Str_To_Name_Buffer ("::");
-- Get_Name_String_And_Append (Name (Identifier (CPU)));
-- CPU_Classifier := Name_Find;
-- else
-- CPU_Classifier := Name (Identifier (CPU));
-- end if;
--
-- C_New_Processor
-- (Get_Name_String (CPU_Name),
-- Get_Name_String (CPU_Name)'Length,
-- Get_Name_String (CPU_Classifier),
-- Get_Name_String (CPU_Classifier)'Length,
-- Supported_Execution_Platform'Image (CPU_Platform),
-- Supported_Execution_Platform'Image (CPU_Platform)'Length);
--
-- C_New_Process
-- (Get_Name_String
-- (ATN.Name
-- (ATN.Component_Type_Identifier
-- (Corresponding_Declaration (Tmp_CI)))),
-- Get_Name_String
-- (ATN.Name
-- (ATN.Component_Type_Identifier
-- (Corresponding_Declaration (Tmp_CI))))'Length,
-- Get_Name_String (Name (Identifier (Processes))),
-- Get_Name_String (Name (Identifier (Processes)))'Length,
-- NodeName, NodeName'Length,
-- Boolean'Pos (Node_Coverage));
--
-- Processes2 := First_Node (Subcomponents (My_System));
--
-- while Present (Processes2) loop
-- Tmp_CI2 := Corresponding_Instance (Processes2);
--
-- if Get_Category_Of_Component (Tmp_CI2) = CC_System
-- and then
-- Is_Defined_Property
-- (Tmp_CI2, "taste::aplc_binding")
-- then
-- Ref := Get_Reference_Property
-- (Tmp_CI2, Get_String_Name ("taste::aplc_binding"));
--
-- if Ref = Tmp_CI then
-- declare
-- Bound_APLC_Name : Unbounded_String;
-- begin
-- begin
-- Bound_APLC_Name := US
-- (Get_Name_String
-- (ATN.Name
-- (ATN.Component_Type_Identifier
-- (Corresponding_Declaration (Tmp_CI2)))));
-- exception
-- when System.Assertions.Assert_Failure =>
-- Put_Line
-- ("Detected DV from TASTE version 1.2");
-- Bound_APLC_Name := US
-- (Get_Name_String
-- (Name (Identifier (Processes2))));
-- end;
--
-- C_Add_Binding
-- (To_String (Bound_APLC_Name),
-- To_String (Bound_APLC_Name)'Length);
-- end;
-- end if;
-- end if;
--
-- Processes2 := Next_Node (Processes2);
-- end loop;
--
-- C_End_Process;
-- end;
-- end if;
--
-- Processes := Next_Node (Processes);
-- end loop;
-- C_End_Drivers_Section;
-- end if;
end Browse_Deployment_View_System;
------------------------ ------------------------
-- Parse_Command_Line -- -- Parse_Command_Line --
...@@ -269,11 +130,11 @@ procedure AADL_Parser is ...@@ -269,11 +130,11 @@ procedure AADL_Parser is
Previous_DataView := false; Previous_DataView := false;
elsif Previous_Outdir then elsif Previous_Outdir then
OutDir := J; -- OutDir := J;
Previous_OutDir := false; Previous_OutDir := false;
elsif Previous_TimerRes then elsif Previous_TimerRes then
Timer_Resolution := J; -- Timer_Resolution := J;
Previous_TimerRes := false; Previous_TimerRes := false;
elsif Ada.Command_Line.Argument (J) = "--polyorb-hi-c" elsif Ada.Command_Line.Argument (J) = "--polyorb-hi-c"
...@@ -282,12 +143,6 @@ procedure AADL_Parser is ...@@ -282,12 +143,6 @@ procedure AADL_Parser is
then then
null; null;
elsif Ada.Command_Line.Argument (J) = "--keep-case"
or else Ada.Command_Line.Argument (J) = "-j"
or else Ada.Command_Line.Argument (J) = "-keep-case"
then
Keep_case := true;
elsif Ada.Command_Line.Argument (J) = "--glue" elsif Ada.Command_Line.Argument (J) = "--glue"
or else Ada.Command_Line.Argument (J) = "-glue" or else Ada.Command_Line.Argument (J) = "-glue"
or else Ada.Command_Line.Argument (J) = "-l" or else Ada.Command_Line.Argument (J) = "-l"
...@@ -505,7 +360,7 @@ begin ...@@ -505,7 +360,7 @@ begin
IV_Root := Root_System (Instantiate_Model (Root => Interface_Root)); IV_Root := Root_System (Instantiate_Model (Root => Interface_Root));
IV_AST := Parse_Interface_View (IV_Root); IV_AST := Parse_Interface_View (IV_Root);
Debug_Dump_IV (IV_AST); IV_AST.Debug_Dump;
-- Now, we are done with the interface view. We now analyze the -- Now, we are done with the interface view. We now analyze the
-- deployment view. -- deployment view.
...@@ -513,6 +368,7 @@ begin ...@@ -513,6 +368,7 @@ begin
if Depl_View_Pos > 0 then if Depl_View_Pos > 0 then
AADL_Lib.Append (Ada.Command_Line.Argument (Interface_View)); AADL_Lib.Append (Ada.Command_Line.Argument (Interface_View));
DV_AST := Parse_Deployment_View (Deployment_Root); DV_AST := Parse_Deployment_View (Deployment_Root);
DV_AST.Debug_Dump;
end if; end if;
Ocarina.Configuration.Reset_Modules; Ocarina.Configuration.Reset_Modules;
......
...@@ -6,9 +6,9 @@ ...@@ -6,9 +6,9 @@
with Ada.Text_IO, with Ada.Text_IO,
Ada.Exceptions, Ada.Exceptions,
System.Assertions,
-- Ada.Command_Line, -- Ada.Command_Line,
Ocarina.Instances.Queries, Ocarina.Instances.Queries,
Ocarina.Backends.Properties,
Ocarina.Instances, Ocarina.Instances,
Ocarina.Files, Ocarina.Files,
Ocarina.FE_AADL.Parser, Ocarina.FE_AADL.Parser,
...@@ -26,8 +26,8 @@ package body Deployment_View is ...@@ -26,8 +26,8 @@ package body Deployment_View is
use Ada.Text_IO, use Ada.Text_IO,
Ada.Exceptions, Ada.Exceptions,
System.Assertions,
Ocarina.Instances.Queries, Ocarina.Instances.Queries,
Ocarina.Backends.Properties,
Ocarina.Namet, Ocarina.Namet,
Ocarina.Files, Ocarina.Files,
Ocarina.FE_AADL.Parser, Ocarina.FE_AADL.Parser,
...@@ -88,6 +88,7 @@ package body Deployment_View is ...@@ -88,6 +88,7 @@ package body Deployment_View is
use type Bus_Connections.Vector; use type Bus_Connections.Vector;
Nodes : Node_Maps.Map; Nodes : Node_Maps.Map;
Node : Taste_Node;
Busses : Taste_Busses.Vector; Busses : Taste_Busses.Vector;
Conns : Bus_Connections.Vector; Conns : Bus_Connections.Vector;
My_Root_System : Node_Id; My_Root_System : Node_Id;
...@@ -329,11 +330,84 @@ package body Deployment_View is ...@@ -329,11 +330,84 @@ package body Deployment_View is
& Exception_Message (Error); & Exception_Message (Error);
end Parse_Device; end Parse_Device;
function Parse_Node (Depl_View_System : Node_Id) function Parse_Partition (CI : Node_Id; Depl : Node_Id)
return Taste_Node is return Taste_Partition is
Result : Taste_Partition;
CPU : Node_Id;
Processes : Node_Id;
P_CI : Node_Id;
Ref : Node_Id;
begin
if Is_Defined_Property (CI, "taste_dv_properties::coverageenabled")
then
Result.Coverage := Get_Boolean_Property
(CI, Get_String_Name ("taste_dv_properties::coverageenabled"));
end if;
CPU := Get_Bound_Processor (CI);
Result.CPU_Name :=
US (Get_Name_String (Name (Identifier (Parent_Subcomponent (CPU)))));
Result.CPU_Platform := Get_Execution_Platform (CPU);
if ATN.Namespace (Corresponding_Declaration (CPU)) /= No_Node
then
Set_Str_To_Name_Buffer ("");
Get_Name_String (ATN.Name (ATN.Identifier (ATN.Namespace
(Corresponding_Declaration (CPU)))));
Result.Package_Name := US (Get_Name_String (Name_Find));
Set_Str_To_Name_Buffer ("");
Get_Name_String
(Get_String_Name (To_String (Result.Package_Name)));
Add_Str_To_Name_Buffer ("::");
Get_Name_String_And_Append (Name (Identifier (CPU)));
Result.CPU_Classifier := US (Get_Name_String (Name_Find));
else
Result.CPU_Classifier :=
US (Get_Name_String (Name (Identifier (CPU))));
Result.Package_Name := US ("");
end if;
Result.Name :=
US (Get_Name_String (ATN.Name (ATN.Component_Type_Identifier
(Corresponding_Declaration (CI)))));
-- Bounded functions
Processes := First_Node (Subcomponents (Depl));
while Present (Processes) loop
P_CI := Corresponding_Instance (Processes);
if Get_Category_Of_Component (P_CI) = CC_System
and then Is_Defined_Property (P_CI, "taste::aplc_binding")
then
Ref := Get_Reference_Property
(P_CI, Get_String_Name ("taste::aplc_binding"));
if Ref = CI then
begin
Result.Bound_Functions.Append (Get_Name_String (ATN.Name
(ATN.Component_Type_Identifier
(Corresponding_Declaration (P_CI)))));
exception
when Assert_Failure =>
Put_Line ("Detected DV from TASTE version 1.2");
Result.Bound_Functions.Append
(Get_Name_String (Name (Identifier (Processes))));
end;
end if;
end if;
Processes := Next_Node (Processes);
end loop;
return Result;
end Parse_Partition;
function Parse_Node (Depl_View_System : Node_Id) return Taste_Node is
Processes : Node_Id; Processes : Node_Id;
CI : Node_Id; CI : Node_Id;
Result : Taste_Node; Result : Taste_Node;
Partition : Taste_Partition;
begin begin
Processes := First_Node (Subcomponents (Depl_View_System)); Processes := First_Node (Subcomponents (Depl_View_System));
...@@ -342,15 +416,14 @@ package body Deployment_View is ...@@ -342,15 +416,14 @@ package body Deployment_View is
if Get_Category_Of_Component (CI) = CC_Device then if Get_Category_Of_Component (CI) = CC_Device then
Result.Drivers.Append (Parse_Device (CI)); Result.Drivers.Append (Parse_Device (CI));
elsif Get_Category_Of_Component (CI) = CC_Process then elsif Get_Category_Of_Component (CI) = CC_Process then
-- Partitions? Partition := Parse_Partition (CI, Depl_View_System);
null; Result.Partitions.Insert (Key => To_String (Partition.Name),
New_Item => Partition);
end if; end if;
Processes := Next_Node (Processes); Processes := Next_Node (Processes);
end loop; end loop;
return Result; return Result;
end Parse_Node; end Parse_Node;
begin begin
...@@ -372,8 +445,10 @@ package body Deployment_View is ...@@ -372,8 +445,10 @@ package body Deployment_View is
end if; end if;
if not Is_Empty (Subcomponents (CI)) then if not Is_Empty (Subcomponents (CI)) then
Nodes.Insert (Key => Get_Name_String (Name (Identifier (Subs))), Node := Parse_Node (CI);
New_Item => Parse_Node (CI)); Node.Name := US (Get_Name_String (Name (Identifier (Subs))));
Nodes.Insert (Key => To_String (Node.Name),
New_Item => Node);
end if; end if;
elsif Get_Category_Of_Component (CI) = CC_Bus then -- Bus elsif Get_Category_Of_Component (CI) = CC_Bus then -- Bus
Busses.Append (Parse_Bus (Subs, CI)); Busses.Append (Parse_Bus (Subs, CI));
...@@ -390,5 +465,5 @@ package body Deployment_View is ...@@ -390,5 +465,5 @@ package body Deployment_View is
Busses => Busses); Busses => Busses);
end Parse_Deployment_View; end Parse_Deployment_View;
procedure Debug_Dump_DV (DV : Complete_Deployment_View) is null; procedure Debug_Dump (DV : Complete_Deployment_View) is null;
end Deployment_View; end Deployment_View;
...@@ -9,11 +9,12 @@ with Ocarina, ...@@ -9,11 +9,12 @@ with Ocarina,
Ada.Containers.Indefinite_Ordered_Maps, Ada.Containers.Indefinite_Ordered_Maps,
Ada.Containers.Indefinite_Vectors, Ada.Containers.Indefinite_Vectors,
Ada.Strings.Unbounded, Ada.Strings.Unbounded,
-- Option_Type, Ocarina.Backends.Properties,
Parser_Utils; Parser_Utils;
use Ocarina, use Ocarina,
Ocarina.Types, Ocarina.Types,
Ocarina.Backends.Properties,
Ada.Containers, Ada.Containers,
Ada.Strings.Unbounded, Ada.Strings.Unbounded,
Parser_Utils; Parser_Utils;
...@@ -88,10 +89,25 @@ package Deployment_View is ...@@ -88,10 +89,25 @@ package Deployment_View is
package Taste_Drivers is package Taste_Drivers is
new Indefinite_Vectors (Natural, Taste_Device_Driver); new Indefinite_Vectors (Natural, Taste_Device_Driver);
type Taste_Partition is
record
Name : Unbounded_String;
Coverage : Boolean;
Package_Name : Unbounded_String;
CPU_Name : Unbounded_String;
CPU_Platform : Supported_Execution_Platform;
CPU_Classifier : Unbounded_String;
Bound_Functions : String_Vectors.Vector;
end record;
package Taste_Partitions is
new Indefinite_Ordered_Maps (String, Taste_Partition);
type Taste_Node is type Taste_Node is
record record
Name : Unbounded_String; Name : Unbounded_String;
Drivers : Taste_Drivers.Vector; Drivers : Taste_Drivers.Vector;
Partitions : Taste_Partitions.Map;
end record; end record;
package Node_Maps is new Indefinite_Ordered_Maps (String, Taste_Node); package Node_Maps is new Indefinite_Ordered_Maps (String, Taste_Node);
...@@ -108,6 +124,6 @@ package Deployment_View is ...@@ -108,6 +124,6 @@ package Deployment_View is
return Complete_Deployment_View return Complete_Deployment_View
with Pre => System /= No_Node; with Pre => System /= No_Node;
procedure Debug_Dump_DV (DV : Complete_Deployment_View); procedure Debug_Dump (DV : Complete_Deployment_View);
end Deployment_View; end Deployment_View;
...@@ -754,7 +754,7 @@ package body Interface_View is ...@@ -754,7 +754,7 @@ package body Interface_View is
end loop; end loop;
end Rename_Required_Interface; end Rename_Required_Interface;
procedure Debug_Dump_IV (IV : Complete_Interface_View) is procedure Debug_Dump (IV : Complete_Interface_View) is
procedure Dump_Interface (Ind : String := " "; procedure Dump_Interface (Ind : String := " ";
I : Taste_Interface) is I : Taste_Interface) is
begin begin
...@@ -824,5 +824,5 @@ package body Interface_View is ...@@ -824,5 +824,5 @@ package body Interface_View is
end loop; end loop;
New_Line; New_Line;
end loop; end loop;
end Debug_Dump_IV; end Debug_Dump;
end Interface_View; end Interface_View;
...@@ -179,6 +179,6 @@ package Interface_View is ...@@ -179,6 +179,6 @@ package Interface_View is
Iface : String; Iface : String;
To : String); To : String);
procedure Debug_Dump_IV (IV : Complete_Interface_View); procedure Debug_Dump (IV : Complete_Interface_View);
end Interface_View; end Interface_View;
...@@ -48,8 +48,6 @@ package body Parser_Utils is ...@@ -48,8 +48,6 @@ package body Parser_Utils is
Put_Line ("Generate glue code"); Put_Line ("Generate glue code");
Put ("-w, --gw" & HT & HT & HT & HT); Put ("-w, --gw" & HT & HT & HT & HT);
Put_Line ("Generate code skeletons");