-------------------------------------------------- ------------------------------ -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . E X P A N D E 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 Namet; with Locations; with Ocarina.Nodes; with Ocarina.Nutils; with Ocarina.Analyzer.Finder; with Ocarina.Entities.Components; with Ocarina.Processor.Properties; with Ocarina.Processor.Instances.Properties; with Ocarina.Expander.Messages; with Ocarina.Expander.Components.Connections; with Ocarina.Expander.Namespaces; package body Ocarina.Expander is use Namet; use Locations; use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.Analyzer; use Ocarina.Analyzer.Finder; use Ocarina.Entities; use Ocarina.Entities.Components; use Ocarina.Processor.Properties; use Ocarina.Processor.Instances.Properties; use Ocarina.Expander.Messages; use Ocarina.Expander.Components; use Ocarina.Expander.Components.Connections; use Ocarina.Expander.Namespaces; function Build_Expansion_Internal_Name (N : Node_Id) return Name_Id; -- Factorize code between (Get/Set)_Expansion ---------------------------------- -- Append_To_Namespace_Instance -- ---------------------------------- procedure Append_To_Namespace_Instance (Instance_Root : Node_Id; Entity_Instance : Node_Id) is pragma Assert (Kind (Instance_Root) = K_Architecture_Instance); pragma Assert (Kind (Entity_Instance) = K_Component_Instance or else Kind (Entity_Instance) = K_Subcomponent_Instance); Namespace_Model : Node_Id; Namespace_Instance : Node_Id; Component_Instance : Node_Id; Subcomponent_Instance : Node_Id; begin -- Set namespaces if Kind (Entity_Instance) = K_Component_Instance then Component_Instance := Entity_Instance; elsif Kind (Entity_Instance) = K_Subcomponent_Instance then Component_Instance := Corresponding_Instance (Entity_Instance); else raise Program_Error; end if; Namespace_Model := Namespace (Corresponding_Declaration (Component_Instance)); Namespace_Instance := Expand_Namespace (Instance_Root, Namespace_Model); -- Append the subcomponents before the component itself since -- the AADL model may be converted into a language that -- requires entities to be declared in order to be used. if not Is_Empty (Subcomponents (Component_Instance)) then Subcomponent_Instance := First_Node (Subcomponents (Component_Instance)); while Present (Subcomponent_Instance) loop Append_To_Namespace_Instance (Instance_Root, Subcomponent_Instance); Subcomponent_Instance := Next_Node (Subcomponent_Instance); end loop; end if; -- Append the component itself if No (Get_First_Contained_Homonym (Declarations (Namespace_Instance), Component_Instance)) then Append_Node_To_List (Make_Node_Container (Component_Instance), Declarations (Namespace_Instance)); end if; end Append_To_Namespace_Instance; -------------------------------- -- Create_Virtual_Connections -- -------------------------------- function Create_Virtual_Connections (Root : Node_Id; Component : Node_Id) return Boolean is pragma Assert (Kind (Root) = K_Architecture_Instance); pragma Assert (Kind (Component) = K_Component_Instance); List_Node : Node_Id; Success : Boolean := True; begin if Get_Category_Of_Component (Component) = CC_Thread and then not Is_Empty (Features (Component)) then List_Node := First_Node (Features (Component)); while Present (List_Node) loop if (Kind (List_Node) = K_Port_Spec_Instance and then Is_Out (List_Node)) or else (Kind (List_Node) = K_Subcomponent_Access_Instance and then Is_Provided (List_Node)) then Success := Compute_Virtual_Connections (Instance_Root => Root, Component_Instance => Parent_Component (Parent_Subcomponent (Component)), Source_Entity => List_Node, Virtual_Cnx => No_Node) and then Success; -- we process all the connections related to the -- considered port among the connections of the parent -- process. end if; List_Node := Next_Node (List_Node); end loop; elsif not Is_Empty (Subcomponents (Component)) then List_Node := First_Node (Subcomponents (Component)); while Present (List_Node) loop Success := Create_Virtual_Connections (Root, Corresponding_Instance (List_Node)) and then Success; List_Node := Next_Node (List_Node); end loop; end if; return True; end Create_Virtual_Connections; ------------------ -- Expand_Model -- ------------------ function Expand_Model (Root : Node_Id; Root_System_Name : Name_Id := No_Name) return Node_Id is pragma Assert (Kind (Root) = K_AADL_Specification); Top_Level_Systems : Entity_List; Instance_Root : Node_Id; Root_System : Node_Id; List_Node : Node_Id; begin -- Find all the top level systems, i.e. AADL system -- implementation that are not connected to any other AADL -- entity. Top_Level_Systems := Find_All_Top_Level_Systems (Root); if Top_Level_Systems.First_Entity /= Top_Level_Systems.Last_Entity then -- If the user provied a particular top level system he -- wants to expand, find this system in the top level system -- list. Otherwise, display an error message indicating that -- there are too much systems eligible for expansion. if Root_System_Name /= No_Name then List_Node := Top_Level_Systems.First_Entity; Root_System := No_Node; while Present (List_Node) and then No (Root_System) loop if Get_Name_Of_Entity (List_Node, False) = Root_System_Name then Root_System := List_Node; end if; List_Node := Next_Entity (List_Node); end loop; else Display_Multiple_Instance_Roots (Top_Level_Systems); Root_System := No_Node; end if; else -- If there is only one top level system, choose it Root_System := Top_Level_Systems.First_Entity; end if; -- If the chosen top level system does not correspond to the -- system name given by the user, complain by displaying an -- error and aborting expansion. if No (Root_System) or else (Root_System_Name /= No_Name and then Get_Name_Of_Entity (Root_System, False) /= Root_System_Name) then Display_No_Instance_Root; Instance_Root := No_Node; else -- The first step of the expansion consist of propagate the -- properties declared in the AADL packages to the AADL -- component they can apply to. Diffuse_Package_Properties_To_Entities (Root); Instance_Root := New_Node (K_Architecture_Instance, No_Location); Set_Namespaces (Instance_Root, New_List (K_List_Id, No_Location)); Set_Virtual_Connections (Instance_Root, New_List (K_List_Id, No_Location)); Set_Unnamed_Namespace (Instance_Root, No_Node); -- Begin the expansion Set_Root_System (Instance_Root, Expand_Component (Instance_Root, Root_System)); Compute_Property_Instance_Values (Instance_Root); end if; return Instance_Root; end Expand_Model; ----------------------- -- Get_First_Homonym -- ----------------------- function Get_First_Homonym (Declaration_List : List_Id; Name_Of_Declaration : Name_Id) return Node_Id is List_Node : Node_Id; begin if Name_Of_Declaration = No_Name or else Declaration_List = No_List then return No_Node; end if; List_Node := First_Node (Declaration_List); while Present (List_Node) loop exit when Get_Name_Of_Entity (List_Node, False) = Name_Of_Declaration; List_Node := Next_Node (List_Node); end loop; return List_Node; end Get_First_Homonym; --------------------------------- -- Get_First_Contained_Homonym -- --------------------------------- function Get_First_Contained_Homonym (Declaration_List : List_Id; Name_Of_Declaration : Name_Id) return Node_Id is List_Node : Node_Id; begin if Name_Of_Declaration = No_Name or else Declaration_List = No_List then return No_Node; end if; List_Node := First_Node (Declaration_List); while Present (List_Node) loop exit when Get_Name_Of_Entity (Item (List_Node), False) = Name_Of_Declaration; List_Node := Next_Node (List_Node); end loop; if No (List_Node) then return List_Node; else return Item (List_Node); end if; end Get_First_Contained_Homonym; ----------------------- -- Get_First_Homonym -- ----------------------- function Get_First_Homonym (Declaration_List : List_Id; Declaration : Node_Id) return Node_Id is pragma Assert (Present (Declaration)); begin return Get_First_Homonym (Declaration_List, Get_Name_Of_Entity (Declaration, False)); end Get_First_Homonym; --------------------------------- -- Get_First_Contained_Homonym -- --------------------------------- function Get_First_Contained_Homonym (Declaration_List : List_Id; Declaration : Node_Id) return Node_Id is pragma Assert (Present (Declaration)); begin return Get_First_Contained_Homonym (Declaration_List, Get_Name_Of_Entity (Declaration, False)); end Get_First_Contained_Homonym; ----------------------------------- -- Build_Expansion_Internal_Name -- ----------------------------------- function Build_Expansion_Internal_Name (N : Node_Id) return Name_Id is begin Set_Str_To_Name_Buffer ("%Expansion%"); Add_Nat_To_Name_Buffer (Nat (N)); return Name_Find; end Build_Expansion_Internal_Name; ------------------- -- Get_Expansion -- ------------------- function Get_Expansion (N : Node_Id) return Node_Id is I_Name : constant Name_Id := Build_Expansion_Internal_Name (N); begin return Node_Id (Get_Name_Table_Info (I_Name)); end Get_Expansion; ------------------- -- Set_Expansion -- ------------------- procedure Set_Expansion (N : Node_Id; E : Node_Id) is I_Name : constant Name_Id := Build_Expansion_Internal_Name (N); begin Set_Name_Table_Info (I_Name, Int (E)); end Set_Expansion; end Ocarina.Expander;