-------------------------------------- ------------------------------------------ -- -- -- OCARINA COMPONENTS -- -- -- -- OCARINA.GENERATORS.PO_HI_ADA.MARSHALLERS -- -- -- -- 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 Namet; 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.PO_HI_Ada.Runtime; with Ocarina.Generators.PO_HI_Ada.Mapping; package body Ocarina.Generators.PO_HI_Ada.Marshallers is use Namet; use Ocarina.Nodes; use Ocarina.Generators.Utils; use Ocarina.Generators.Properties; use Ocarina.Generators.Messages; use Ocarina.Entities.Components; use Ocarina.Generators.Ada_Tree.Nutils; use Ocarina.Generators.PO_HI_Ada.Runtime; use Ocarina.Generators.PO_HI_Ada.Mapping; package ADN renames Ocarina.Generators.Ada_Tree.Nodes; package AAN renames Ocarina.Nodes; package AAU renames Ocarina.Nutils; function Get_Marshalled_Type (E : node_id) return node_id; -- Return depending on the category of component E, the type that -- should be used in procedure Marshall and Unmarshall. ------------------------- -- Get_Marshalled_Type -- ------------------------- function Get_Marshalled_Type (E : node_id) return node_id is Cathegory : constant component_category := Get_Category_Of_Component (E); T : node_id; begin case Cathegory is when cc_process => T := RE (re_port_type_1); when cc_thread => T := Extract_Designator (ADN.Port_Interface_Node (Backend_Node (Identifier (E)))); when cc_data => T := Extract_Designator (ADN.Type_Definition_Node (Backend_Node (Identifier (E)))); when others => raise Program_Error with "Cannot generate Marshall procedure" & " for a " & component_category'image (Cathegory); end case; return T; end Get_Marshalled_Type; ------------------ -- 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 Marshall_Spec (E : node_id) return node_id; -- Creates a spec for a Marshall procedure for a data type -- generated from an AADL data component, a Thread_Port type -- generated from an AADL thread component or a Port_Type type -- generated from an AADL process component. function Unmarshall_Spec (E : node_id) return node_id; -- Same as above but with an Unmarshall procedure ------------------- -- Marshall_Spec -- ------------------- function Marshall_Spec (E : node_id) return node_id is N : node_id; Profile : constant list_id := New_List (ADN.k_parameter_profile); begin -- The 'Data' parameter N := Make_Parameter_Specification (Make_Defining_Identifier (PN (p_data)), Get_Marshalled_Type (E), mode_in); Append_Node_To_List (N, Profile); -- The 'Message' parameter N := Make_Parameter_Specification (Make_Defining_Identifier (PN (p_message)), RE (re_message_type), mode_inout); Append_Node_To_List (N, Profile); N := Make_Subprogram_Specification (Make_Defining_Identifier (SN (s_marshall)), Profile); return N; end Marshall_Spec; --------------------- -- Unmarshall_Spec -- --------------------- function Unmarshall_Spec (E : node_id) return node_id is Category : constant component_category := Get_Category_Of_Component (E); N : node_id; Profile : constant list_id := New_List (ADN.k_parameter_profile); begin -- If we deal with a thread, there is an extra parameter -- correspodning to the _Ports enumerator useful for the -- marshalling. if Category = cc_thread then N := Make_Parameter_Specification (Make_Defining_Identifier (PN (p_port)), Extract_Designator (ADN.Port_Enumeration_Node (Backend_Node (Identifier (E)))), mode_in); Append_Node_To_List (N, Profile); end if; -- The 'Data' parameter N := Make_Parameter_Specification (Make_Defining_Identifier (PN (p_data)), Get_Marshalled_Type (E), mode_out); Append_Node_To_List (N, Profile); -- The 'Message' parameter N := Make_Parameter_Specification (Make_Defining_Identifier (PN (p_message)), RE (re_message_type), mode_inout); Append_Node_To_List (N, Profile); N := Make_Subprogram_Specification (Make_Defining_Identifier (SN (s_unmarshall)), Profile); return N; end Unmarshall_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 N : node_id; begin -- Do not generate Marshallers more than once per node if No (Get_Handling (E, by_name, h_ada_marshallers_spec)) then -- Marshallers are generated only for types which can -- sent through data ports and event data ports. if Get_Data_Type (E) /= data_with_accessors then N := Message_Comment ("Marshallers for DATA type " & Get_Name_String (Name (Identifier (E)))); Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); -- Marshall procedure N := Marshall_Spec (E); Bind_AADL_To_Marshall (Identifier (E), N); Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); -- Unmarshall procedure N := Unmarshall_Spec (E); Bind_AADL_To_Unmarshall (Identifier (E), N); Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); -- Mark the data type as being handled. Set_Handling (E, by_name, h_ada_marshallers_spec, Identifier (E)); end if; else -- Do the tree bindings only Bind_AADL_To_Marshall (Identifier (E), ADN.Marshall_Node (Backend_Node (Get_Handling (E, by_name, h_ada_marshallers_spec)))); Bind_AADL_To_Unmarshall (Identifier (E), ADN.Unmarshall_Node (Backend_Node (Get_Handling (E, by_name, h_ada_marshallers_spec)))); 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); C : constant node_id := Parent_Subcomponent (E); N : node_id; S : node_id; begin Push_Entity (P); Push_Entity (U); Set_Marshallers_Spec; -- Start recording the handling since they have to be reset -- for each node. Start_Recording_Handlings; -- Generate marshallers for the Port_Type enumeration N := Message_Comment ("Marshallers for Port_Type enumeration of process " & Get_Name_String (Name (Identifier (C)))); Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); -- Marshall procedure N := Marshall_Spec (E); Bind_AADL_To_Marshall (Identifier (E), N); Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); -- Unmarshall procedure N := Unmarshall_Spec (E); Bind_AADL_To_Unmarshall (Identifier (E), N); Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); -- 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 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 then Display_Located_Error (Loc (F), "Port features in subprogram are not supported", Fatal => True); end if; if Present (Corresponding_Instance (F)) then Visit (Corresponding_Instance (F)); end if; F := Next_Node (F); 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 S : constant node_id := Parent_Subcomponent (E); N : node_id; F : node_id; begin if Has_Ports (E) then -- Generate marshallers for the Port_Type enumeration N := Message_Comment ("Marshallers for interface type of thread " & Get_Name_String (Name (Identifier (S)))); Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); -- Marshall procedure N := Marshall_Spec (E); Bind_AADL_To_Marshall (Identifier (E), N); Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); -- Unmarshall procedure N := Unmarshall_Spec (E); Bind_AADL_To_Unmarshall (Identifier (E), N); Append_Node_To_List (N, ADN.Visible_Part (Current_Package)); end if; -- The only data that need to be marshalled or unmarshalled -- is the data that is meant to be sent between threads -- (locally or remotly). So we visit only thread features. 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; 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 Marshall_Implementation (E : node_id) return node_id; -- Creates an implementation for a Marshall procedure function Unmarshall_Implementation (E : node_id) return node_id; -- Same as above but with an Unmarshall procedure function Marshallers_Intantiation (E : node_id) return node_id; -- Creates a generic instantiation for the Marshallers_G -- package corresponding to the node E. function Extract_Enumerator (F : node_id) return node_id; -- Return a fully qualified name for the _Port_Type -- enumerator corresponding to the feature F. ----------------------------- -- Marshall_Implementation -- ----------------------------- function Marshall_Implementation (E : node_id) return node_id is Spec : constant node_id := ADN.Marshall_Node (Backend_Node (Identifier (E))); N : node_id; begin -- The marshallers for processes and data component ara -- simple renaming of intantiated ones. Fo thread -- components, the body is more complex. if not Is_Thread (E) then N := Make_Selected_Component (Make_Defining_Identifier (Map_Marshallers_Name (E)), Make_Defining_Identifier (SN (s_marshall))); N := Make_Subprogram_Specification (Defining_Identifier => ADN.Defining_Identifier (Spec), Parameter_Profile => ADN.Parameter_Profile (Spec), Return_Type => ADN.Return_Type (Spec), Renamed_Subprogram => N); else declare Alternatives : constant list_id := New_List (ADN.k_list_id); Statements : list_id; Declarations : list_id; F : node_id; Has_Data : Boolean := False; begin -- Check if the thread conrains at least one OUT DATA -- port, other wise, there is nothing to marshall F := First_Node (Features (E)); while Present (F) loop if Kind (F) = k_port_spec_instance and then Is_Out (F) and then AAN.Is_Data (F) then Has_Data := True; exit; end if; F := Next_Node (F); end loop; if Has_Data then -- If we are at this point, we are sure that the -- thread contains at least one data port. We must -- also take in account the presence of pure event -- ports, bu adding null case alternative for them F := First_Node (Features (E)); while Present (F) loop if Kind (F) = k_port_spec_instance and then Is_Out (F) then -- The statements (if any) Statements := New_List (ADN.k_statement_list); if AAN.Is_Data (F) then N := Make_Subprogram_Call (Extract_Designator (ADN.Marshall_Node (Backend_Node (Identifier (Corresponding_Instance (F))))), Make_List_Id (Make_Selected_Component (Make_Designator (PN (p_data)), Make_Defining_Identifier (Map_Ada_Component_Name (F))), Make_Defining_Identifier (PN (p_message)))); Append_Node_To_List (N, Statements); end if; N := Make_Case_Statement_Alternative (Make_List_Id (Extract_Enumerator (F)), Statements); Append_Node_To_List (N, Alternatives); end if; F := Next_Node (F); end loop; N := Make_Case_Statement_Alternative (No_List, Make_List_Id (Make_Raise_Statement (Make_Designator (EN (e_program_error))))); Append_Node_To_List (N, Alternatives); N := Make_Case_Statement (Make_Selected_Component (Make_Designator (PN (p_data)), Make_Designator (PN (p_port))), Alternatives); N := Make_Subprogram_Implementation (Spec, No_List, Make_List_Id (N)); else Declarations := New_List (ADN.k_declaration_list); -- Add a pragma unreferenced for parameters N := Make_Pragma_Statement (pragma_unreferenced, Make_List_Id (Make_Defining_Identifier (PN (p_message)))); Append_Node_To_List (N, Declarations); N := Make_Pragma_Statement (pragma_unreferenced, Make_List_Id (Make_Defining_Identifier (PN (p_data)))); Append_Node_To_List (N, Declarations); N := Make_Subprogram_Implementation (Spec, Declarations, No_List); end if; end; end if; return N; end Marshall_Implementation; ------------------------------- -- Unmarshall_Implementation -- ------------------------------- function Unmarshall_Implementation (E : node_id) return node_id is Spec : constant node_id := ADN.Unmarshall_Node (Backend_Node (Identifier (E))); N : node_id; begin -- The marshallers for processes and data component ara -- simple renaming of intantiated ones. Fo thread -- components, the body is more complex. if not Is_Thread (E) then N := Make_Selected_Component (Make_Defining_Identifier (Map_Marshallers_Name (E)), Make_Defining_Identifier (SN (s_unmarshall))); N := Make_Subprogram_Specification (Defining_Identifier => ADN.Defining_Identifier (Spec), Parameter_Profile => ADN.Parameter_Profile (Spec), Return_Type => ADN.Return_Type (Spec), Renamed_Subprogram => N); else declare Alternatives : constant list_id := New_List (ADN.k_list_id); Declarations : constant list_id := New_List (ADN.k_declaration_list); Statements : list_id; Aggregates : list_id; Ref_Message : Boolean := False; F : node_id; begin -- If the thread has not IN port, there is nothing to -- unmarshall if Has_In_Ports (E) then -- If we are at this point, we are sure that the -- thread contains at least one port F := First_Node (Features (E)); while Present (F) loop if Kind (F) = k_port_spec_instance and then Is_In (F) then -- The record aggregate Aggregates := New_List (ADN.k_statement_list); N := Make_Component_Association (Make_Defining_Identifier (PN (p_port)), Extract_Enumerator (F)); Append_Node_To_List (N, Aggregates); -- The statements (if any) Statements := New_List (ADN.k_statement_list); if AAN.Is_Data (F) then -- Declare the temporary variable N := Make_Object_Declaration (Defining_Identifier => Make_Defining_Identifier (Map_Ada_Component_Name (F)), Object_Definition => Map_Ada_Data_Type_Designator (Corresponding_Instance (F))); Append_Node_To_List (N, Declarations); N := Make_Subprogram_Call (Extract_Designator (ADN.Unmarshall_Node (Backend_Node (Identifier (Corresponding_Instance (F))))), Make_List_Id (Make_Defining_Identifier (Map_Ada_Component_Name (F)), Make_Defining_Identifier (PN (p_message)))); Append_Node_To_List (N, Statements); -- Append the extra aggregate N := Make_Component_Association (Make_Defining_Identifier (Map_Ada_Component_Name (F)), Make_Defining_Identifier (Map_Ada_Component_Name (F))); Append_Node_To_List (N, Aggregates); -- Mark the message formal parameter as -- being referenced. Ref_Message := True; end if; -- Assign the port value N := Make_Assignment_Statement (Make_Defining_Identifier (PN (p_data)), Make_Qualified_Expression (Extract_Designator (ADN.Port_Interface_Node (Backend_Node (Identifier (E)))), Make_Record_Aggregate (Aggregates))); Append_Node_To_List (N, Statements); N := Make_Case_Statement_Alternative (Make_List_Id (Extract_Enumerator (F)), Statements); Append_Node_To_List (N, Alternatives); end if; F := Next_Node (F); end loop; N := Make_Case_Statement_Alternative (No_List, Make_List_Id (Make_Raise_Statement (Make_Designator (EN (e_program_error))))); Append_Node_To_List (N, Alternatives); if not Ref_Message then -- Add a pragma unreferenced for 'Message' N := Make_Pragma_Statement (pragma_unreferenced, Make_List_Id (Make_Defining_Identifier (PN (p_message)))); Append_Node_To_List (N, Declarations); end if; N := Make_Case_Statement (Make_Defining_Identifier (PN (p_port)), Alternatives); N := Make_Subprogram_Implementation (Spec, Declarations, Make_List_Id (N)); else -- Add a pragma unreferenced for parameters N := Make_Pragma_Statement (pragma_unreferenced, Make_List_Id (Make_Defining_Identifier (PN (p_port)))); Append_Node_To_List (N, Declarations); N := Make_Pragma_Statement (pragma_unreferenced, Make_List_Id (Make_Defining_Identifier (PN (p_message)))); Append_Node_To_List (N, Declarations); N := Make_Pragma_Statement (pragma_unreferenced, Make_List_Id (Make_Defining_Identifier (PN (p_data)))); Append_Node_To_List (N, Declarations); N := Make_Subprogram_Implementation (Spec, Declarations, No_List); end if; end; end if; return N; end Unmarshall_Implementation; ------------------------------ -- Marshallers_Intantiation -- ------------------------------ function Marshallers_Intantiation (E : node_id) return node_id is N : node_id; begin N := Make_Package_Instantiation (Defining_Identifier => Make_Defining_Identifier (Map_Marshallers_Name (E)), Generic_Package => RU (ru_polyorb_hi_marshallers_g), Parameter_List => Make_List_Id (Get_Marshalled_Type (E))); return N; end Marshallers_Intantiation; ------------------------ -- Extract_Enumerator -- ------------------------ function Extract_Enumerator (F : node_id) return node_id is T : constant node_id := Parent_Component (F); P : constant node_id := Extract_Designator (ADN.Port_Enumeration_Node (Backend_Node (Identifier (T)))); N : constant node_id := Map_Ada_Defining_Identifier (F); begin Set_Homogeneous_Parent_Unit_Name (N, ADN.Parent_Unit_Name (P)); return N; end Extract_Enumerator; ----------- -- 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 N : node_id; begin -- Do not generate Marshallers more than once per node if No (Get_Handling (E, by_name, h_ada_marshallers_body)) then -- Marshallers are generated only for types which can -- sent through data ports and event data ports. if Get_Data_Type (E) /= data_with_accessors then N := Message_Comment ("Marshallers for DATA type " & Get_Name_String (Name (Identifier (E)))); Append_Node_To_List (N, ADN.Statements (Current_Package)); -- Package instantiation N := Marshallers_Intantiation (E); Append_Node_To_List (N, ADN.Statements (Current_Package)); -- Marshall procedure N := Marshall_Implementation (E); Append_Node_To_List (N, ADN.Statements (Current_Package)); -- Unmarshall procedure N := Unmarshall_Implementation (E); Append_Node_To_List (N, ADN.Statements (Current_Package)); -- Mark the data type as being handled. Set_Handling (E, by_name, h_ada_marshallers_body, Identifier (E)); end if; 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); C : constant node_id := Parent_Subcomponent (E); N : node_id; S : node_id; begin Push_Entity (P); Push_Entity (U); Set_Marshallers_Body; -- Start recording the handling since they have to be reset -- for each node. Start_Recording_Handlings; -- Generate marshallers for the Port_Type enumeration N := Message_Comment ("Marshallers for Port_Type enumeration of process " & Get_Name_String (Name (Identifier (C)))); Append_Node_To_List (N, ADN.Statements (Current_Package)); -- Package instantiation N := Marshallers_Intantiation (E); Append_Node_To_List (N, ADN.Statements (Current_Package)); -- Marshall procedure N := Marshall_Implementation (E); Append_Node_To_List (N, ADN.Statements (Current_Package)); -- Unmarshall procedure N := Unmarshall_Implementation (E); Append_Node_To_List (N, ADN.Statements (Current_Package)); -- 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 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 then Display_Located_Error (Loc (F), "Port features in subprogram are not supported", Fatal => True); end if; if Present (Corresponding_Instance (F)) then Visit (Corresponding_Instance (F)); end if; F := Next_Node (F); 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 S : constant node_id := Parent_Subcomponent (E); N : node_id; F : node_id; begin if Has_Ports (E) then -- Generate marshallers for the Port_Type enumeration N := Message_Comment ("Marshallers for interface type of thread " & Get_Name_String (Name (Identifier (S)))); Append_Node_To_List (N, ADN.Statements (Current_Package)); -- Marshall procedure N := Marshall_Implementation (E); Append_Node_To_List (N, ADN.Statements (Current_Package)); -- Unmarshall procedure N := Unmarshall_Implementation (E); Append_Node_To_List (N, ADN.Statements (Current_Package)); end if; -- The only data that need to be marshalled or unmarshalled -- is the data that is meant to be sent between threads -- (locally or remotly). So we visit only thread features. 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; end Visit_Thread_Instance; end Package_Body; end Ocarina.Generators.PO_HI_Ada.Marshallers;