---------------------------------- ---------------------------------------------- -- -- -- OCARINA COMPONENTS -- -- -- -- O C A R I N A . G E N E R A T O R S . P O _ H I _ A D A . T Y P E S -- -- -- -- 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.Messages; 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.Types is use Ocarina.Nodes; use Ocarina.Entities.Components; use Ocarina.Generators.Utils; use Ocarina.Generators.Properties; use Ocarina.Generators.Messages; 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 Feature_Spg_Spec (E : node_id) return node_id; -- Builds a spec for a protected object procedure from an AADL -- subprogram spec E. ---------------------- -- Feature_Spg_Spec -- ---------------------- function Feature_Spg_Spec (E : node_id) return node_id is Profile : constant list_id := New_List (ADN.k_parameter_profile); N : node_id; Mode : mode_id; P : node_id; Spg : node_id; begin pragma assert (Kind (E) = k_subprogram_spec_instance); Spg := Corresponding_Instance (E); pragma assert (Is_Subprogram (Spg)); if not AAU.Is_Empty (Features (Spg)) then P := First_Node (Features (Spg)); while Present (P) loop if Kind (P) = k_parameter_instance then -- Create a parameter specification if Is_In (P) and then Is_Out (P) then Mode := mode_inout; elsif Is_Out (P) then Mode := mode_out; else Mode := mode_in; end if; N := Make_Parameter_Specification (Defining_Identifier => Map_Ada_Defining_Identifier (P), Subtype_Mark => Map_Ada_Data_Type_Designator (Corresponding_Instance (P)), Parameter_Mode => Mode); Append_Node_To_List (N, Profile); end if; P := Next_Node (P); end loop; end if; N := Make_Subprogram_Specification (Defining_Identifier => Map_Ada_Defining_Identifier (E), Parameter_Profile => Profile); return N; end Feature_Spg_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_data => Visit_Data_Instance (E); when cc_subprogram => Visit_Subprogram_Instance (E); when others => null; end case; end Visit_Component_Instance; ------------------------- -- Visit_Data_Instance -- ------------------------- procedure Visit_Data_Instance (E : node_id) is Data_Type : supported_data_type; Language_Type : supported_source_language; N : node_id; S : node_id; begin -- Do not generate Ada type more than once if No (Get_Handling (E, by_name, h_ada_type_spec)) then -- The code generation for the following types is not yet -- supported: bounded strings. Language_Type := Get_Source_Language (E); if Language_Type = language_asn1 then -- If the type is defined through an ASN.1 -- specification, then we assume the type is generated -- in the ASN1_Types package. We simply bind this type -- to the specification. Add_With_Package (E => RU (ru_asn1_types), Used => True, Warnings_Off => True, Elaborated => True); N := Make_Designator (Get_Type_Source_Name (E), Fully_Qualified_Name (RU (ru_asn1_types))); else -- Otherwise, we extract from the ARAO specific -- properties the exact nature of the type and -- generate its definition. Data_Type := Get_Data_Type (E); case Data_Type is when data_integer => N := Make_Full_Type_Declaration (Defining_Identifier => Map_Ada_Defining_Identifier (E), Type_Definition => Make_Derived_Type_Definition (RE (re_integer))); when data_float => -- In HI system floating point types are not supported Display_Located_Error (Loc (E), "No floating point in for HI applications", Fatal => True); when data_fixed => declare Data_Digits : constant unsigned_long_long := Get_Data_Digits (E); Data_Scale : constant unsigned_long_long := Get_Data_Scale (E); begin if Data_Digits /= 0 and then Data_Scale /= 0 then N := Make_Full_Type_Declaration (Defining_Identifier => Map_Ada_Defining_Identifier (E), Type_Definition => Make_Decimal_Type_Definition (Data_Digits, Data_Scale)); else if Data_Digits = 0 then Display_Located_Error (Loc (E), "Missing digit number of fixed point type", Fatal => True); end if; if Data_Scale = 0 then Display_Located_Error (Loc (E), "Missing the scale of fixed point type!", Fatal => True); end if; end if; end; when data_boolean => N := Make_Full_Type_Declaration (Defining_Identifier => Map_Ada_Defining_Identifier (E), Type_Definition => Make_Derived_Type_Definition (RE (re_boolean))); when data_character => N := Make_Full_Type_Declaration (Defining_Identifier => Map_Ada_Defining_Identifier (E), Type_Definition => Make_Derived_Type_Definition (RE (re_character))); when data_wide_character => N := Make_Full_Type_Declaration (Defining_Identifier => Map_Ada_Defining_Identifier (E), Type_Definition => Make_Derived_Type_Definition (RE (re_wide_character))); when data_string => Display_Located_Error (Loc (E), "Bounded strings not supported yet!", Fatal => True); when data_wide_string => Display_Located_Error (Loc (E), "Bounded wide strings not supported yet!", Fatal => True); when data_array => Visit (Corresponding_Instance (First_Node (Subcomponents (E)))); N := Make_Full_Type_Declaration (Defining_Identifier => Map_Ada_Defining_Identifier (E), Type_Definition => Make_Array_Type_Definition (Range_Constraints => Make_List_Id (Make_Range_Constraint (Make_Literal (New_Integer_Value (1, 1, 10)), Make_Literal (New_Integer_Value (Get_Data_Length (E), 1, 10)), RE (re_positive))), Component_Definition => Map_Ada_Data_Type_Designator (Corresponding_Instance (First_Node (Subcomponents (E)))))); when data_record | data_with_accessors => declare Components : constant list_id := New_List (ADN.k_component_list); C : node_id := First_Node (Subcomponents (E)); Visible_P : list_id; Private_P : list_id; I : unsigned_long_long; O : node_id; begin -- Build the component list while Present (C) loop -- Generate the Ada type corresponding to the -- subcomponent. Visit (Corresponding_Instance (C)); -- Make the record or private type component N := Make_Component_Declaration (Defining_Identifier => Map_Ada_Defining_Identifier (C), Subtype_Indication => Map_Ada_Data_Type_Designator (Corresponding_Instance (C))); Append_Node_To_List (N, Components); C := Next_Node (C); end loop; if Data_Type = data_record then -- Record type N := Make_Full_Type_Declaration (Defining_Identifier => Map_Ada_Defining_Identifier (E), Type_Definition => Make_Record_Type_Definition (Make_Record_Definition (Components))); else -- Protected type Visible_P := New_List (ADN.k_declaration_list); Private_P := Components; S := First_Node (Features (E)); while Present (S) loop -- We are sure that S is of kind -- K_Subprogram_Spec_Instance. Otherwise, -- an error whould be raised when trying -- to find the data type. -- Build a subprogram spec and append it -- to the visible part of the protected -- type. N := Feature_Spg_Spec (S); Bind_AADL_To_Feature_Subprogram (Identifier (S), N); Append_Node_To_List (N, Visible_P); S := Next_Node (S); end loop; -- Build the private type spec N := Make_Protected_Object_Spec (Defining_Identifier => Map_Ada_Defining_Identifier (E), Visible_Part => Visible_P, Private_Part => Private_P, Is_Type => True); I := Get_Priority_Celing_Of_Data_Access (E); if I /= 0 then -- The data component defines a priority, -- use it for the ceiling priority of the -- protected object. O := Make_Pragma_Statement (pragma_priority, Make_List_Id (Make_Literal (New_Integer_Value (I, 1, 10)))); Append_Node_To_List (O, ADN.Private_Part (N)); else -- The data component defines no priority, -- use System.Priority'Last for the -- ceiling priority of the protected -- object. O := Make_Pragma_Statement (pragma_priority, Make_List_Id (Make_Attribute_Designator (RE (re_priority), a_last))); Append_Node_To_List (O, ADN.Private_Part (N)); end if; end if; end; when others => Display_Located_Error (Loc (E), "unsupported data type (" & supported_data_type'image (Data_Type) & ")", Fatal => True); end case; end if; -- Mark the data type as being handled and append it to -- the handled list. Set_Handling (E, by_name, h_ada_type_spec, N); -- In the case of a data type with accessor, visit the -- parameters of its features subprograms. It is -- important to do this *after* marking the type as -- handled, to avoid endless loops and *before* adding -- the type declaration to the package statements because -- the declaration order of type is important in Ada. if Data_Type = data_with_accessors then S := First_Node (Features (E)); while Present (S) loop Visit (Corresponding_Instance (S)); S := Next_Node (S); end loop; end if; -- Append the type declaration to the package spec if Language_Type /= language_asn1 then Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); end if; end if; -- Bind the type to its mapping Bind_AADL_To_Type_Definition (Identifier (E), Get_Handling (E, by_name, h_ada_type_spec)); -- Declare the "default value" of a type. This value is not -- declared as a 'constant' so that the user can modify it. if No (Get_Handling (E, by_name, h_ada_type_default_value)) then Data_Type := Get_Data_Type (E); -- We generate default values for all types except -- protected types. if Data_Type /= data_with_accessors then N := Make_Object_Declaration (Defining_Identifier => Map_Ada_Default_Value_Identifier (E), Object_Definition => Map_Ada_Defining_Identifier (E), Expression => Get_Ada_Default_Value (E)); Set_Handling (E, by_name, h_ada_type_default_value, N); Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); else N := No_Node; end if; end if; -- Bind the type to its default value if a default value has -- been generated. if Present (N) then Bind_AADL_To_Default_Value (Identifier (E), Get_Handling (E, by_name, h_ada_type_default_value)); 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_Types_Spec; -- Start recording the handling since they have to be reset -- for each node. 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 types Reset_Handlings; Pop_Entity; -- U Pop_Entity; -- P end Visit_Process_Instance; ------------------------------- -- Visit_Subprogram_Instance -- ------------------------------- procedure Visit_Subprogram_Instance (E : node_id) is Call_Seq : node_id; Spg_Call : node_id; F : node_id; begin -- Declare all necessary data types if not AAU.Is_Empty (Features (E)) then F := First_Node (Features (E)); while Present (F) loop if Present (Corresponding_Instance (F)) then Visit (Corresponding_Instance (F)); end if; F := Next_Node (F); end loop; 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; F : node_id; begin -- Declare all necessary data types. We cannot rely only on -- subprogram calls to generate necessary data type becaus -- threads may not contain subprogram calls. if not AAU.Is_Empty (Features (E)) then F := First_Node (Features (E)); while Present (F) loop if Kind (F) = k_port_spec_instance and then AAN.Is_Data (F) then Visit (Corresponding_Instance (F)); end if; F := Next_Node (F); end loop; end if; -- 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 Feature_Spg_Body (E : node_id) return node_id; -- Builds a body for a protected object procedure from an AADL -- subprogram spec E. ---------------------- -- Feature_Spg_Body -- ---------------------- function Feature_Spg_Body (E : node_id) return node_id is N : node_id; Call_Profile : constant list_id := New_List (ADN.k_parameter_profile); Param : node_id; C_Access : node_id; D : node_id; Statements : constant list_id := New_List (ADN.k_statement_list); Spg : node_id; begin pragma assert (Kind (E) = k_subprogram_spec_instance); Spg := Corresponding_Instance (E); pragma assert (Is_Subprogram (Spg)); -- The body of a subprogram contained in a protected type -- contains simply a call to the user implementation of the -- corresponding AADL subprogram. -- Since the subprogram has Data Access to its containing -- data component. It gives all the protected fields of the -- protected type as IN, OUT or IN OUT (depending on the -- data access property) parameters to the subprogram -- implementation call. Therefore the parameters for the -- subprogram implementation call are: -- 1 - The list of the AADL subprogram parameters: if not AAU.Is_Empty (Features (Spg)) then Param := First_Node (Features (Spg)); while Present (Param) loop if Kind (Param) = k_parameter_instance then -- Create a parameter association N := Make_Parameter_Association (Selector_Name => Map_Ada_Defining_Identifier (Param), Actual_Parameter => Map_Ada_Defining_Identifier (Param)); Append_Node_To_List (N, Call_Profile); end if; Param := Next_Node (Param); end loop; end if; -- 2 - The list of all record fields given -- FIXME: Respect the mapping rules by setting the correct -- parameter orientation. For now all parameter are -- considered IN OUT. Provide all necessary routines -- (passing through intermediate variables, to prevent the -- user from cheating). if not AAU.Is_Empty (Features (Spg)) then C_Access := First_Node (Features (Spg)); while Present (C_Access) loop if Kind (C_Access) = k_subcomponent_access_instance then D := Corresponding_Instance (C_Access); if not AAU.Is_Empty (Subcomponents (D)) then Param := First_Node (Subcomponents (D)); while Present (Param) loop -- Create a parameter association N := Make_Parameter_Association (Selector_Name => Map_Ada_Protected_Aggregate_Identifier (C_Access, Param), Actual_Parameter => Map_Ada_Defining_Identifier (Param)); Append_Node_To_List (N, Call_Profile); Param := Next_Node (Param); end loop; end if; end if; C_Access := Next_Node (C_Access); end loop; end if; -- Call the implementation subprogram with the built profile N := Make_Subprogram_Call (Extract_Designator (ADN.Subprogram_Node (Backend_Node (Identifier (Corresponding_Instance (E))))), Call_Profile); Append_Node_To_List (N, Statements); -- Build the subprogram implementation N := Make_Subprogram_Implementation (ADN.Feature_Subprogram_Node (Backend_Node (Identifier (E))), No_List, Statements); return N; end Feature_Spg_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_data => Visit_Data_Instance (E); when cc_subprogram => Visit_Subprogram_Instance (E); when others => null; end case; end Visit_Component_Instance; ------------------------- -- Visit_Data_Instance -- ------------------------- procedure Visit_Data_Instance (E : node_id) is Data_Type : supported_data_type; N : node_id; begin -- Do not generate Ada type more than once if No (Get_Handling (E, by_name, h_ada_type_body)) then Data_Type := Get_Data_Type (E); case Data_Type is when data_with_accessors => declare Statements : constant list_id := New_List (ADN.k_statement_list); C : node_id := First_Node (Subcomponents (E)); S : node_id; begin -- Visit the subcomponents while Present (C) loop Visit (Corresponding_Instance (C)); C := Next_Node (C); end loop; -- Protected type S := First_Node (Features (E)); while Present (S) loop -- Build a subprogram spec and append it to -- the visible part of the protected type. N := Feature_Spg_Body (S); Append_Node_To_List (N, Statements); S := Next_Node (S); end loop; -- Build the private type body N := Make_Protected_Object_Body (Defining_Identifier => Map_Ada_Defining_Identifier (E), Statements => Statements); -- Append the type declaration to the package body Append_Node_To_List (N, ADN.Statements (Current_Package)); -- Mark the data type as being handled Set_Handling (E, by_name, h_ada_type_body, N); end; when others => null; end case; 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_Types_Body; -- Start recording the handling since they have to be reset -- for each node. 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 types Reset_Handlings; Pop_Entity; -- U Pop_Entity; -- P end Visit_Process_Instance; ------------------------------- -- Visit_Subprogram_Instance -- ------------------------------- procedure Visit_Subprogram_Instance (E : node_id) is Call_Seq : node_id; Spg_Call : node_id; F : node_id; begin -- Declare all necessary data types if not AAU.Is_Empty (Features (E)) then F := First_Node (Features (E)); while Present (F) loop if Present (Corresponding_Instance (F)) then Visit (Corresponding_Instance (F)); end if; F := Next_Node (F); end loop; 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; F : node_id; begin -- Declare all necessary data types. if not AAU.Is_Empty (Features (E)) then F := First_Node (Features (E)); while Present (F) loop if Kind (F) = k_port_spec_instance and then AAN.Is_Data (F) then Visit (Corresponding_Instance (F)); end if; F := Next_Node (F); end loop; end if; -- 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.Types;