Commit df7e9a26 authored by Julien's avatar Julien

Update the VxWorks configuration generator

parent ffe3e41f
-- 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.XML_Tree.Nodes;
with Ocarina.Backends.XML_Tree.Nutils;
-- with Ocarina.Backends.Vxworks653_Conf.Mapping;
package body Ocarina.Backends.Vxworks653_Conf.Connections 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.Vxworks653_Conf.Mapping;
package AINU renames Ocarina.ME_AADL.AADL_Instances.Nutils;
package XTN renames Ocarina.Backends.XML_Tree.Nodes;
Root_Node : Node_Id := No_Node;
Schedules_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);
-----------
-- 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;
------------------------------
-- Visit_Processor_Instance --
------------------------------
procedure Visit_Processor_Instance (E : Node_Id) is
U : Node_Id;
P : Node_Id;
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));
Schedules_Node := Make_XML_Node ("Connections");
Append_Node_To_List
(Schedules_Node,
XTN.Subitems (Current_XML_Node));
Pop_Entity;
Pop_Entity;
end Visit_Processor_Instance;
--------------------------------------
-- Visit_Virtual_Processor_Instance --
--------------------------------------
procedure Visit_Virtual_Processor_Instance (E : Node_Id) is
pragma Unreferenced (E);
begin
null;
end Visit_Virtual_Processor_Instance;
end Ocarina.Backends.Vxworks653_Conf.Connections;
package Ocarina.Backends.Vxworks653_Conf.Connections is
procedure Visit (E : Node_Id);
end Ocarina.Backends.Vxworks653_Conf.Connections;
-- 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.XML_Tree.Nodes;
with Ocarina.Backends.XML_Tree.Nutils;
-- with Ocarina.Backends.Vxworks653_Conf.Mapping;
package body Ocarina.Backends.Vxworks653_Conf.Payloads 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;
Root_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);
-----------
-- 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;
------------------------------
-- Visit_Processor_Instance --
------------------------------
procedure Visit_Processor_Instance (E : Node_Id) is
U : Node_Id;
P : Node_Id;
Payloads_Node : Node_Id;
Core_OS_Payload_Node : Node_Id;
Shared_Library_Payload_Node : Node_Id;
Config_Record_Payload_Node : Node_Id;
Partition_Payload_Node : Node_Id;
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));
Payloads_Node := Make_XML_Node ("Payloads");
Append_Node_To_List
(Payloads_Node,
XTN.Subitems (Current_XML_Node));
Core_OS_Payload_Node
:= Make_XML_Node ("CoreOSPayload");
Append_Node_To_List (Core_OS_Payload_Node,
XTN.Subitems (Payloads_Node));
Shared_Library_Payload_Node
:= Make_XML_Node ("SharedLibraryPayload");
Add_Attribute ("NameRef",
"vxSysLib",
Shared_Library_Payload_Node);
Append_Node_To_List (Shared_Library_Payload_Node,
XTN.Subitems (Payloads_Node));
Config_Record_Payload_Node
:= Make_XML_Node ("ConfigRecordPayload");
Add_Attribute ("NameRef",
"configRecord",
Config_Record_Payload_Node);
Append_Node_To_List (Config_Record_Payload_Node,
XTN.Subitems (Payloads_Node));
Partition_Payload_Node
:= Make_XML_Node ("PartitionPayload");
Add_Attribute ("NameRef",
"tobefixed",
Partition_Payload_Node);
Append_Node_To_List (Partition_Payload_Node,
XTN.Subitems (Payloads_Node));
Pop_Entity;
Pop_Entity;
end Visit_Processor_Instance;
--------------------------------------
-- Visit_Virtual_Processor_Instance --
--------------------------------------
procedure Visit_Virtual_Processor_Instance (E : Node_Id) is
pragma Unreferenced (E);
begin
null;
end Visit_Virtual_Processor_Instance;
end Ocarina.Backends.Vxworks653_Conf.Payloads;
package Ocarina.Backends.Vxworks653_Conf.Payloads is
procedure Visit (E : Node_Id);
end Ocarina.Backends.Vxworks653_Conf.Payloads;
......@@ -37,7 +37,7 @@ package body Ocarina.Backends.Vxworks653_Conf.Schedule is
package XTU renames Ocarina.Backends.XML_Tree.Nutils;
Root_Node : Node_Id := No_Node;
Schedule_Node : Node_Id := No_Node;
Schedules_Node : Node_Id := No_Node;
procedure Visit_Architecture_Instance (E : Node_Id);
procedure Visit_Component_Instance (E : Node_Id);
......@@ -157,47 +157,42 @@ package body Ocarina.Backends.Vxworks653_Conf.Schedule is
---------------------------
procedure Fill_Scheduling_Slots (Processor : Node_Id) is
Time_Window_Node : Node_Id;
Partition_Window_Node : Node_Id;
Schedule_Node : Node_Id;
Module_Schedule : constant Schedule_Window_Record_Term_Array
:= Get_Module_Schedule_Property (Processor);
Offset : Unsigned_Long_Long;
Slot_Duration : Unsigned_Long_Long;
Partition_Duration : Float;
begin
Offset := 0;
Schedule_Node := Make_XML_Node ("Schedule");
XTU.Add_Attribute ("Id", "0", Schedule_Node);
Append_Node_To_List (Schedule_Node, XTN.Subitems (Schedules_Node));
for J in Module_Schedule'Range loop
Time_Window_Node := Make_XML_Node ("PartitionTimeWindow");
Partition_Window_Node := Make_XML_Node ("PartitionWindow");
Append_Node_To_List
(Time_Window_Node,
(Partition_Window_Node,
XTN.Subitems (Schedule_Node));
-- XTU.Add_Attribute ("Duration", "6000000", Time_Window_Node);
--
-- For now, we assume the partition duration
-- is in milliseconds.
--
Slot_Duration := To_Milliseconds
(Module_Schedule (J).Duration) * 1_000_000;
Partition_Duration := 1000.0 /
(Float
(To_Milliseconds
(Module_Schedule (J).Duration)) * Float (100.0));
XTU.Add_Attribute ("Duration",
Trim (Unsigned_Long_Long'Image
(Slot_Duration), Left),
Time_Window_Node);
XTU.Add_Attribute ("Offset",
Trim (Unsigned_Long_Long'Image
(Offset), Left),
Time_Window_Node);
XTU.Add_Attribute ("PeriodicProcessingStart",
"true", Time_Window_Node);
XTU.Add_Attribute ("RepeatWindowAtNanosecondInterval",
"PartitionPeriod", Time_Window_Node);
XTU.Add_Attribute ("InhibitEarlyCompletion",
"false", Time_Window_Node);
Trim (Float'Image
(Partition_Duration), Left),
Partition_Window_Node);
XTU.Add_Attribute ("ReleasePoint",
"1", Partition_Window_Node);
XTU.Add_Attribute ("PartitionNameRef",
Get_Name_String
(Module_Schedule (J).Partition),
Time_Window_Node);
Offset := Offset + Slot_Duration;
Partition_Window_Node);
end loop;
end Fill_Scheduling_Slots;
......@@ -218,13 +213,10 @@ package body Ocarina.Backends.Vxworks653_Conf.Schedule is
Current_XML_Node := XTN.Root_Node (XTN.XML_File (U));
Schedule_Node := Make_XML_Node ("Schedule");
XTU.Add_Attribute ("MajorFrameLength",
"Automatic", Schedule_Node);
Schedules_Node := Make_XML_Node ("Schedules");
Append_Node_To_List
(Schedule_Node,
(Schedules_Node,
XTN.Subitems (Current_XML_Node));
if Is_Defined_Property (E, "arinc653::module_schedule") then
......
......@@ -8,6 +8,8 @@ with Ocarina.Backends.Vxworks653_Conf.HM;
with Ocarina.Backends.VxWorks653_Conf.Schedule;
with Ocarina.Backends.VxWorks653_Conf.Naming;
with Ocarina.Backends.Vxworks653_Conf.Partitions;
with Ocarina.Backends.Vxworks653_Conf.Payloads;
with Ocarina.Backends.Vxworks653_Conf.Connections;
with Ocarina.Backends.Utils;
with GNAT.Command_Line; use GNAT.Command_Line;
......@@ -128,7 +130,9 @@ package body Ocarina.Backends.Vxworks653_Conf is
Vxworks653_Conf.Naming.Visit (E);
Vxworks653_Conf.Partitions.Visit (E);
Vxworks653_Conf.Schedule.Visit (E);
Vxworks653_Conf.Connections.Visit (E);
Vxworks653_Conf.HM.Visit (E);
Vxworks653_Conf.Payloads.Visit (E);
XTU.Pop_Entity;
......
Markdown is supported
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