Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
TASTE
kazoo
Commits
dc546623
Commit
dc546623
authored
Dec 05, 2017
by
Maxime Perrotin
Browse files
Add missing parts to the deployment view parser
parent
6402696c
Changes
6
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
);
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment