------------------------------------------------------ -------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- G A I A . P R O C E S S O R -- -- -- -- B o d y -- -- -- -- Copyright (C) 2005-2007, GET-Telecom Paris. -- -- -- -- Ocarina is free software; you can redistribute it and/or modify -- -- it under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. Ocarina is distributed in the hope that it will be -- -- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of -- -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -- -- Public License for more details. You should have received a copy of the -- -- GNU General Public License distributed with Ocarina; see file COPYING. -- -- If not, write to the Free Software Foundation, 51 Franklin Street, Fifth -- -- Floor, Boston, MA 02111-1301, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- -- Ocarina is maintained by the Ocarina team -- -- (ocarina-users@listes.enst.fr) -- -- -- ------------------------------------------------------------------------------ with Output; with Namet; with Ocarina.Nodes; with Ocarina.Nutils; with Ocarina.AADL_Values; with Gaia.Processor.Nodes; with Gaia.Processor.Nodes.Utils; with Gaia.Processor.Entities.Namespaces; with Gaia.Processor.Entities.Components; with Gaia.Processor.Messages; with Ocarina.Entities; with Ocarina.Entities.Components; with Ocarina.Analyzer.Queries; with GNAT.Table; use Ocarina.Nutils; use Ocarina.Entities; use Ocarina.AADL_Values; package body Gaia.Processor is package ON renames Ocarina.Nodes; package ONU renames Ocarina.Nutils; package GN renames Gaia.Processor.Nodes; package GNU renames Gaia.Processor.Nodes.Utils; function Filter_Name (Name : String) return String; -- eliminate all illegal characters from Name function Generate_Subset_Of_Architecture_Instance (Instance : Node_Id; Architecture_Instance : Node_Id; Distributed_Application : Node_Id) return Boolean; -- Extract the necessary information for the code generator of -- Gaia from a system or a process Instance of the whole -- architecture Architecture_Instance. Return True is everything -- was OK, else False. function Process_Subarchitecture_Instance (Instance : Node_Id; Architecture_Instance : Node_Id; Distributed_Application : Node_Id) return Boolean; ---------- -- Init -- ---------- procedure Init is begin Gaia.Processor.Entities.Components.Init; GNU.Init_Variables; end Init; ----------- -- Reset -- ----------- procedure Reset is begin GN.Entries.Init; end Reset; ----------------- -- Filter_Name -- ----------------- function Filter_Name (Name : String) return String is Position : Integer; Found_Dot : Boolean := False; begin for P in Name'Range loop if Name (P) = '.' then Position := P; Found_Dot := True; exit; end if; end loop; if Found_Dot then return "impl_" & Name (Name'First .. Position - 1) & "_" & Name (Position + 1 .. Name'Last); else return "spec_" & Name; end if; end Filter_Name; -------------------------------- -- Write_Unique_Instance_Name -- -------------------------------- procedure Write_Unique_Instance_Name (Instance : Node_Id) is use Output; pragma Assert (Instance /= No_Node); begin Write_Str (Filter_Name (Get_Name_Of_Entity (Instance, False))); Write_Int (Int (Instance)); end Write_Unique_Instance_Name; ------------------------- -- Write_Instance_Name -- ------------------------- procedure Write_Instance_Name (Instance : Node_Id) is use Output; pragma Assert (Instance /= No_Node); begin Write_Str (Filter_Name (Get_Name_Of_Entity (Instance, False))); end Write_Instance_Name; ---------------------------------------------- -- Generate_Subset_Of_Architecture_Instance -- ---------------------------------------------- function Generate_Subset_Of_Architecture_Instance (Instance : Node_Id; Architecture_Instance : Node_Id; Distributed_Application : Node_Id) return Boolean is use Namet; use Output; use ON; use GN; use GNU; use Gaia.Processor.Entities.Namespaces; use Gaia.Processor.Entities.Components; use Gaia.Processor; use Gaia.Processor.Messages; use Ocarina.Entities.Components; pragma Assert (Kind (Architecture_Instance) = K_Architecture_Instance); pragma Assert (Kind (Instance) = K_Component_Instance and then Get_Category_Of_Component (Instance) = CC_Process); pragma Assert (GN.Kind (Distributed_Application) = K_Distributed_Application); Success : Boolean := True; List_Node : Node_Id; Root_Node : constant Node_Id := GNU.New_Node (GN.K_Root_Node); Namespace : Node_Id; Identifier : Node_Id; begin -- The name of the node is the name of its process Identifier := GNU.Make_Identifier (Normalize_Name (Get_Name_Of_Entity (ON.Parent_Subcomponent (Instance)))); Bind_Identifier_To_Entity (Identifier, Root_Node); GN.Set_Scoped_Name (Root_Node, GNU.Append_Scoped_Name (No_Node, Root_Node, Normalize_Name (Get_Name_Of_Entity (Instance)))); GN.Set_Thread_Number (Root_Node, 0); GN.Set_Priority_Managed (Root_Node, False); GN.Set_Namespaces (Root_Node, GNU.New_List (GN.K_List_Id)); Display_Message ("* Processing " & Get_Name_String (Compute_Full_Name_Of_Instance (Instance, True)) & "..."); -- Retrieve the location of the process, by fetching the -- location of the processor it is bounded to Set_Node_Location (Root_Node, Get_Process_Location (Instance)); Set_Port_Number (Root_Node, Get_Process_Port_Number (Instance)); -- Process the namespaces if not ONU.Is_Empty (ON.Namespaces (Architecture_Instance)) then List_Node := ON.First_Node (ON.Namespaces (Architecture_Instance)); while Present (List_Node) loop Namespace := Process_Namespace (List_Node, Root_Node); Success := (Namespace /= No_Node) and then Success; List_Node := ON.Next_Node (List_Node); end loop; end if; -- The main package if Unnamed_Namespace (Architecture_Instance) /= No_Node then Namespace := Process_Namespace (Unnamed_Namespace (Architecture_Instance), Root_Node); Success := (Namespace /= No_Node) and then Success; end if; if Namespace /= No_Node then Success := Process_Process (Instance, Namespace) and then Success; end if; if Success then GNU.Append_Node_To_List (Root_Node, Root_Nodes (Distributed_Application)); end if; return Success; end Generate_Subset_Of_Architecture_Instance; ----------------- -- Filter_Name -- ----------------- function Normalize_Name (Name : Name_Id) return Name_Id is use Namet; Filtered_Name : Name_Id; begin -- XXX The algorithm does not ensure a bijection between the -- input and the output. It should be improved. if Name = No_Name then Filtered_Name := Name; else declare Initial_Name : constant String := Get_Name_String (Name); begin Name_Len := 0; for Index in Initial_Name'First .. Initial_Name'Last loop if Initial_Name (Index) = '.' then Add_Char_To_Name_Buffer ('_'); else Add_Char_To_Name_Buffer (Initial_Name (Index)); end if; end loop; Filtered_Name := Name_Find; end; end if; return Filtered_Name; end Normalize_Name; -------------------------------------- -- Process_Subarchitecture_Instance -- -------------------------------------- function Process_Subarchitecture_Instance (Instance : Node_Id; Architecture_Instance : Node_Id; Distributed_Application : Node_Id) return Boolean is use ON; use GN; use GNU; use Ocarina.Entities.Components; use Gaia.Processor; pragma Assert (ON.Kind (Architecture_Instance) = K_Architecture_Instance); pragma Assert (ON.Kind (Instance) = K_Component_Instance); pragma Assert (GN.Kind (Distributed_Application) = K_Distributed_Application); Success : Boolean := True; List_Node : Node_Id; Identifier : Node_Id; begin case Get_Category_Of_Component (Instance) is when CC_Process => Success := Generate_Subset_Of_Architecture_Instance (Instance, Architecture_Instance, Distributed_Application); when CC_System => if Parent_Subcomponent (Instance) = No_Node then -- The distributed application name is the name of the -- whole system iplementation Identifier := GNU.Make_Identifier (Get_Name_Of_Entity (Instance)); Bind_Identifier_To_Entity (Identifier, Distributed_Application); Set_Protocol (Distributed_Application, Get_DA_Protocol_Name (Instance)); end if; if not ONU.Is_Empty (Subcomponents (Instance)) then List_Node := ON.First_Node (Subcomponents (Instance)); while List_Node /= No_Node loop Success := Process_Subarchitecture_Instance (Corresponding_Instance (List_Node), Architecture_Instance, Distributed_Application) and then Success; List_Node := ON.Next_Node (List_Node); end loop; end if; when others => null; end case; return Success; end Process_Subarchitecture_Instance; ----------------------------------- -- Process_Architecture_Instance -- ----------------------------------- procedure Process_Architecture_Instance (Architecture_Instance : Node_Id; Neutral_Tree_Root : out Node_Id; Output_Directory : String := "."; Success : out Boolean) is use Namet; use ON; use Gaia.Processor; use Gaia.Processor.Messages; pragma Assert (Kind (Architecture_Instance) = K_Architecture_Instance); Instance : Node_Id; begin Success := False; -- Getting the root system of the AADL architecture Instance := Root_System (Architecture_Instance); -- Preparing the neutral tree root Neutral_Tree_Root := GNU.New_Node (GN.K_Distributed_Application); GN.Set_Root_Nodes (Neutral_Tree_Root, GNU.New_List (GN.K_List_Id)); if Instance /= No_Node then Success := Process_Subarchitecture_Instance (Instance, Architecture_Instance, Neutral_Tree_Root); -- Add all the missing links to the Gaia tree Add_All_Missed_Links; end if; if Success then if Output_Directory /= "." then Display_Message ("AADL files correctly processed in " & Output_Directory); else Display_Message ("AADL files correctly processed in " & Get_Name_Of_Entity (Instance)); end if; else Display_Message ("ERROR while processing AADL files"); end if; end Process_Architecture_Instance; -------------------------- -- Get_DA_Protocol_Name -- -------------------------- function Get_DA_Protocol_Name (System_Instance : Node_Id) return Name_Id is use Namet; use ON; use Ocarina.Analyzer.Queries; use Ocarina.Entities.Components; use Gaia.Processor.Messages; pragma Assert (ON.Kind (System_Instance) = K_Component_Instance and then Get_Category_Of_Component (System_Instance) = CC_System and then Parent_Subcomponent (System_Instance) = No_Node); Protocol_Name : Name_Id := No_Name; begin if not Is_Defined_Enumeration_Property (System_Instance, "arao::protocol") then Display_Message ("No protocol specified"); else Protocol_Name := Get_Enumeration_Property (System_Instance, "arao::protocol"); if Get_Name_String (Protocol_Name) = "iiop" then Set_Str_To_Name_Buffer ("giop/iiop"); end if; if Get_Name_String (Protocol_Name) = "diop" then Set_Str_To_Name_Buffer ("giop/diop"); end if; Protocol_Name := Name_Find; end if; return Protocol_Name; end Get_DA_Protocol_Name; -------------------------- -- Get_Process_Location -- -------------------------- function Get_Process_Location (Process_Instance : Node_Id) return Name_Id is use ON; use Ocarina.Analyzer.Queries; use Ocarina.Entities.Components; use Gaia.Processor.Messages; pragma Assert (ON.Kind (Process_Instance) = K_Component_Instance and then Get_Category_Of_Component (Process_Instance) = CC_Process); Bound_Processor : Node_Id; Process_Location : Name_Id := No_Name; begin if Is_Defined_Reference_Property (Process_Instance, "actual_processor_binding") then Bound_Processor := Get_Reference_Property (Process_Instance, "actual_processor_binding"); if Bound_Processor /= No_Node and then Is_Defined_String_Property (Bound_Processor, "arao::location") then Process_Location := Get_String_Property (Bound_Processor, "arao::location"); else Display_Message ("No location for the processor"); end if; else Display_Message ("No processor binding"); end if; return Process_Location; end Get_Process_Location; ----------------------------- -- Get_Process_Port_Number -- ----------------------------- function Get_Process_Port_Number (Process_Instance : Node_Id) return Value_Id is use ON; use Ocarina.Analyzer.Queries; use Ocarina.Entities.Components; use Gaia.Processor.Messages; pragma Assert (ON.Kind (Process_Instance) = K_Component_Instance and then Get_Category_Of_Component (Process_Instance) = CC_Process); Port_Number : Value_Id; -- := V_Zero; begin if Is_Defined_Integer_Property (Process_Instance, "arao::port_number") then Port_Number := New_Integer_Value (Unsigned_Long_Long (Get_Integer_Property (Process_Instance, "arao::port_number"))); else Port_Number := V_Zero; Display_No_Port_Number (Process_Instance); end if; return Port_Number; end Get_Process_Port_Number; ---------- -- Dump -- ---------- procedure Dump (Gaia_Tree_Root : Node_Id) is use Output; begin Set_Standard_Output; GN.W_Node (Gaia_Tree_Root); end Dump; --------------------------- -- Missed links routines -- --------------------------- procedure Register_Missed_Link (Set_Procedure : Set_Procedure_Access; Node_1 : Node_Id; Node_2 : Node_Id; Is_Scoped_Name : Boolean; From_Scratch : Boolean); -- If From_Scratch is FALSE, assume that Node_1 is a Gaia node and -- that Node_2 is an AADL node and register one of the following -- calls as being missed: -- 1 - Is_Scoped_Name = True -- GN.Set_ (Node_1, GN.Scoped_Name (ON.Annotation (Node_2))); -- 2 - Is_Scoped_Name = False -- GN.Set_ (Node_1, ON.Annotation (Node_2)); -- If From_Scratch is TRUE, assume that both Node_1 and Node_2 are -- AADL nodes and regiter the following call: -- GN.Set_ (ON.Annotation (Node_1), ON.Annotation (Node_2)); type Missed_Link is record Set_Procedure : Set_Procedure_Access; Node_1 : Node_Id; Node_2 : Node_Id; Is_Scoped_Name : Boolean; From_Scratch : Boolean; end record; -- Data structure that stores a missed link package Missed_Link_Table is new GNAT.Table ( Missed_Link, Natural, 1, 20, 50); -- Table of the missed links -------------------------- -- Register_Missed_Link -- -------------------------- procedure Register_Missed_Link (Set_Procedure : Set_Procedure_Access; Node_1 : Node_Id; Node_2 : Node_Id; Is_Scoped_Name : Boolean; From_Scratch : Boolean) is L : Natural; begin Missed_Link_Table.Increment_Last; L := Missed_Link_Table.Last; Missed_Link_Table.Table (L) := (Set_Procedure, Node_1, Node_2, Is_Scoped_Name, From_Scratch); end Register_Missed_Link; ---------------------- -- Try_Perform_Link -- ---------------------- procedure Try_Perform_Link (Set_Procedure : Set_Procedure_Access; G_Node : Node_Id; A_Node : Node_Id; Is_Scoped_Name : Boolean) is begin if Present (ON.Annotation (A_Node)) then if Is_Scoped_Name then Set_Procedure.all (G_Node, GN.Scoped_Name (ON.Annotation (A_Node))); else Set_Procedure.all (G_Node, ON.Annotation (A_Node)); end if; else Register_Missed_Link (Set_Procedure, G_Node, A_Node, Is_Scoped_Name, False); end if; end Try_Perform_Link; ----------------------------------- -- Try_Perform_Link_From_Scratch -- ----------------------------------- procedure Try_Perform_Link_From_Scratch (Set_Procedure : Set_Procedure_Access; A_Node_1 : Node_Id; A_Node_2 : Node_Id) is begin if Present (ON.Annotation (A_Node_1)) and then Present (ON.Annotation (A_Node_2)) then Set_Procedure.all (ON.Annotation (A_Node_1), ON.Annotation (A_Node_2)); else Register_Missed_Link (Set_Procedure, A_Node_1, A_Node_2, False, True); end if; end Try_Perform_Link_From_Scratch; -------------------------- -- Add_All_Missed_Links -- -------------------------- procedure Add_All_Missed_Links is procedure Add_Missed_Link (ML : Missed_Link); -- Perform one single missed link --------------------- -- Add_Missed_Link -- --------------------- procedure Add_Missed_Link (ML : Missed_Link) is begin if not ML.From_Scratch then if ML.Is_Scoped_Name then ML.Set_Procedure.all (ML.Node_1, GN.Scoped_Name (ON.Annotation (ML.Node_2))); else ML.Set_Procedure.all (ML.Node_1, ON.Annotation (ML.Node_2)); end if; else ML.Set_Procedure.all (ON.Annotation (ML.Node_1), ON.Annotation (ML.Node_2)); end if; end Add_Missed_Link; L : Natural := 1; begin while L <= Missed_Link_Table.Last loop Add_Missed_Link (Missed_Link_Table.Table (L)); L := L + 1; end loop; -- Free the table Missed_Link_Table.Free; end Add_All_Missed_Links; end Gaia.Processor;