Skip to content
GitLab
Commit a5b4f722 authored by Maxime Perrotin's avatar Maxime Perrotin
Browse files

Work on the deployment view parser

parent 18edad5e
Hide whitespace changes
Inline Side-by-side
src/aadl_parser.adb
View file @ a5b4f722
......@@ -71,47 +71,6 @@ procedure AADL_Parser is
procedure Browse_Deployment_View_System
(My_System : Node_Id; NodeName : String) with Unreferenced;
-- Find the bus that is connected to a device through a require
-- access.
------------------------
-- Find_Connected_Bus --
------------------------
procedure Find_Connected_Bus (Device : Node_Id;
Accessed_Bus : out Node_Id;
Accessed_Port : out Node_Id) is
F : Node_Id;
Src : Node_Id;
begin
Accessed_Bus := No_Node;
Accessed_Port := No_Node;
if not Is_Empty (Features (Device)) then
F := First_Node (Features (Device));
while Present (F) loop
-- The sources of F
if not Is_Empty (Sources (F)) then
Src := First_Node (Sources (F));
if Src /= No_Node then
if Item (Src) /= No_Node and then
not Is_Empty (Sources (Item (Src))) and then
First_Node (Sources (Item (Src))) /= No_Node
then
Src := Item (First_Node (Sources (Item (Src))));
Accessed_Bus := Src;
Accessed_Port := F;
end if;
end if;
end if;
F := Next_Node (F);
end loop;
end if;
end Find_Connected_Bus;
----------------------------
-- Process_Interface_View --
----------------------------
......@@ -205,180 +164,6 @@ procedure AADL_Parser is
-- while Present (Processes) loop
-- Tmp_CI := Corresponding_Instance (Processes);
--
-- if Get_Category_Of_Component (Tmp_CI) = CC_Device then
-- declare
-- Device_Classifier : Name_Id := No_Name;
-- Pkg_Name : Name_Id := No_Name;
-- Associated_Processor_Name : Name_Id := No_Name;
-- Accessed_Bus : Node_Id := No_Node;
-- Accessed_Port : Node_Id := No_Node;
-- Accessed_Bus_Name : Name_Id := No_Name;
-- Accessed_Port_Name : Name_Id := No_Name;
-- Device_Configuration : Name_Id := No_Name;
-- Device_Configuration_Len : Integer := 0;
-- Device_ASN1_Filename : Name_Id := No_Name;
-- Device_ASN1_Filename_Len : Integer := 0;
-- Device_Implementation : Node_Id := No_Node;
-- Configuration_Data : Node_Id := No_Node;
-- Device_ASN1_Typename : Name_Id := No_Name;
-- Device_ASN1_Typename_Len : Integer := 0;
-- Device_ASN1_Module : Name_Id := No_Name;
-- Device_ASN1_Module_Len : Integer := 0;
-- begin
--
-- Device_Implementation := Get_Implementation (Tmp_CI);
-- if Device_Implementation /= No_Node and then
-- Is_Defined_Property (Device_Implementation,
-- "deployment::configuration_type")
-- then
-- Configuration_Data
-- := Get_Classifier_Property
-- (Device_Implementation,
-- "deployment::configuration_type");
-- if Configuration_Data /= No_Node and then
-- Is_Defined_Property
-- (Configuration_Data, "type_source_name")
-- then
-- Device_ASN1_Typename :=
-- (Get_String_Property
-- (Configuration_Data, "type_source_name"));
--
-- Device_ASN1_Typename_Len :=
-- Get_Name_String (Device_ASN1_Typename)'Length;
-- declare
-- ST : constant Name_Array
-- := Get_Source_Text (Configuration_Data);
-- begin
-- Exit_On_Error
-- (ST'Length = 0,
-- "Source_Text property of " &
-- "configuration data" &
-- " must have at least one element " &
-- "(the header file).");
--
-- for Index in ST'Range loop
-- Get_Name_String (ST (Index));
-- if Name_Buffer (Name_Len - 3 .. Name_Len)
-- = ".asn"
-- then
-- Device_ASN1_Filename := Get_String_Name
-- (Name_Buffer (1 .. Name_Len));
-- Device_ASN1_Filename_Len :=
-- Get_Name_String
-- (Device_ASN1_Filename)'Length;
-- end if;
-- end loop;
--
-- Exit_On_Error
-- (Device_ASN1_Filename = No_Name,
-- "Cannot find ASN file " &
-- "that implements the device " &
-- "configuration type");
-- end;
-- end if;
-- if Configuration_Data /= No_Node and then
-- Is_Defined_Property
-- (Configuration_Data, "deployment::asn1_module_name")
-- then
-- Device_ASN1_Module :=
-- Get_String_Property
-- (Configuration_Data, "deployment::asn1_module_name");
-- else
-- Device_ASN1_Module := Get_String_Name ("nomod");
-- end if;
--
-- Device_ASN1_Module_Len :=
-- Get_Name_String (Device_ASN1_Module)'Length;
--
-- else
-- Exit_On_Error (true,
-- "Device configuration is incorrect (" &
-- Get_Name_String (Name (Identifier (Tmp_CI))) &
-- ")");
-- end if;
--
-- Set_Str_To_Name_Buffer ("");
-- if ATN.Namespace (Corresponding_Declaration
-- (Tmp_CI)) /= No_Node
-- then
--
-- Set_Str_To_Name_Buffer ("");
-- Get_Name_String
-- (ATN.Name
-- (ATN.Identifier
-- (ATN.Namespace
-- (Corresponding_Declaration (Tmp_CI)))));
-- 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 (Tmp_CI)));
-- Device_Classifier := Name_Find;
-- else
-- Device_Classifier := Name (Identifier (Tmp_CI));
-- end if;
--
-- if Get_Bound_Processor (Tmp_CI) /= No_Node then
-- Set_Str_To_Name_Buffer ("");
-- Associated_Processor_Name := Name
-- (Identifier
-- (Parent_Subcomponent
-- (Get_Bound_Processor (Tmp_CI))));
-- end if;
--
-- if Is_Defined_Property
-- (Tmp_CI, "deployment::configuration") and then
-- Get_String_Property
-- (Tmp_CI, "deployment::configuration") /= No_Name
-- then
-- Get_Name_String
-- (Get_String_Property
-- (Tmp_CI, "deployment::configuration"));
-- Device_Configuration := Name_Find;
-- else
-- Device_Configuration := Get_String_Name ("noconf");
-- end if;
--
-- Device_Configuration_Len := Get_Name_String
-- (Device_Configuration)'Length;
--
-- Find_Connected_Bus (Tmp_CI, Accessed_Bus, Accessed_Port);
-- if Accessed_Bus /= No_Node and then
-- Accessed_Port /= No_Node
-- then
-- Accessed_Bus_Name := Name (Identifier (Accessed_Bus));
-- Accessed_Port_Name := Name (Identifier (Accessed_Port));
-- end if;
--
-- if Associated_Processor_Name /= No_Name then
-- C_New_Device
-- (Get_Name_String (Name (Identifier (Processes))),
-- Get_Name_String
-- (Name (Identifier (Processes)))'Length,
-- Get_Name_String (Device_Classifier),
-- Get_Name_String (Device_Classifier)'Length,
-- Get_Name_String (Associated_Processor_Name),
-- Get_Name_String (Associated_Processor_Name)'Length,
-- Get_Name_String (Device_Configuration),
-- Device_Configuration_Len,
-- Get_Name_String (Accessed_Bus_Name),
-- Get_Name_String (Accessed_Bus_Name)'Length,
-- Get_Name_String (Accessed_Port_Name),
-- Get_Name_String (Accessed_Port_Name)'Length,
-- Get_Name_String (Device_ASN1_Filename),
-- Device_ASN1_Filename_Len,
-- Get_Name_String (Device_ASN1_Typename),
-- Device_ASN1_Typename_Len,
-- Get_Name_String (Device_ASN1_Module),
-- Device_ASN1_Module_Len);
-- C_End_Device;
-- end if;
-- end;
-- end if;
--
-- if Get_Category_Of_Component (Tmp_CI) = CC_Process then
-- declare
-- Node_Coverage : Boolean := False;
......
src/deployment_view.adb
View file @ a5b4f722
......@@ -6,7 +6,7 @@
with -- Ada.Text_IO,
-- Ada.Exceptions,
-- Ocarina.Instances.Queries,
Ocarina.Instances.Queries,
Ocarina.Backends.Properties,
Ocarina.Instances,
Ocarina.Namet,
......@@ -21,7 +21,7 @@ package body Deployment_View is
use -- Ada.Text_IO,
-- Ada.Exceptions,
-- Ocarina.Instances.Queries,
Ocarina.Instances.Queries,
Ocarina.Backends.Properties,
Ocarina.Namet,
Ocarina.ME_AADL.AADL_Instances.Nodes,
......@@ -152,6 +152,159 @@ package body Deployment_View is
return Result;
end Parse_Connections;
-- Find the bus that is connected to a device through a require access
procedure Find_Connected_Bus (Device : Node_Id;
Accessed_Bus : out Node_Id;
Accessed_Port : out Node_Id) is
F : Node_Id;
Src : Node_Id;
begin
Accessed_Bus := No_Node;
Accessed_Port := No_Node;
if not Is_Empty (Features (Device)) then
F := First_Node (Features (Device));
while Present (F) loop
-- The sources of F
if not Is_Empty (Sources (F)) then
Src := First_Node (Sources (F));
if Src /= No_Node then
if Item (Src) /= No_Node and then
not Is_Empty (Sources (Item (Src))) and then
First_Node (Sources (Item (Src))) /= No_Node
then
Src := Item (First_Node (Sources (Item (Src))));
Accessed_Bus := Src;
Accessed_Port := F;
end if;
end if;
end if;
F := Next_Node (F);
end loop;
end if;
end Find_Connected_Bus;
function Parse_Device (dummy_CI : Node_Id) return Taste_Device_Driver is
Result : Taste_Device_Driver;
Device_Classifier : Name_Id := No_Name;
Pkg_Name : Name_Id := No_Name;
Associated_Processor_Name : Name_Id := No_Name;
Accessed_Bus : Node_Id := No_Node;
Accessed_Port : Node_Id := No_Node;
Device_ASN1_Filename : Name_Id := No_Name;
Device_Implementation : Node_Id := No_Node;
Configuration_Data : Node_Id := No_Node;
Device_ASN1_Typename : Name_Id := No_Name;
Device_ASN1_Module : Name_Id := No_Name;
begin
Result.Name := US (Get_Name_String (Name (Identifier (CI))));
Device_Implementation := Get_Implementation (CI);
if Device_Implementation /= No_Node and then
Is_Defined_Property (Device_Implementation,
"deployment::configuration_type")
then
Configuration_Data := Get_Classifier_Property
(Device_Implementation, "deployment::configuration_type");
if Is_Defined_Property (Configuration_Data, "type_source_name")
then
Device_ASN1_Typename :=
(Get_String_Property
(Configuration_Data, "type_source_name"));
declare
ST : constant Name_Array :=
Get_Source_Text (Configuration_Data);
begin
for Index in ST'Range loop
Get_Name_String (ST (Index));
if Name_Buffer (Name_Len - 3 .. Name_Len) = ".asn"
then
Device_ASN1_Filename := Get_String_Name
(Name_Buffer (1 .. Name_Len));
end if;
end loop;
end;
end if;
if Is_Defined_Property
(Configuration_Data, "deployment::asn1_module_name")
then
Device_ASN1_Module := Get_String_Property
(Configuration_Data, "deployment::asn1_module_name");
else
Device_ASN1_Module := Get_String_Name ("nomod");
end if;
else
raise Device_Driver_Error with
"Device configuration is incorrect ("
& Get_Name_String (Name (Identifier (CI))) & ")";
end if;
Set_Str_To_Name_Buffer ("");
if ATN.Namespace (Corresponding_Declaration (CI)) /= No_Node
then
Set_Str_To_Name_Buffer ("");
Get_Name_String (ATN.Name (ATN.Identifier
(ATN.Namespace (Corresponding_Declaration (CI)))));
Pkg_Name := Name_Find;
-- C_Add_Package (Get_Name_String (Pkg_Name),
Set_Str_To_Name_Buffer ("");
Get_Name_String (Pkg_Name);
Add_Str_To_Name_Buffer ("::");
Get_Name_String_And_Append (Name (Identifier (CI)));
Device_Classifier := Name_Find;
else
Device_Classifier := Name (Identifier (CI));
end if;
if Get_Bound_Processor (CI) /= No_Node then
Set_Str_To_Name_Buffer ("");
Associated_Processor_Name := Name
(Identifier (Parent_Subcomponent (Get_Bound_Processor (CI))));
end if;
if Is_Defined_Property (CI, "deployment::configuration") and then
Get_String_Property (CI, "deployment::configuration") /= No_Name
then
Result.Device_Configuration :=
US (Get_Name_String
(Get_String_Property (CI, "deployment::configuration")));
else
Result.Device_Configuration := US ("noconf");
end if;
Find_Connected_Bus (CI, Accessed_Bus, Accessed_Port);
if Accessed_Bus /= No_Node and then Accessed_Port /= No_Node
then
Result.Accessed_Bus_Name :=
US (Get_Name_String (Name (Identifier (Accessed_Bus))));
Result.Accessed_Port_Name :=
US (Get_Name_String (Name (Identifier (Accessed_Port))));
end if;
if Device_ASN1_Filename = No_Name
or Associated_Processor_Name = No_Name
then
raise Device_Driver_Error with "Missing ASN.1 configuration file"
& " for device driver specification "
& Get_Name_String (Device_Classifier);
end if;
Result.Device_Classifier :=
US (Get_Name_String (Device_Classifier));
Result.Associated_Processor_Name :=
US (Get_Name_String (Associated_Processor_Name));
Result.ASN1_Filename :=
US (Get_Name_String (Device_ASN1_Filename));
Result.ASN1_Typename :=
US (Get_Name_String (Device_ASN1_Typename));
Result.ASN1_Module := US (Get_Name_String (Device_ASN1_Module));
return Result;
end Parse_Device;
function Parse_Node (Depl_View_System : Node_Id)
return Taste_Node is
Processes : Node_Id;
......@@ -163,9 +316,7 @@ package body Deployment_View is
while Present (Processes) loop
CI := Corresponding_Instance (Processes);
if Get_Category_Of_Component (CI) = CC_Device then
-- There can be several drivers
null;
Result.Drivers.Append (Parse_Device (CI));
elsif Get_Category_Of_Component (CI) = CC_Process then
-- Partitions?
null;
......@@ -201,6 +352,9 @@ package body Deployment_View is
end if;
elsif Get_Category_Of_Component (CI) = CC_Bus then -- Bus
Busses.Append (Parse_Bus (Subs, CI));
else
raise Deployment_View_Error with "Unknown component found: "
& Get_Category_Of_Component (CI)'Img;
end if;
Subs := Next_Node (Subs);
end loop;
......
src/deployment_view.ads
View file @ a5b4f722
......@@ -25,19 +25,13 @@ package Deployment_View is
-- Exceptions specific to the deployment view
Deployment_View_Error : exception;
Device_Driver_Error : exception;
Empty_Deployment_View_Error : exception;
-- Initialize Ocarina and instantiate the deployment view, return root.
function Initialize (Root : Node_Id) return Node_Id
with Pre => Root /= No_Node;
type Taste_Node is
record
Name : Unbounded_String;
end record;
package Node_Maps is new Indefinite_Ordered_Maps (String, Taste_Node);
type Taste_Bus is
record
Name : Unbounded_String;
......@@ -59,6 +53,30 @@ package Deployment_View is
package Bus_Connections is new Indefinite_Vectors (Natural, Bus_Connection);
type Taste_Device_Driver is
record
Name : Unbounded_String;
Device_Classifier : Unbounded_String;
Associated_Processor_Name : Unbounded_String;
Device_Configuration : Unbounded_String;
Accessed_Bus_Name : Unbounded_String;
Accessed_Port_Name : Unbounded_String;
ASN1_Filename : Unbounded_String;
ASN1_Typename : Unbounded_String;
ASN1_Module : Unbounded_String;
end record;
package Taste_Drivers is
new Indefinite_Vectors (Natural, Taste_Device_Driver);
type Taste_Node is
record
Name : Unbounded_String;
Drivers : Taste_Drivers.Vector;
end record;
package Node_Maps is new Indefinite_Ordered_Maps (String, Taste_Node);
type Complete_Deployment_View is tagged
record
Nodes : Node_Maps.Map;
......
src/parser_version.ads
View file @ a5b4f722
package Parser_Version is
Parser_Release : constant String :=
"d48c71d ; Commit Date: Tue Nov 28 13:54:14 2017 ";
"18edad5 ; Commit Date: Wed Nov 29 17:44:20 2017 ";
Ocarina_Version : constant String :=
"Ocarina 2017.x (Working Copy from r0b92ed3)";
"";
end Parser_Version;
\ No newline at end of file
Supports Markdown
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