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