Skip to content
GitLab
Menu
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
TASTE
Ocarina
Commits
b7152d58
Commit
b7152d58
authored
Mar 21, 2015
by
Julien
Browse files
Start the VxWorks653 configuration backend
parent
1a096aae
Changes
14
Expand all
Hide whitespace changes
Inline
Side-by-side
src/backends/ocarina-backends-vxworks653_conf-hm.adb
0 → 100644
View file @
b7152d58
with
Ada
.
Strings
;
use
Ada
.
Strings
;
with
Ada
.
Strings
.
Fixed
;
use
Ada
.
Strings
.
Fixed
;
-- with Locations;
with
Ocarina
.
ME_AADL
;
with
Ocarina
.
ME_AADL
.
AADL_Instances
.
Nodes
;
with
Ocarina
.
ME_AADL
.
AADL_Instances
.
Nutils
;
with
Ocarina
.
ME_AADL
.
AADL_Instances
.
Entities
;
-- with Ocarina.Backends.Properties;
with
Ocarina
.
Backends
.
XML_Tree
.
Nodes
;
with
Ocarina
.
Backends
.
XML_Tree
.
Nutils
;
-- with Ocarina.Backends.Vxworks653_Conf.Mapping;
package
body
Ocarina
.
Backends
.
Vxworks653_Conf
.
Hm
is
-- use Locations;
use
Ocarina
.
ME_AADL
;
use
Ocarina
.
ME_AADL
.
AADL_Instances
.
Nodes
;
use
Ocarina
.
ME_AADL
.
AADL_Instances
.
Entities
;
use
Ocarina
.
Backends
.
XML_Tree
.
Nutils
;
-- use Ocarina.Backends.Properties;
-- use Ocarina.Backends.Vxworks653_Conf.Mapping;
package
AINU
renames
Ocarina
.
ME_AADL
.
AADL_Instances
.
Nutils
;
package
XTN
renames
Ocarina
.
Backends
.
XML_Tree
.
Nodes
;
package
XTU
renames
Ocarina
.
Backends
.
XML_Tree
.
Nutils
;
Root_Node
:
Node_Id
:=
No_Node
;
HM_Node
:
Node_Id
:=
No_Node
;
procedure
Visit_Architecture_Instance
(
E
:
Node_Id
);
procedure
Visit_Component_Instance
(
E
:
Node_Id
);
procedure
Visit_System_Instance
(
E
:
Node_Id
);
procedure
Visit_Process_Instance
(
E
:
Node_Id
);
procedure
Visit_Processor_Instance
(
E
:
Node_Id
);
procedure
Visit_Bus_Instance
(
E
:
Node_Id
);
procedure
Visit_Virtual_Processor_Instance
(
E
:
Node_Id
);
procedure
Add_System_Error
(
XML_Node
:
Node_Id
;
Identifier
:
String
;
Description
:
String
);
procedure
Add_Error_Action
(
XML_Node
:
Node_Id
;
Identifier
:
String
;
Level
:
String
;
Action
:
String
);
-----------
-- Visit --
-----------
procedure
Visit
(
E
:
Node_Id
)
is
begin
case
Kind
(
E
)
is
when
K_Architecture_Instance
=>
Visit_Architecture_Instance
(
E
);
when
K_Component_Instance
=>
Visit_Component_Instance
(
E
);
when
others
=>
null
;
end
case
;
end
Visit
;
---------------------------------
-- Visit_Architecture_Instance --
---------------------------------
procedure
Visit_Architecture_Instance
(
E
:
Node_Id
)
is
begin
Root_Node
:=
Root_System
(
E
);
Visit
(
Root_Node
);
end
Visit_Architecture_Instance
;
------------------------------
-- Visit_Component_Instance --
------------------------------
procedure
Visit_Component_Instance
(
E
:
Node_Id
)
is
Category
:
constant
Component_Category
:=
Get_Category_Of_Component
(
E
);
begin
case
Category
is
when
CC_System
=>
Visit_System_Instance
(
E
);
when
CC_Process
=>
Visit_Process_Instance
(
E
);
when
CC_Processor
=>
Visit_Processor_Instance
(
E
);
when
CC_Bus
=>
Visit_Bus_Instance
(
E
);
when
CC_Virtual_Processor
=>
Visit_Virtual_Processor_Instance
(
E
);
when
others
=>
null
;
end
case
;
end
Visit_Component_Instance
;
----------------------------
-- Visit_Process_Instance --
----------------------------
procedure
Visit_Process_Instance
(
E
:
Node_Id
)
is
S
:
Node_Id
;
begin
if
not
AINU
.
Is_Empty
(
Subcomponents
(
E
))
then
S
:=
First_Node
(
Subcomponents
(
E
));
while
Present
(
S
)
loop
-- Visit the component instance corresponding to the
-- subcomponent S.
Visit
(
Corresponding_Instance
(
S
));
S
:=
Next_Node
(
S
);
end
loop
;
end
if
;
end
Visit_Process_Instance
;
---------------------------
-- Visit_System_Instance --
---------------------------
procedure
Visit_System_Instance
(
E
:
Node_Id
)
is
S
:
Node_Id
;
begin
if
not
AINU
.
Is_Empty
(
Subcomponents
(
E
))
then
S
:=
First_Node
(
Subcomponents
(
E
));
while
Present
(
S
)
loop
-- Visit the component instance corresponding to the
-- subcomponent S.
if
AINU
.
Is_Processor
(
Corresponding_Instance
(
S
))
then
Visit
(
Corresponding_Instance
(
S
));
end
if
;
S
:=
Next_Node
(
S
);
end
loop
;
end
if
;
end
Visit_System_Instance
;
------------------------
-- Visit_Bus_Instance --
------------------------
procedure
Visit_Bus_Instance
(
E
:
Node_Id
)
is
pragma
Unreferenced
(
E
);
begin
null
;
end
Visit_Bus_Instance
;
------------------------
-- Add_System_Error --
------------------------
procedure
Add_System_Error
(
XML_Node
:
Node_Id
;
Identifier
:
String
;
Description
:
String
)
is
Intermediate
:
Node_Id
;
begin
Intermediate
:=
Make_XML_Node
(
"SystemError"
);
XTU
.
Add_Attribute
(
"ErrorIdentifier"
,
Identifier
,
Intermediate
);
XTU
.
Add_Attribute
(
"Description"
,
Description
,
Intermediate
);
Append_Node_To_List
(
Intermediate
,
XTN
.
Subitems
(
XML_Node
));
end
Add_System_Error
;
------------------------
-- Add_Error_Action --
------------------------
procedure
Add_Error_Action
(
XML_Node
:
Node_Id
;
Identifier
:
String
;
Level
:
String
;
Action
:
String
)
is
Intermediate
:
Node_Id
;
begin
Intermediate
:=
Make_XML_Node
(
"ErrorAction"
);
XTU
.
Add_Attribute
(
"ErrorIdentifierRef"
,
Identifier
,
Intermediate
);
XTU
.
Add_Attribute
(
"ErrorLevel"
,
Level
,
Intermediate
);
XTU
.
Add_Attribute
(
"ModuleRecoveryAction"
,
Action
,
Intermediate
);
Append_Node_To_List
(
Intermediate
,
XTN
.
Subitems
(
XML_Node
));
end
Add_Error_Action
;
------------------------------
-- Visit_Processor_Instance --
------------------------------
procedure
Visit_Processor_Instance
(
E
:
Node_Id
)
is
S
:
Node_Id
;
U
:
Node_Id
;
P
:
Node_Id
;
System_Errors
:
Node_Id
;
Multi_Partition_HM
:
Node_Id
;
Partition_HM
:
Node_Id
;
Partition_Identifier
:
Unsigned_Long_Long
;
begin
U
:=
XTN
.
Unit
(
Backend_Node
(
Identifier
(
E
)));
P
:=
XTN
.
Node
(
Backend_Node
(
Identifier
(
E
)));
Push_Entity
(
P
);
Push_Entity
(
U
);
Current_XML_Node
:=
XTN
.
Root_Node
(
XTN
.
XML_File
(
U
));
Partition_Identifier
:=
1
;
--
-- For now, just generate the default HM policy.
--
HM_Node
:=
Make_XML_Node
(
"HealthMonitoring"
);
Append_Node_To_List
(
HM_Node
,
XTN
.
Subitems
(
Current_XML_Node
));
System_Errors
:=
Make_XML_Node
(
"SystemErrors"
);
Append_Node_To_List
(
System_Errors
,
XTN
.
Subitems
(
HM_Node
));
Add_System_Error
(
System_Errors
,
"1"
,
"processorSpecific"
);
Add_System_Error
(
System_Errors
,
"2"
,
"floatingPoint"
);
Add_System_Error
(
System_Errors
,
"3"
,
"accessViolation"
);
Add_System_Error
(
System_Errors
,
"4"
,
"powerTransient"
);
Add_System_Error
(
System_Errors
,
"5"
,
"platformSpecific"
);
Add_System_Error
(
System_Errors
,
"6"
,
"frameResync"
);
Add_System_Error
(
System_Errors
,
"7"
,
"deadlineMissed"
);
Add_System_Error
(
System_Errors
,
"8"
,
"applicationError"
);
Add_System_Error
(
System_Errors
,
"9"
,
"illegalRequest"
);
Add_System_Error
(
System_Errors
,
"10"
,
"stackOverflow"
);
--
-- The MultiPartitionHM
--
Multi_Partition_HM
:=
Make_XML_Node
(
"MultiPartitionHM"
);
XTU
.
Add_Attribute
(
"TableIdentifier"
,
"1"
,
Multi_Partition_HM
);
XTU
.
Add_Attribute
(
"TableName"
,
"default MultiPartitionHM"
,
Multi_Partition_HM
);
Append_Node_To_List
(
Multi_Partition_HM
,
XTN
.
Subitems
(
HM_Node
));
Add_Error_Action
(
Multi_Partition_HM
,
"1"
,
"MODULE"
,
"IGNORE"
);
Add_Error_Action
(
Multi_Partition_HM
,
"2"
,
"MODULE"
,
"IGNORE"
);
Add_Error_Action
(
Multi_Partition_HM
,
"3"
,
"MODULE"
,
"IGNORE"
);
Add_Error_Action
(
Multi_Partition_HM
,
"4"
,
"MODULE"
,
"IGNORE"
);
Add_Error_Action
(
Multi_Partition_HM
,
"5"
,
"MODULE"
,
"IGNORE"
);
Add_Error_Action
(
Multi_Partition_HM
,
"6"
,
"MODULE"
,
"IGNORE"
);
Add_Error_Action
(
Multi_Partition_HM
,
"7"
,
"MODULE"
,
"IGNORE"
);
Add_Error_Action
(
Multi_Partition_HM
,
"8"
,
"MODULE"
,
"IGNORE"
);
Add_Error_Action
(
Multi_Partition_HM
,
"9"
,
"MODULE"
,
"IGNORE"
);
Add_Error_Action
(
Multi_Partition_HM
,
"10"
,
"MODULE"
,
"IGNORE"
);
if
not
AINU
.
Is_Empty
(
Subcomponents
(
E
))
then
S
:=
First_Node
(
Subcomponents
(
E
));
while
Present
(
S
)
loop
-- Visit the component instance corresponding to the
-- subcomponent S.
if
AINU
.
Is_Virtual_Processor
(
Corresponding_Instance
(
S
))
then
Visit
(
Corresponding_Instance
(
S
));
--
-- The PartitionHM
--
Partition_HM
:=
Make_XML_Node
(
"PartitionHM"
);
Append_Node_To_List
(
Partition_HM
,
XTN
.
Subitems
(
HM_Node
));
XTU
.
Add_Attribute
(
"TableIdentifier"
,
Trim
(
Unsigned_Long_Long
'
Image
(
Partition_Identifier
),
Left
),
Partition_HM
);
XTU
.
Add_Attribute
(
"TableName"
,
"Unique name for partition "
&
Trim
(
Unsigned_Long_Long
'
Image
(
Partition_Identifier
),
Left
),
Partition_HM
);
XTU
.
Add_Attribute
(
"MultiPartitionHMTableNameRef"
,
"default MultiPartitionHM"
,
Partition_HM
);
Partition_Identifier
:=
Partition_Identifier
+
1
;
end
if
;
S
:=
Next_Node
(
S
);
end
loop
;
end
if
;
Pop_Entity
;
Pop_Entity
;
end
Visit_Processor_Instance
;
--------------------------------------
-- Visit_Virtual_Processor_Instance --
--------------------------------------
procedure
Visit_Virtual_Processor_Instance
(
E
:
Node_Id
)
is
S
:
Node_Id
;
begin
if
not
AINU
.
Is_Empty
(
Subcomponents
(
E
))
then
S
:=
First_Node
(
Subcomponents
(
E
));
while
Present
(
S
)
loop
Visit
(
Corresponding_Instance
(
S
));
S
:=
Next_Node
(
S
);
end
loop
;
end
if
;
end
Visit_Virtual_Processor_Instance
;
end
Ocarina
.
Backends
.
Vxworks653_Conf
.
Hm
;
src/backends/ocarina-backends-vxworks653_conf-hm.ads
0 → 100644
View file @
b7152d58
package
Ocarina
.
Backends
.
Vxworks653_Conf
.
Hm
is
procedure
Visit
(
E
:
Node_Id
);
end
Ocarina
.
Backends
.
Vxworks653_Conf
.
Hm
;
src/backends/ocarina-backends-vxworks653_conf-mapping.adb
0 → 100644
View file @
b7152d58
This diff is collapsed.
Click to expand it.
src/backends/ocarina-backends-vxworks653_conf-mapping.ads
0 → 100644
View file @
b7152d58
with
Ocarina
.
Backends
.
Properties
;
use
Ocarina
.
Backends
.
Properties
;
package
Ocarina
.
Backends
.
Vxworks653_Conf
.
Mapping
is
function
Map_Distributed_Application
(
E
:
Node_Id
)
return
Node_Id
;
function
Map_HI_Node
(
E
:
Node_Id
)
return
Node_Id
;
function
Map_HI_Unit
(
E
:
Node_Id
)
return
Node_Id
;
function
Map_Port
(
F
:
Node_Id
)
return
Node_Id
;
function
Map_Data
(
E
:
Node_Id
)
return
Node_Id
;
function
Map_Data_Access
(
E
:
Node_Id
)
return
Node_Id
;
function
Map_Bus_Access
(
E
:
Node_Id
)
return
Node_Id
;
function
Map_System
(
E
:
Node_Id
)
return
Node_Id
;
function
Map_Process
(
E
:
Node_Id
;
Partition_Identifier
:
Unsigned_Long_Long
)
return
Node_Id
;
function
Map_Data_Size
(
T
:
Size_Type
)
return
Unsigned_Long_Long
;
function
Map_Virtual_Processor
(
E
:
Node_Id
)
return
Node_Id
;
function
Map_Processor
(
E
:
Node_Id
)
return
Node_Id
;
function
Map_Partition
(
Process
:
Node_Id
;
Runtime
:
Node_Id
;
Partition_Identifier
:
Integer
;
Nb_Threads
:
Unsigned_Long_Long
;
Nb_Buffers
:
Unsigned_Long_Long
;
Nb_Events
:
Unsigned_Long_Long
;
Nb_Lock_Objects
:
Unsigned_Long_Long
;
Nb_Blackboards
:
Unsigned_Long_Long
;
Blackboards_Size
:
Unsigned_Long_Long
;
Buffers_Size
:
Unsigned_Long_Long
)
return
Node_Id
;
function
Map_Bus
(
E
:
Node_Id
)
return
Node_Id
;
function
Map_Port_Connection
(
E
:
Node_Id
)
return
Node_Id
;
function
Map_Process_Memory
(
Process
:
Node_Id
)
return
Node_Id
;
procedure
Map_Process_Scheduling
(
Process
:
Node_Id
;
Window_Number
:
in
out
Unsigned_Long_Long
;
N
:
out
Node_Id
);
function
Map_Connection
(
Connection
:
Node_Id
;
Channel_Identifier
:
Unsigned_Long_Long
)
return
Node_Id
;
function
Map_Process_HM_Table
(
Process
:
Node_Id
)
return
Node_Id
;
function
Map_Processor_HM_Table
(
Processor
:
Node_Id
)
return
Node_Id
;
function
Map_Sampling_Port
(
Port
:
Node_Id
)
return
Node_Id
;
function
Map_Queuing_Port
(
Port
:
Node_Id
)
return
Node_Id
;
end
Ocarina
.
Backends
.
Vxworks653_Conf
.
Mapping
;
src/backends/ocarina-backends-vxworks653_conf-naming.adb
0 → 100644
View file @
b7152d58
with
Locations
;
with
Ocarina
.
ME_AADL
;
with
Ocarina
.
ME_AADL
.
AADL_Instances
.
Nodes
;
with
Ocarina
.
ME_AADL
.
AADL_Instances
.
Nutils
;
with
Ocarina
.
ME_AADL
.
AADL_Instances
.
Entities
;
with
Ocarina
.
Backends
.
Properties
;
with
Ocarina
.
Backends
.
XML_Tree
.
Nodes
;
with
Ocarina
.
Backends
.
XML_Tree
.
Nutils
;
with
Ocarina
.
Backends
.
Vxworks653_Conf
.
Mapping
;
package
body
Ocarina
.
Backends
.
Vxworks653_Conf
.
Naming
is
use
Locations
;
use
Ocarina
.
ME_AADL
;
use
Ocarina
.
ME_AADL
.
AADL_Instances
.
Nodes
;
use
Ocarina
.
ME_AADL
.
AADL_Instances
.
Entities
;
use
Ocarina
.
Backends
.
XML_Tree
.
Nutils
;
use
Ocarina
.
Backends
.
Properties
;
use
Ocarina
.
Backends
.
Vxworks653_Conf
.
Mapping
;
package
AINU
renames
Ocarina
.
ME_AADL
.
AADL_Instances
.
Nutils
;
package
AIN
renames
Ocarina
.
ME_AADL
.
AADL_Instances
.
Nodes
;
package
XTN
renames
Ocarina
.
Backends
.
XML_Tree
.
Nodes
;
package
XTU
renames
Ocarina
.
Backends
.
XML_Tree
.
Nutils
;
procedure
Visit_Component
(
E
:
Node_Id
);
procedure
Visit_System
(
E
:
Node_Id
);
procedure
Visit_Process
(
E
:
Node_Id
);
procedure
Visit_Processor
(
E
:
Node_Id
);
procedure
Visit_Virtual_Processor
(
E
:
Node_Id
);
procedure
Add_Applications
(
AADL_Processor
:
Node_Id
;
XML_Node
:
Node_Id
);
procedure
Add_Shared_Data_Regions
(
AADL_Processor
:
Node_Id
;
XML_Node
:
Node_Id
);
procedure
Add_Shared_Library_Regions
(
AADL_Processor
:
Node_Id
;
XML_Node
:
Node_Id
);
-----------
-- Visit --
-----------
procedure
Visit
(
E
:
Node_Id
)
is
begin
case
Kind
(
E
)
is
when
K_Architecture_Instance
=>
Visit
(
Root_System
(
E
));
when
K_Component_Instance
=>
Visit_Component
(
E
);
when
others
=>
null
;
end
case
;
end
Visit
;
---------------------
-- Visit_Component --
---------------------
procedure
Visit_Component
(
E
:
Node_Id
)
is
Category
:
constant
Component_Category
:=
Get_Category_Of_Component
(
E
);
begin
case
Category
is
when
CC_System
=>
Visit_System
(
E
);
when
CC_Process
=>
Visit_Process
(
E
);
when
CC_Device
=>
Visit_Process
(
E
);
when
CC_Processor
=>
Visit_Processor
(
E
);
when
CC_Virtual_Processor
=>
Visit_Virtual_Processor
(
E
);
when
others
=>
null
;
end
case
;
end
Visit_Component
;
-------------------
-- Visit_Process --
-------------------
procedure
Visit_Process
(
E
:
Node_Id
)
is
N
:
Node_Id
;
Processes_List
:
List_Id
;
begin
Processes_List
:=
XTN
.
Processes
(
Backend_Node
(
Identifier
(
Get_Bound_Processor
(
E
))));
N
:=
XTU
.
Make_Container
(
E
);
XTU
.
Append_Node_To_List
(
N
,
Processes_List
);
end
Visit_Process
;
--------------------------------------
-- Visit_Virtual_Processor_Instance --
--------------------------------------
procedure
Visit_Virtual_Processor
(
E
:
Node_Id
)
is
Processes
:
List_Id
;
N
:
Node_Id
;
begin
N
:=
New_Node
(
XTN
.
K_HI_Tree_Bindings
);
AIN
.
Set_Backend_Node
(
Identifier
(
E
),
N
);
Processes
:=
XTU
.
New_List
(
XTN
.
K_List_Id
);
XTN
.
Set_Processes
(
N
,
Processes
);
end
Visit_Virtual_Processor
;
---------------------
-- Visit_Processor --
---------------------
procedure
Visit_Processor
(
E
:
Node_Id
)
is
S
:
Node_Id
;
P
:
Node_Id
;
U
:
Node_Id
;
N
:
Node_Id
;
Processes
:
List_Id
;
begin
P
:=
Map_HI_Node
(
E
);
Push_Entity
(
P
);
U
:=
Map_HI_Unit
(
E
);
Push_Entity
(
U
);
if
not
AINU
.
Is_Empty
(
Subcomponents
(
E
))
then
S
:=
First_Node
(
Subcomponents
(
E
));
while
Present
(
S
)
loop
-- Visit the component instance corresponding to the
-- subcomponent S.
Visit
(
Corresponding_Instance
(
S
));
S
:=
Next_Node
(
S
);
end
loop
;
end
if
;
N
:=
New_Node
(
XTN
.
K_HI_Tree_Bindings
);
Processes
:=
AINU
.
New_List
(
K_Node_Id
,
No_Location
);
XTN
.
Set_Processes
(
N
,
Processes
);
XTN
.
Set_Unit
(
N
,
U
);
XTN
.
Set_Node
(
N
,
P
);
AIN
.
Set_Backend_Node
(
Identifier
(
E
),
N
);
Add_Applications
(
E
,
XTN
.
Root_Node
(
XTN
.
XML_File
(
U
)));
Add_Shared_Data_Regions
(
E
,
XTN
.
Root_Node
(
XTN
.
XML_File
(
U
)));
Add_Shared_Library_Regions
(
E
,
XTN
.
Root_Node
(
XTN
.
XML_File
(
U
)));
Pop_Entity
;
Pop_Entity
;
end
Visit_Processor
;
------------------
-- Visit_System --
------------------
procedure
Visit_System
(
E
:
Node_Id
)
is
S
:
Node_Id
;
Component_Instance
:
Node_Id
;
begin
if
not
AINU
.
Is_Empty
(
Subcomponents
(
E
))
then
S
:=
First_Node
(
Subcomponents
(
E
));
while
Present
(
S
)
loop
Component_Instance
:=
Corresponding_Instance
(
S
);
if
Get_Category_Of_Component
(
Component_Instance
)
=
CC_Processor
then
Visit_Processor
(
Component_Instance
);
end
if
;
S
:=
Next_Node
(
S
);
end
loop
;
end
if
;
if
not
AINU
.
Is_Empty
(
Subcomponents
(
E
))
then
S
:=
First_Node
(
Subcomponents
(
E
));
while
Present
(
S
)
loop
-- Visit the component instance corresponding to the
-- subcomponent S.
if
AINU
.
Is_Process_Or_Device
(
Corresponding_Instance
(
S
))
then
Visit_Process
(
Corresponding_Instance
(
S
));
end
if
;
S
:=
Next_Node
(
S
);
end
loop
;
end
if
;
end
Visit_System
;
procedure
Add_Applications
(
AADL_Processor
:
Node_Id
;
XML_Node
:
Node_Id
)
is
pragma
Unreferenced
(
AADL_Processor
);
Applications_Node
:
Node_Id
;
Application_Node
:
Node_Id
;
Application_Description_Node
:
Node_Id
;
Memory_Size_Node
:
Node_Id
;
Ports_Node
:
Node_Id
;
begin
-- Applications Node first
Applications_Node
:=
Make_XML_Node
(
"Applications"
);
Append_Node_To_List
(
Applications_Node
,
XTN
.
Subitems
(
XML_Node
));