-------------------------------------- ------------------------------------------ -- -- -- OCARINA COMPONENTS -- -- -- -- OCARINA.GENERATORS.PO_HI_ADA.SUBPROGRAMS -- -- -- -- B o d y -- -- -- -- Copyright (C) 2006-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.Components; with Ocarina.Generators.Utils; with Ocarina.Generators.Properties; with Ocarina.Generators.Ada_Tree.Nutils; with Ocarina.Generators.Ada_Tree.Nodes; with Ocarina.Generators.Ada_Values; with Ocarina.Generators.PO_HI_Ada.Mapping; with Ocarina.Generators.PO_HI_Ada.Runtime; package body Ocarina.Generators.PO_HI_Ada.Subprograms is use Ocarina.Nodes; use Ocarina.Entities.Components; use Ocarina.Generators.Utils; use Ocarina.Generators.Properties; use Ocarina.Generators.Ada_Tree.Nutils; use Ocarina.Generators.Ada_Values; use Ocarina.Generators.PO_HI_Ada.Mapping; use Ocarina.Generators.PO_HI_Ada.Runtime; package AAN renames Ocarina.Nodes; package AAU renames Ocarina.Nutils; package ADN renames Ocarina.Generators.Ada_Tree.Nodes; ------------------ -- Package_Spec -- ------------------ package body Package_Spec is procedure Visit_Architecture_Instance (E : node_id); procedure Visit_Component_Instance (E : node_id); procedure Visit_System_Instance (E : node_id); procedure Visit_Process_Instance (E : node_id); procedure Visit_Thread_Instance (E : node_id); procedure Visit_Subprogram_Instance (E : node_id); procedure Visit_Data_Instance (E : node_id); function Put_Value_Spec (E : node_id) return node_id; function Get_Value_Spec (E : node_id) return node_id; function Next_Value_Spec (E : node_id) return node_id; function Get_Count_Spec (E : node_id) return node_id; -- Routines to raise and collect subprogram events in a thread -- safe manner. -------------------- -- Put_Value_Spec -- -------------------- function Put_Value_Spec (E : node_id) return node_id is Profile : constant list_id := New_List (ADN.k_parameter_profile); N : node_id; begin N := Make_Parameter_Specification (Defining_Identifier => Make_Defining_Identifier (PN (p_status)), Subtype_Mark => Make_Defining_Identifier (Map_Port_Status_Name (E)), Parameter_Mode => mode_inout); Append_Node_To_List (N, Profile); N := Make_Parameter_Specification (Defining_Identifier => Make_Defining_Identifier (PN (p_spg_interface)), Subtype_Mark => Make_Defining_Identifier (Map_Port_Interface_Name (E)), Parameter_Mode => mode_in); Append_Node_To_List (N, Profile); N := Make_Subprogram_Specification (Defining_Identifier => Make_Defining_Identifier (SN (s_put_value)), Parameter_Profile => Profile, Return_Type => No_Node); return N; end Put_Value_Spec; -------------------- -- Get_Value_Spec -- -------------------- function Get_Value_Spec (E : node_id) return node_id is Profile : constant list_id := New_List (ADN.k_parameter_profile); N : node_id; begin N := Make_Parameter_Specification (Defining_Identifier => Make_Defining_Identifier (PN (p_status)), Subtype_Mark => Make_Defining_Identifier (Map_Port_Status_Name (E)), Parameter_Mode => mode_in); Append_Node_To_List (N, Profile); N := Make_Parameter_Specification (Defining_Identifier => Make_Defining_Identifier (PN (p_port)), Subtype_Mark => Make_Defining_Identifier (Map_Port_Enumeration_Name (E)), Parameter_Mode => mode_in); Append_Node_To_List (N, Profile); N := Make_Subprogram_Specification (Defining_Identifier => Make_Defining_Identifier (SN (s_get_value)), Parameter_Profile => Profile, Return_Type => Make_Defining_Identifier (Map_Port_Interface_Name (E))); return N; end Get_Value_Spec; --------------------- -- Next_Value_Spec -- --------------------- function Next_Value_Spec (E : node_id) return node_id is Profile : constant list_id := New_List (ADN.k_parameter_profile); N : node_id; begin N := Make_Parameter_Specification (Defining_Identifier => Make_Defining_Identifier (PN (p_status)), Subtype_Mark => Make_Defining_Identifier (Map_Port_Status_Name (E)), Parameter_Mode => mode_inout); Append_Node_To_List (N, Profile); N := Make_Parameter_Specification (Defining_Identifier => Make_Defining_Identifier (PN (p_port)), Subtype_Mark => Make_Defining_Identifier (Map_Port_Enumeration_Name (E)), Parameter_Mode => mode_in); Append_Node_To_List (N, Profile); N := Make_Subprogram_Specification (Defining_Identifier => Make_Defining_Identifier (SN (s_next_value)), Parameter_Profile => Profile, Return_Type => No_Node); return N; end Next_Value_Spec; -------------------- -- Get_Count_Spec -- -------------------- function Get_Count_Spec (E : node_id) return node_id is Profile : constant list_id := New_List (ADN.k_parameter_profile); N : node_id; begin N := Make_Parameter_Specification (Defining_Identifier => Make_Defining_Identifier (PN (p_status)), Subtype_Mark => Make_Defining_Identifier (Map_Port_Status_Name (E)), Parameter_Mode => mode_in); Append_Node_To_List (N, Profile); N := Make_Parameter_Specification (Defining_Identifier => Make_Defining_Identifier (PN (p_port)), Subtype_Mark => Make_Defining_Identifier (Map_Port_Enumeration_Name (E)), Parameter_Mode => mode_in); Append_Node_To_List (N, Profile); N := Make_Subprogram_Specification (Defining_Identifier => Make_Defining_Identifier (SN (s_get_count)), Parameter_Profile => Profile, Return_Type => RE (re_integer)); return N; end Get_Count_Spec; ----------- -- Visit -- ----------- procedure Visit (E : node_id) is begin case Kind (E) is when k_architecture_instance => Visit_Architecture_Instance (E); when k_component_instance => Visit_Component_Instance (E); when others => null; end case; end Visit; --------------------------------- -- Visit_Architecture_Instance -- --------------------------------- procedure Visit_Architecture_Instance (E : node_id) is begin Visit (Root_System (E)); end Visit_Architecture_Instance; ------------------------------ -- Visit_Component_Instance -- ------------------------------ procedure Visit_Component_Instance (E : node_id) is Cathegory : constant component_category := Get_Category_Of_Component (E); begin case Cathegory is when cc_system => Visit_System_Instance (E); when cc_process => Visit_Process_Instance (E); when cc_thread => Visit_Thread_Instance (E); when cc_subprogram => Visit_Subprogram_Instance (E); when cc_data => Visit_Data_Instance (E); when others => null; end case; end Visit_Component_Instance; ------------------------- -- Visit_Data_Instance -- ------------------------- procedure Visit_Data_Instance (E : node_id) is Data_Type : constant supported_data_type := Get_Data_Type (E); S : node_id; begin if Data_Type = data_with_accessors then -- Visit all the accessor subprograms of the data type S := First_Node (Features (E)); while Present (S) loop Visit (Corresponding_Instance (S)); S := Next_Node (S); end loop; end if; end Visit_Data_Instance; ---------------------------- -- Visit_Process_Instance -- ---------------------------- procedure Visit_Process_Instance (E : node_id) is U : constant node_id := ADN.Distributed_Application_Unit (ADN.Naming_Node (Backend_Node (Identifier (E)))); P : constant node_id := ADN.Entity (U); S : node_id; begin Push_Entity (P); Push_Entity (U); Set_Subprograms_Spec; -- Start recording all the handlings Start_Recording_Handlings; -- Visit all the subcomponents of the process if not AAU.Is_Empty (Subcomponents (E)) then S := First_Node (Subcomponents (E)); while Present (S) loop -- Visit the component instance corresponding to the -- subcomponent S. Visit (Corresponding_Instance (S)); S := Next_Node (S); end loop; end if; -- Unmark all the marked subprograms Reset_Handlings; Pop_Entity; -- U Pop_Entity; -- P end Visit_Process_Instance; ------------------------------- -- Visit_Subprogram_Instance -- ------------------------------- procedure Visit_Subprogram_Instance (E : node_id) is N : node_id; Call_Seq : node_id; Spg_Call : node_id; begin -- Generate the spec of the subprogram if No (Get_Handling (E, by_name, h_ada_subprogram_spec)) then -- Mark the subprogram as being handled Set_Handling (E, by_name, h_ada_subprogram_spec, E); if Has_Out_Ports (E) then -- If the subprogram contains out event [data] ports, -- declare the following entities. -- An enumeration type for the SPG out ports N := Map_Port_Enumeration (E); Bind_AADL_To_Port_Enumeration (Identifier (E), N); Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); -- A Subprogram_Interface discriminated record N := Map_Port_Interface (E); Bind_AADL_To_Port_Interface (Identifier (E), N); Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); -- The same AADL subprogram, may be invoked by -- different threads. The user implementation DOES NOT -- HAVE TO know which thread is actually running the -- subprogram. In partivular, if a subprogram, raises -- events on one of its out ports, the venet must be -- dispatched to the thread running the subprogra in a -- way which is transparent to the user. A simple way -- to perform this is the use of an opaque IN OUT -- parameter which is given to the subprogram. This -- implies that the thread is aware of the subprogram -- event raise AFTER the complete run of the -- subprogram. -- A private type called _Port_Status. N := Map_Port_Status (E, Full_Declaration => False); Bind_AADL_To_Type_Definition (Identifier (E), N); Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); N := Map_Port_Status (E, Full_Declaration => True); Append_Node_To_List (N, ADN.Private_Part (Current_Package)); -- Spec of the Put_Value subprogram, generally used by -- the user code to raise an event [data]. N := Put_Value_Spec (E); Bind_AADL_To_Put_Value (Identifier (E), N); Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); -- Spec of the Get_Value subprogram, generally used by -- the thread code to get the raised events. N := Get_Value_Spec (E); Bind_AADL_To_Get_Value (Identifier (E), N); Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); -- Spec of the Next_Value subprogram, generally used by -- the thread code to get the raised events. N := Next_Value_Spec (E); Bind_AADL_To_Next_Value (Identifier (E), N); Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); -- Spec of the Get_Count subprogram, generally used -- by the thread code to get the raised events. N := Get_Count_Spec (E); Bind_AADL_To_Get_Count (Identifier (E), N); Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); end if; N := Map_Ada_Subprogram_Spec (E); Bind_AADL_To_Subprogram (Identifier (E), N); Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); else declare H : constant node_id := Get_Handling (E, by_name, h_ada_subprogram_spec); begin Bind_AADL_To_Subprogram (Identifier (E), ADN.Subprogram_Node (Backend_Node (Identifier (H)))); if Has_Out_Ports (E) then Bind_AADL_To_Port_Enumeration (Identifier (E), ADN.Port_Enumeration_Node (Backend_Node (Identifier (H)))); Bind_AADL_To_Port_Interface (Identifier (E), ADN.Port_Interface_Node (Backend_Node (Identifier (H)))); Bind_AADL_To_Type_Definition (Identifier (E), ADN.Type_Definition_Node (Backend_Node (Identifier (H)))); Bind_AADL_To_Put_Value (Identifier (E), ADN.Put_Value_Node (Backend_Node (Identifier (H)))); Bind_AADL_To_Get_Value (Identifier (E), ADN.Get_Value_Node (Backend_Node (Identifier (H)))); end if; end; end if; -- Visit all the call sequences of the subprogram if not AAU.Is_Empty (Calls (E)) then Call_Seq := First_Node (Calls (E)); while Present (Call_Seq) loop -- For each call sequence visit all the called -- subprograms. if not AAU.Is_Empty (Subprogram_Calls (Call_Seq)) then Spg_Call := First_Node (Subprogram_Calls (Call_Seq)); while Present (Spg_Call) loop Visit (Corresponding_Instance (Spg_Call)); Spg_Call := Next_Node (Spg_Call); end loop; end if; Call_Seq := Next_Node (Call_Seq); end loop; end if; end Visit_Subprogram_Instance; --------------------------- -- Visit_System_Instance -- --------------------------- procedure Visit_System_Instance (E : node_id) is S : node_id; begin Push_Entity (HI_Distributed_Application_Root); -- Visit all the subcomponents of the system if not AAU.Is_Empty (Subcomponents (E)) then S := First_Node (Subcomponents (E)); while Present (S) loop -- Visit the component instance corresponding to the -- subcomponent S. Visit (Corresponding_Instance (S)); S := Next_Node (S); end loop; end if; Pop_Entity; -- HI_Distributed_Application_Root end Visit_System_Instance; --------------------------- -- Visit_Thread_Instance -- --------------------------- procedure Visit_Thread_Instance (E : node_id) is Call_Seq : node_id; Spg_Call : node_id; begin -- Visit all the call sequences of the thread if not AAU.Is_Empty (Calls (E)) then Call_Seq := First_Node (Calls (E)); while Present (Call_Seq) loop -- For each call sequence visit all the called -- subprograms. if not AAU.Is_Empty (Subprogram_Calls (Call_Seq)) then Spg_Call := First_Node (Subprogram_Calls (Call_Seq)); while Present (Spg_Call) loop Visit (Corresponding_Instance (Spg_Call)); Spg_Call := Next_Node (Spg_Call); end loop; end if; Call_Seq := Next_Node (Call_Seq); end loop; end if; end Visit_Thread_Instance; end Package_Spec; ------------------ -- Package_Body -- ------------------ package body Package_Body is procedure Visit_Architecture_Instance (E : node_id); procedure Visit_Component_Instance (E : node_id); procedure Visit_System_Instance (E : node_id); procedure Visit_Process_Instance (E : node_id); procedure Visit_Thread_Instance (E : node_id); procedure Visit_Subprogram_Instance (E : node_id); procedure Visit_Data_Instance (E : node_id); function Put_Value_Body (E : node_id) return node_id; function Get_Value_Body (E : node_id) return node_id; function Next_Value_Body (E : node_id) return node_id; function Get_Count_Body (E : node_id) return node_id; -- Routines to raise and collect subprogram events in a thread -- safe manner. -------------------- -- Put_Value_Body -- -------------------- function Put_Value_Body (E : node_id) return node_id is Spec : constant node_id := ADN.Put_Value_Node (Backend_Node (Identifier (E))); Statements : constant list_id := New_List (ADN.k_statement_list); Alternatives : constant list_id := New_List (ADN.k_list_id); F : node_id; N : node_id; begin F := First_Node (Features (E)); while Present (F) loop if Kind (F) = k_port_spec_instance then declare St : constant list_id := New_List (ADN.k_statement_list); begin -- Set the boolean flag corresponding to the -- component to 'True'. N := Make_Assignment_Statement (Make_Selected_Component (Make_Defining_Identifier (PN (p_status)), Map_Ada_Defining_Identifier (F)), RE (re_true)); Append_Node_To_List (N, St); if AAN.Is_Data (F) then -- Update the component correspodning to the out -- port in the status structure N := Make_Assignment_Statement (Make_Selected_Component (Make_Defining_Identifier (PN (p_status)), Make_Defining_Identifier (Map_Ada_Component_Name (F))), Make_Selected_Component (Make_Defining_Identifier (PN (p_spg_interface)), Make_Defining_Identifier (Map_Ada_Component_Name (F)))); Append_Node_To_List (N, St); end if; -- Create the case alternative N := Make_Case_Statement_Alternative (Make_List_Id (Map_Ada_Defining_Identifier (F)), St); Append_Node_To_List (N, Alternatives); end; end if; F := Next_Node (F); end loop; N := Make_Case_Statement (Make_Selected_Component (Make_Defining_Identifier (PN (p_spg_interface)), Make_Defining_Identifier (CN (c_port))), Alternatives); Append_Node_To_List (N, Statements); N := Make_Subprogram_Implementation (Spec, No_List, Statements); return N; end Put_Value_Body; -------------------- -- Get_Value_Body -- -------------------- function Get_Value_Body (E : node_id) return node_id is Spec : constant node_id := ADN.Get_Value_Node (Backend_Node (Identifier (E))); Statements : constant list_id := New_List (ADN.k_statement_list); Alternatives : constant list_id := New_List (ADN.k_list_id); F : node_id; N : node_id; begin F := First_Node (Features (E)); while Present (F) loop if Kind (F) = k_port_spec_instance then declare Aggr : constant list_id := New_List (ADN.k_list_id); begin N := Make_Component_Association (Make_Defining_Identifier (CN (c_port)), Map_Ada_Defining_Identifier (F)); Append_Node_To_List (N, Aggr); if AAN.Is_Data (F) then -- Update the component correspodning to the out -- port in the status structure. N := Make_Component_Association (Make_Defining_Identifier (Map_Ada_Component_Name (F)), Make_Selected_Component (Make_Defining_Identifier (PN (p_status)), Make_Defining_Identifier (Map_Ada_Component_Name (F)))); Append_Node_To_List (N, Aggr); end if; N := Make_Return_Statement (Make_Record_Aggregate (Aggr)); -- Create the case alternative N := Make_Case_Statement_Alternative (Make_List_Id (Map_Ada_Defining_Identifier (F)), Make_List_Id (N)); Append_Node_To_List (N, Alternatives); end; end if; F := Next_Node (F); end loop; N := Make_Case_Statement (Make_Defining_Identifier (PN (p_port)), Alternatives); Append_Node_To_List (N, Statements); N := Make_Subprogram_Implementation (Spec, No_List, Statements); return N; end Get_Value_Body; --------------------- -- Next_Value_Body -- --------------------- function Next_Value_Body (E : node_id) return node_id is Spec : constant node_id := ADN.Next_Value_Node (Backend_Node (Identifier (E))); Statements : constant list_id := New_List (ADN.k_statement_list); Declarations : constant list_id := New_List (ADN.k_declaration_list); N : node_id; begin -- FIXME: Not implemented yet for now N := Make_Pragma_Statement (pragma_unreferenced, Make_List_Id (Make_Defining_Identifier (PN (p_status)), Make_Defining_Identifier (PN (p_port)))); Append_Node_To_List (N, Declarations); N := Message_Comment ("Not implemented yet!"); Append_Node_To_List (N, Statements); N := Make_Raise_Statement (Make_Defining_Identifier (EN (e_program_error))); Append_Node_To_List (N, Statements); N := Make_Subprogram_Implementation (Spec, Declarations, Statements); return N; end Next_Value_Body; -------------------- -- Get_Count_Body -- -------------------- function Get_Count_Body (E : node_id) return node_id is Spec : constant node_id := ADN.Get_Count_Node (Backend_Node (Identifier (E))); Statements : constant list_id := New_List (ADN.k_statement_list); Alternatives : constant list_id := New_List (ADN.k_list_id); F : node_id; N : node_id; begin -- FIXME: For now, the returned value is either 0 or 1, we -- must take into account the port fifo size. F := First_Node (Features (E)); while Present (F) loop if Kind (F) = k_port_spec_instance then declare St : constant list_id := New_List (ADN.k_statement_list); begin -- If the boolean flag corresponding to the -- component is 'True' then return 1, else return 0 N := Make_If_Statement (Condition => Make_Selected_Component (Make_Defining_Identifier (PN (p_status)), Map_Ada_Defining_Identifier (F)), Then_Statements => Make_List_Id (Make_Return_Statement (Make_Literal (New_Integer_Value (1, 1, 10)))), Else_Statements => Make_List_Id (Make_Return_Statement (Make_Literal (New_Integer_Value (0, 1, 10))))); Append_Node_To_List (N, St); -- Create the case alternative N := Make_Case_Statement_Alternative (Make_List_Id (Map_Ada_Defining_Identifier (F)), St); Append_Node_To_List (N, Alternatives); end; end if; F := Next_Node (F); end loop; N := Make_Case_Statement (Make_Defining_Identifier (PN (p_port)), Alternatives); Append_Node_To_List (N, Statements); N := Make_Subprogram_Implementation (Spec, No_List, Statements); return N; end Get_Count_Body; ----------- -- Visit -- ----------- procedure Visit (E : node_id) is begin case Kind (E) is when k_architecture_instance => Visit_Architecture_Instance (E); when k_component_instance => Visit_Component_Instance (E); when others => null; end case; end Visit; --------------------------------- -- Visit_Architecture_Instance -- --------------------------------- procedure Visit_Architecture_Instance (E : node_id) is begin Visit (Root_System (E)); end Visit_Architecture_Instance; ------------------------------ -- Visit_Component_Instance -- ------------------------------ procedure Visit_Component_Instance (E : node_id) is Cathegory : constant component_category := Get_Category_Of_Component (E); begin case Cathegory is when cc_system => Visit_System_Instance (E); when cc_process => Visit_Process_Instance (E); when cc_thread => Visit_Thread_Instance (E); when cc_subprogram => Visit_Subprogram_Instance (E); when cc_data => Visit_Data_Instance (E); when others => null; end case; end Visit_Component_Instance; ------------------------- -- Visit_Data_Instance -- ------------------------- procedure Visit_Data_Instance (E : node_id) is Data_Type : constant supported_data_type := Get_Data_Type (E); S : node_id; begin if Data_Type = data_with_accessors then -- Visit all the accessor subprograms of the data type S := First_Node (Features (E)); while Present (S) loop Visit (Corresponding_Instance (S)); S := Next_Node (S); end loop; end if; end Visit_Data_Instance; ---------------------------- -- Visit_Process_Instance -- ---------------------------- procedure Visit_Process_Instance (E : node_id) is U : constant node_id := ADN.Distributed_Application_Unit (ADN.Naming_Node (Backend_Node (Identifier (E)))); P : constant node_id := ADN.Entity (U); S : node_id; begin Push_Entity (P); Push_Entity (U); Set_Subprograms_Body; -- Start recording all the handlings Start_Recording_Handlings; -- Visit all the subcomponents of the process if not AAU.Is_Empty (Subcomponents (E)) then S := First_Node (Subcomponents (E)); while Present (S) loop -- Visit the component instance corresponding to the -- subcomponent S. Visit (Corresponding_Instance (S)); S := Next_Node (S); end loop; end if; -- Unmark all the marked subprograms Reset_Handlings; Pop_Entity; -- U Pop_Entity; -- P end Visit_Process_Instance; ------------------------------- -- Visit_Subprogram_Instance -- ------------------------------- procedure Visit_Subprogram_Instance (E : node_id) is N : node_id; Call_Seq : node_id; Spg_Call : node_id; begin -- Generate the body of the subprogram if No (Get_Handling (E, by_name, h_ada_subprogram_body)) then N := Map_Ada_Subprogram_Body (E); Append_Node_To_List (N, ADN.Statements (Current_Package)); if Has_Out_Ports (E) then -- If the subprogram contains out event [data] ports, -- declare the following entities. N := Put_Value_Body (E); Append_Node_To_List (N, ADN.Statements (Current_Package)); N := Get_Value_Body (E); Append_Node_To_List (N, ADN.Statements (Current_Package)); N := Next_Value_Body (E); Append_Node_To_List (N, ADN.Statements (Current_Package)); N := Get_Count_Body (E); Append_Node_To_List (N, ADN.Statements (Current_Package)); end if; -- Mark the data type as being handled Set_Handling (E, by_name, h_ada_subprogram_body, N); end if; -- Visit all the call sequences of the subprogram if not AAU.Is_Empty (Calls (E)) then Call_Seq := First_Node (Calls (E)); while Present (Call_Seq) loop -- For each call sequence visit all the called -- subprograms. if not AAU.Is_Empty (Subprogram_Calls (Call_Seq)) then Spg_Call := First_Node (Subprogram_Calls (Call_Seq)); while Present (Spg_Call) loop Visit (Corresponding_Instance (Spg_Call)); Spg_Call := Next_Node (Spg_Call); end loop; end if; Call_Seq := Next_Node (Call_Seq); end loop; end if; end Visit_Subprogram_Instance; --------------------------- -- Visit_System_Instance -- --------------------------- procedure Visit_System_Instance (E : node_id) is S : node_id; begin Push_Entity (HI_Distributed_Application_Root); -- Visit all the subcomponents of the system if not AAU.Is_Empty (Subcomponents (E)) then S := First_Node (Subcomponents (E)); while Present (S) loop -- Visit the component instance corresponding to the -- subcomponent S. Visit (Corresponding_Instance (S)); S := Next_Node (S); end loop; end if; Pop_Entity; -- HI_Distributed_Application_Root end Visit_System_Instance; --------------------------- -- Visit_Thread_Instance -- --------------------------- procedure Visit_Thread_Instance (E : node_id) is Call_Seq : node_id; Spg_Call : node_id; begin -- Visit all the call sequences of the thread if not AAU.Is_Empty (Calls (E)) then Call_Seq := First_Node (Calls (E)); while Present (Call_Seq) loop -- For each call sequence visit all the called -- subprograms. if not AAU.Is_Empty (Subprogram_Calls (Call_Seq)) then Spg_Call := First_Node (Subprogram_Calls (Call_Seq)); while Present (Spg_Call) loop Visit (Corresponding_Instance (Spg_Call)); Spg_Call := Next_Node (Spg_Call); end loop; end if; Call_Seq := Next_Node (Call_Seq); end loop; end if; end Visit_Thread_Instance; end Package_Body; end Ocarina.Generators.PO_HI_Ada.Subprograms;