----------------------------------------------- --------------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . E X P A N D E R . C O M P O N E N T S . M O D E S -- -- -- -- B o d y -- -- -- -- Copyright (C) 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 Ocarina.Nodes; with Ocarina.Nutils; with Ocarina.Entities; package body Ocarina.Expander.Components.Modes is use Ocarina.Nodes; use Ocarina.Nutils; use Ocarina.Entities; package ON renames Ocarina.Nodes; function Fetch_Port_Reference_Instance (Ref : Node_Id; C : Node_Id) return Node_Id; -- Return an reference to the instance corresponding to the port -- declaration referenced by Ref. C is the AADL component in which -- the search begins. Research can be continued inside the -- subcomponent of C incase Ref references a subcomponent port -- (C.Th_1.Out_Port for example). ----------------------------------- -- Fetch_Port_Reference_Instance -- ----------------------------------- function Fetch_Port_Reference_Instance (Ref : Node_Id; C : Node_Id) return Node_Id is Ref_Inst : Node_Id; procedure Recursive_Path_Search (Path_Element : Node_Id; Component : Node_Id); -- Recusively update Ref_Inst, starting from Path_Element and -- continuing to its next element and to C component -- containment hierarchy. --------------------------- -- Recursive_Path_Search -- --------------------------- procedure Recursive_Path_Search (Path_Element : Node_Id; Component : Node_Id) is N : Node_Id; begin if No (Path_Element) then -- This cannot happen if the semantic analyzer did its -- work well. raise Program_Error with "FATAL: A feature path that does not end with a feature"; end if; pragma Assert (Kind (Component) = K_Component_Instance and then Kind (Path_Element) = K_Node_Container and then Kind (Item (Path_Element)) = K_Identifier); case Kind (Corresponding_Entity (Item (Path_Element))) is when K_Port_Spec | K_Subcomponent_Access | K_Port_Group_Spec | K_Parameter | K_Subprogram_Spec => -- This is a local feature, we search it within the -- features of the current component, add it to the -- new path and stop the search. N := Get_First_Homonym (Features (Component), Name (Item (Path_Element))); Add_Path_Element_To_Entity_Reference (Ref_Inst, N); when K_Subcomponent => -- This is a feature belonging to a subcomponent, we -- fetch the subcomponent instance, add it to the new -- path and then we continue the search with the -- component instance corresponding to the -- subcomponent instance. N := Get_First_Homonym (Subcomponents (Component), Name (Item (Path_Element))); Add_Path_Element_To_Entity_Reference (Ref_Inst, N); Recursive_Path_Search (Next_Node (Path_Element), Corresponding_Instance (N)); when K_Subprogram_Call => -- This is a subprogram call port, we act like for -- subomponents. declare Call_Seq : Node_Id := First_Node (Calls (Component)); begin while Present (Call_Seq) loop N := Get_First_Homonym (Subprogram_Calls (Call_Seq), Name (Item (Path_Element))); if Present (N) then Add_Path_Element_To_Entity_Reference (Ref_Inst, N); Recursive_Path_Search (Next_Node (Path_Element), Corresponding_Instance (N)); exit; end if; Call_Seq := Next_Node (Call_Seq); end loop; end; when others => raise Program_Error; end case; end Recursive_Path_Search; Path_Element : Node_Id; begin Ref_Inst := New_Node (K_Entity_Reference_Instance, Loc (Ref)); Set_Path (Ref_Inst, New_List (K_List_Id, Loc (Ref))); Path_Element := First_Node (Path (Ref)); Recursive_Path_Search (Path_Element, C); return Ref_Inst; end Fetch_Port_Reference_Instance; ----------------- -- Expand_Mode -- ----------------- function Expand_Mode (Instance_Root : Node_Id; Component_Instance : Node_Id; Mode : Node_Id) return Node_Id is New_Instance : Node_Id; begin pragma Assert (Kind (Instance_Root) = K_Architecture_Instance and then Kind (Component_Instance) = K_Component_Instance and then Kind (Mode) = K_Mode); New_Instance := New_Node (K_Mode_Instance, Loc (Mode)); Set_Corresponding_Declaration (New_Instance, Mode); Set_Identifier (New_Instance, Duplicate_Identifier (Identifier (Mode))); Set_Parent_Component (New_Instance, Component_Instance); Set_Is_Initial (New_Instance, Is_Initial (Mode)); return New_Instance; end Expand_Mode; ---------------------------- -- Expand_Mode_Transition -- ---------------------------- function Expand_Mode_Transition (Instance_Root : Node_Id; Component_Instance : Node_Id; Mode_Transition : Node_Id) return Node_Id is New_Instance : Node_Id; N : Node_Id; M : Node_Id; begin pragma Assert (Kind (Instance_Root) = K_Architecture_Instance and then Kind (Component_Instance) = K_Component_Instance and then Kind (Mode_Transition) = K_Mode_Transition); New_Instance := New_Node (K_Mode_Transition_Instance, Loc (Mode_Transition)); Set_Corresponding_Declaration (New_Instance, Mode_Transition); Set_Parent_Component (New_Instance, Component_Instance); Set_Source_Modes (New_Instance, New_List (K_List_Id, Loc (Mode_Transition))); Set_Unique_Ports (New_Instance, New_List (K_List_Id, Loc (Mode_Transition))); -- Fetch the mode instances that corresponds to the transition -- source. N := First_Node (Source_Modes (Mode_Transition)); while Present (N) loop M := Get_First_Homonym (ON.Modes (Component_Instance), Name (N)); if No (M) then return No_Node; end if; pragma Assert (Kind (M) = K_Mode_Instance); Append_Node_To_List (Make_Node_Container (M), Source_Modes (New_Instance)); N := Next_Node (N); end loop; -- Fetch the destination mode of the transition M := Get_First_Homonym (ON.Modes (Component_Instance), Name (Destination_Mode (Mode_Transition))); if No (M) then return No_Node; end if; pragma Assert (Kind (M) = K_Mode_Instance); Set_Destination_Mode (New_Instance, Make_Node_Container (M)); -- Set the instances of the ports that trigger the transition N := First_Node (Unique_Ports (Mode_Transition)); while Present (N) loop M := Fetch_Port_Reference_Instance (N, Component_Instance); if No (M) then return No_Node; end if; pragma Assert (Kind (M) = K_Entity_Reference_Instance); Append_Node_To_List (M, Unique_Ports (New_Instance)); N := Next_Node (N); end loop; return New_Instance; end Expand_Mode_Transition; --------------------- -- Expand_In_Modes -- --------------------- procedure Expand_In_Modes (Component_Instance : Node_Id; Subclause_Instance : Node_Id) is Subclause_In_Modes : Node_Id; MoT : Node_Id; -- Mode or Transition begin pragma Assert (Kind (Component_Instance) = K_Component_Instance and then (Kind (Subclause_Instance) = K_Subcomponent_Instance or else Kind (Subclause_Instance) = K_Call_Sequence_Instance or else Kind (Subclause_Instance) = K_Connection_Instance or else Kind (Subclause_Instance) = K_Property_Association)); if Kind (Subclause_Instance) = K_Property_Association then Subclause_In_Modes := In_Modes (Subclause_Instance); else Subclause_In_Modes := In_Modes (Corresponding_Declaration (Subclause_Instance)); end if; if Present (Subclause_In_Modes) and then not Is_Empty (ON.Modes (Subclause_In_Modes)) then -- Create the subclause mode container Set_In_Modes (Subclause_Instance, New_Node (K_In_Modes, Loc (Subclause_In_Modes))); Set_Modes (In_Modes (Subclause_Instance), New_List (K_List_Id, Loc (Subclause_In_Modes))); MoT := First_Node (ON.Modes (Subclause_In_Modes)); declare Mode_List : List_Id renames ON.Modes (In_Modes (Subclause_Instance)); begin while Present (MoT) loop case Kind (MoT) is when K_Entity_Reference => -- Fetch the mode instance and append it to the -- mode instance list. Append_Node_To_List (Make_Node_Container (Get_First_Homonym (ON.Modes (Component_Instance), Name (Identifier (MoT)))), Mode_List); when K_Pair_Of_Entity_References => -- Fetch the mode transition ends and append -- them as a two-item node sontainer to the mode -- instance list. Append_Node_To_List (Make_Node_Container (Get_First_Homonym (ON.Modes (Component_Instance), Name (Identifier (First_Reference (MoT)))), Get_First_Homonym (ON.Modes (Component_Instance), Name (Identifier (Second_Reference (MoT))))), Mode_List); when others => -- This cannot happen unless the parser went crazy raise Program_Error with "A non-mode-non-transition in an in_mode list"; end case; MoT := Next_Node (MoT); end loop; end; end if; end Expand_In_Modes; --------------------- -- Expand_In_Modes -- --------------------- procedure Expand_In_Modes (Component_Instance : Node_Id; Subclause_List : List_Id) is Subclause_Node : Node_Id; begin pragma Assert (Kind (Component_Instance) = K_Component_Instance); if not Is_Empty (Subclause_List) then Subclause_Node := First_Node (Subclause_List); while Present (Subclause_Node) loop Expand_In_Modes (Component_Instance, Subclause_Node); Subclause_Node := Next_Node (Subclause_Node); end loop; end if; end Expand_In_Modes; end Ocarina.Expander.Components.Modes;