Skip to content

GitLab

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

Add missing parts to the deployment view parser

parent 6402696c
Hide whitespace changes
Inline Side-by-side
src/aadl_parser.adb
View file @ dc546623
......@@ -2,47 +2,37 @@
-- Based on Ocarina **************************************************** --
-- (c) 2017 European Space Agency - maxime.perrotin@esa.int
-- LGPL license, see LICENSE file
pragma Warnings (Off);
with Ada.Strings.Unbounded,
Ada.Command_Line,
with Ada.Command_Line,
Ada.Exceptions,
Ada.Text_IO,
Ada.Containers.Indefinite_Vectors,
GNAT.OS_Lib,
Errors,
Locations,
Ocarina.Namet,
Ocarina.Types,
Ocarina.Analyzer,
Ocarina.Backends.Properties,
Ocarina.Configuration,
Ocarina.Files,
Ocarina.Options,
Ocarina.Instances,
Ocarina.ME_AADL.AADL_Instances.Entities,
Ocarina.ME_AADL.AADL_Instances.Nodes,
Ocarina.ME_AADL.AADL_Instances.Nutils,
Ocarina.Parser,
Ocarina.FE_AADL.Parser,
Parser_Utils,
Interface_View,
Deployment_View;
use Ada.Strings.Unbounded,
Ada.Text_IO,
use Ada.Text_IO,
Ada.Exceptions,
Locations,
Ocarina.Namet,
Ocarina.Types,
Ocarina,
Ocarina.Analyzer,
Ocarina.Backends.Properties,
Ocarina.Instances,
Ocarina.ME_AADL,
Ocarina.ME_AADL.AADL_Instances.Entities,
Ocarina.ME_AADL.AADL_Instances.Nodes,
Ocarina.ME_AADL.AADL_Instances.Nutils,
Ocarina.Backends.Properties,
Parser_Utils,
Interface_View,
Deployment_View,
......@@ -56,20 +46,17 @@ procedure AADL_Parser is
Deployment_root : Node_Id := No_Node;
Dataview_root : Node_ID := No_Node;
Success : Boolean;
OutDir : Integer := 0;
Stack_Val : Integer := 0;
Timer_Resolution : Integer := 0;
-- OutDir : Integer := 0;
-- Stack_Val : Integer := 0;
-- Timer_Resolution : Integer := 0;
Interface_View : Integer := 0;
Depl_View_Pos : Integer := 0;
Data_View : Integer := 0;
Generate_glue : Boolean := false;
Keep_case : Boolean := false;
AADL_Version : AADL_Version_Type := Ocarina.AADL_V2;
procedure Parse_Command_Line;
-- procedure Process_DataView (My_Root : Node_Id);
procedure Browse_Deployment_View_System
(My_System : Node_Id; NodeName : String) with Unreferenced;
----------------------------
-- Process_Interface_View --
......@@ -100,8 +87,8 @@ procedure AADL_Parser is
-- Browse_Deployment_View_System --
-----------------------------------
procedure Browse_Deployment_View_System
(My_System : Node_Id; NodeName : String) is
-- procedure Browse_Deployment_View_System
-- (My_System : Node_Id; NodeName : String) is
-- Processes : Node_Id;
-- Processes2 : Node_Id;
-- Tmp_CI : Node_Id;
......@@ -112,132 +99,6 @@ procedure AADL_Parser is
-- Pkg_Name : Name_Id := No_Name;
-- CPU_Classifier : Name_Id := No_Name;
-- 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 --
......@@ -269,11 +130,11 @@ procedure AADL_Parser is
Previous_DataView := false;
elsif Previous_Outdir then
OutDir := J;
-- OutDir := J;
Previous_OutDir := false;
elsif Previous_TimerRes then
Timer_Resolution := J;
-- Timer_Resolution := J;
Previous_TimerRes := false;
elsif Ada.Command_Line.Argument (J) = "--polyorb-hi-c"
......@@ -282,12 +143,6 @@ procedure AADL_Parser is
then
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"
or else Ada.Command_Line.Argument (J) = "-glue"
or else Ada.Command_Line.Argument (J) = "-l"
......@@ -505,7 +360,7 @@ begin
IV_Root := Root_System (Instantiate_Model (Root => Interface_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
-- deployment view.
......@@ -513,6 +368,7 @@ begin
if Depl_View_Pos > 0 then
AADL_Lib.Append (Ada.Command_Line.Argument (Interface_View));
DV_AST := Parse_Deployment_View (Deployment_Root);
DV_AST.Debug_Dump;
end if;
Ocarina.Configuration.Reset_Modules;
......
src/deployment_view.adb
View file @ dc546623
......@@ -6,9 +6,9 @@
with Ada.Text_IO,
Ada.Exceptions,
System.Assertions,
-- Ada.Command_Line,
Ocarina.Instances.Queries,
Ocarina.Backends.Properties,
Ocarina.Instances,
Ocarina.Files,
Ocarina.FE_AADL.Parser,
......@@ -26,8 +26,8 @@ package body Deployment_View is
use Ada.Text_IO,
Ada.Exceptions,
System.Assertions,
Ocarina.Instances.Queries,
Ocarina.Backends.Properties,
Ocarina.Namet,
Ocarina.Files,
Ocarina.FE_AADL.Parser,
......@@ -88,6 +88,7 @@ package body Deployment_View is
use type Bus_Connections.Vector;
Nodes : Node_Maps.Map;
Node : Taste_Node;
Busses : Taste_Busses.Vector;
Conns : Bus_Connections.Vector;
My_Root_System : Node_Id;
......@@ -329,11 +330,84 @@ package body Deployment_View is
& Exception_Message (Error);
end Parse_Device;
function Parse_Node (Depl_View_System : Node_Id)
return Taste_Node is
function Parse_Partition (CI : Node_Id; Depl : Node_Id)
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;
CI : Node_Id;
Result : Taste_Node;
Partition : Taste_Partition;
begin
Processes := First_Node (Subcomponents (Depl_View_System));
......@@ -342,15 +416,14 @@ package body Deployment_View is
if Get_Category_Of_Component (CI) = CC_Device then
Result.Drivers.Append (Parse_Device (CI));
elsif Get_Category_Of_Component (CI) = CC_Process then
-- Partitions?
null;
Partition := Parse_Partition (CI, Depl_View_System);
Result.Partitions.Insert (Key => To_String (Partition.Name),
New_Item => Partition);
end if;
Processes := Next_Node (Processes);
end loop;
return Result;
end Parse_Node;
begin
......@@ -372,8 +445,10 @@ package body Deployment_View is
end if;
if not Is_Empty (Subcomponents (CI)) then
Nodes.Insert (Key => Get_Name_String (Name (Identifier (Subs))),
New_Item => Parse_Node (CI));
Node := Parse_Node (CI);
Node.Name := US (Get_Name_String (Name (Identifier (Subs))));
Nodes.Insert (Key => To_String (Node.Name),
New_Item => Node);
end if;
elsif Get_Category_Of_Component (CI) = CC_Bus then -- Bus
Busses.Append (Parse_Bus (Subs, CI));
......@@ -390,5 +465,5 @@ package body Deployment_View is
Busses => Busses);
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;
src/deployment_view.ads
View file @ dc546623
......@@ -9,11 +9,12 @@ with Ocarina,
Ada.Containers.Indefinite_Ordered_Maps,
Ada.Containers.Indefinite_Vectors,
Ada.Strings.Unbounded,
-- Option_Type,
Ocarina.Backends.Properties,
Parser_Utils;
use Ocarina,
Ocarina.Types,
Ocarina.Backends.Properties,
Ada.Containers,
Ada.Strings.Unbounded,
Parser_Utils;
......@@ -88,10 +89,25 @@ package Deployment_View is
package Taste_Drivers is
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
record
Name : Unbounded_String;
Drivers : Taste_Drivers.Vector;
Name : Unbounded_String;
Drivers : Taste_Drivers.Vector;
Partitions : Taste_Partitions.Map;
end record;
package Node_Maps is new Indefinite_Ordered_Maps (String, Taste_Node);
......@@ -108,6 +124,6 @@ package Deployment_View is
return Complete_Deployment_View
with Pre => System /= No_Node;
procedure Debug_Dump_DV (DV : Complete_Deployment_View);
procedure Debug_Dump (DV : Complete_Deployment_View);
end Deployment_View;
src/interface_view.adb
View file @ dc546623
......@@ -754,7 +754,7 @@ package body Interface_View is
end loop;
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 := " ";
I : Taste_Interface) is
begin
......@@ -824,5 +824,5 @@ package body Interface_View is
end loop;
New_Line;
end loop;
end Debug_Dump_IV;
end Debug_Dump;
end Interface_View;
src/interface_view.ads
View file @ dc546623
......@@ -179,6 +179,6 @@ package Interface_View is
Iface : String;
To : String);
procedure Debug_Dump_IV (IV : Complete_Interface_View);
procedure Debug_Dump (IV : Complete_Interface_View);
end Interface_View;
src/parser_utils.adb
View file @ dc546623
......@@ -48,8 +48,6 @@ package body Parser_Utils is
Put_Line ("Generate glue code");
Put ("-w, --gw" & HT & HT & HT & HT);
Put_Line ("Generate code skeletons");
Put ("-j, --keep-case" & HT & HT & HT & HT);
Put_Line ("Respect the case for interface names");
Put ("-o, --output <outputDir>" & HT & HT);
Put_Line ("Root directory for the output files");
Put ("-i, --interfaceview <i_view.aadl>" & HT);
......
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