Start the VxWorks653 configuration backend

src/backends/ocarina-backends-vxworks653_conf-hm.adb

+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

+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.ads

+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

+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
+