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