Commit b7152d58 authored by Julien's avatar Julien
Browse files

Start the VxWorks653 configuration backend

parent 1a096aae
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;
package Ocarina.Backends.Vxworks653_Conf.Hm is
procedure Visit (E : Node_Id);
end Ocarina.Backends.Vxworks653_Conf.Hm;
This diff is collapsed.
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;
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));