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