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
80b74ef8
Commit
80b74ef8
authored
Mar 24, 2019
by
Maxime Perrotin
Browse files
Work on the concurrency view
parent
5580af77
Changes
4
Hide whitespace changes
Inline
Side-by-side
src/aadl_parser.adb
View file @
80b74ef8
...
...
@@ -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
;
...
...
src/taste-aadl_parser.adb
View file @
80b74ef8
...
...
@@ -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
...
...
src/taste-concurrency_view.adb
View file @
80b74ef8
...
...
@@ -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
;
src/taste-concurrency_view.ads
View file @
80b74ef8
...
...
@@ -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
;
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