From d693e39d020f8707434fe2e9f07849a9177fc5c5 Mon Sep 17 00:00:00 2001 From: Thomas Quinot Date: Mon, 26 May 2008 14:43:50 +0000 Subject: [PATCH] 2008-05-26 Thomas Quinot * rtsfind.ads, rtsfind.adb: (RE_Get_RACW): New runtime library entity provided by PolyORB s-parint. (Check_RPC): Support per-PCS-kind API versioning. exp_dist.ads, exp_dist.adb: (Build_Stub_Tag, Get_Stub_Elements): New utility subprograms. (PolyORB_Support.Add_RACW_From_Any): Offload common code to new runtime library function Get_RACW. (PolyORB_Support.Add_RACW_To_Any): Offload common code to new runtime library function Get_Reference. (PolyORB_Support.Add_RACW_Read_Attribute): Use Get_RACW instead of going through an intermediate Any. (PolyORB_Support.Add_RACW_Write_Attribute): Use Get_Reference instead of going through an intermediate Any. * sem_dist.adb: Minor reformatting. From-SVN: r135932 --- gcc/ada/ChangeLog | 19 + gcc/ada/exp_dist.adb | 1868 ++++++++++++++++++------------------------ gcc/ada/exp_dist.ads | 10 +- gcc/ada/rtsfind.adb | 4 +- gcc/ada/rtsfind.ads | 2 + gcc/ada/sem_dist.adb | 79 +- 6 files changed, 853 insertions(+), 1129 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 32d47aaaa87..dfd9a2c568b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2008-05-26 Thomas Quinot + + * rtsfind.ads, rtsfind.adb: + (RE_Get_RACW): New runtime library entity provided by PolyORB s-parint. + (Check_RPC): Support per-PCS-kind API versioning. + + exp_dist.ads, exp_dist.adb: + (Build_Stub_Tag, Get_Stub_Elements): New utility subprograms. + (PolyORB_Support.Add_RACW_From_Any): Offload common code to new runtime + library function Get_RACW. + (PolyORB_Support.Add_RACW_To_Any): Offload common code to new runtime + library function Get_Reference. + (PolyORB_Support.Add_RACW_Read_Attribute): Use Get_RACW instead of going + through an intermediate Any. + (PolyORB_Support.Add_RACW_Write_Attribute): Use Get_Reference instead of + going through an intermediate Any. + + * sem_dist.adb: Minor reformatting. + 2008-05-26 Javier Miranda * einfo.ads (Abstract_Interface_Alias): Renamed as Interface_Alias. diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 47e193fb8bc..3a37cb30a2f 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -43,7 +43,6 @@ with Sem_Dist; use Sem_Dist; with Sem_Eval; use Sem_Eval; with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; -with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; with Tbuild; use Tbuild; @@ -184,6 +183,12 @@ package body Exp_Dist is -- tag fixup (Get_Unique_Remote_Pointer may have changed Pointer'Tag to -- RACW_Stub_Type'Tag, while the desired tag is that of Stub_Type). + function Build_Stub_Tag + (Loc : Source_Ptr; + RACW_Type : Entity_Id) return Node_Id; + -- Return an expression denoting the tag of the stub type associated with + -- RACW_Type. + function Build_Subprogram_Calling_Stubs (Vis_Decl : Node_Id; Subp_Id : Node_Id; @@ -382,6 +387,9 @@ package body Exp_Dist is Equal => "="); -- Mapping between a RCI subprogram and the corresponding calling stubs + function Get_Stub_Elements (RACW_Type : Entity_Id) return Stub_Structure; + -- Return the stub information associated with the given RACW type + procedure Add_Stub_Type (Designated_Type : Entity_Id; RACW_Type : Entity_Id; @@ -1247,6 +1255,7 @@ package body Exp_Dist is RPC_Receiver := Make_Defining_Identifier (Loc, Chars => New_Internal_Name ('P')); + Specific_Build_RPC_Receiver_Body (RPC_Receiver => RPC_Receiver, Request => RPC_Receiver_Request, @@ -1388,13 +1397,14 @@ package body Exp_Dist is Parameter_Associations => New_List ( New_Occurrence_Of (RPC_Receiver_Subp_Id, Loc), Make_String_Literal (Loc, Subp_Str))), + Then_Statements => New_List ( Make_Assignment_Statement (Loc, Name => New_Occurrence_Of ( RPC_Receiver_Subp_Index, Loc), Expression => Make_Integer_Literal (Loc, - Current_Primitive_Number))))); + Intval => Current_Primitive_Number))))); end if; Append_To (RPC_Receiver_Case_Alternatives, @@ -1465,10 +1475,6 @@ package body Exp_Dist is RAS_Type : constant Entity_Id := Defining_Identifier (N); Fat_Type : constant Entity_Id := Equivalent_Type (RAS_Type); RACW_Type : constant Entity_Id := Underlying_RACW_Type (RAS_Type); - Desig : constant Entity_Id := Etype (Designated_Type (RACW_Type)); - - Stub_Elements : constant Stub_Structure := Stubs_Table.Get (Desig); - pragma Assert (Stub_Elements /= Empty_Stub_Structure); RACW_Primitive_Name : Node_Id; @@ -1642,17 +1648,16 @@ package body Exp_Dist is Subp_Name : constant Entity_Id := Defining_Unit_Name (Specification (Vis_Decl)); - Pkg_Name : constant Entity_Id := - Make_Defining_Identifier (Loc, - Chars => - New_External_Name (Chars (Subp_Name), 'P', -1)); + Pkg_Name : constant Entity_Id := + Make_Defining_Identifier (Loc, + Chars => New_External_Name (Chars (Subp_Name), 'P', -1)); Proxy_Type : constant Entity_Id := Make_Defining_Identifier (Loc, Chars => - New_External_Name ( - Related_Id => Chars (Subp_Name), - Suffix => 'P')); + New_External_Name + (Related_Id => Chars (Subp_Name), + Suffix => 'P')); Proxy_Type_Full_View : constant Entity_Id := Make_Defining_Identifier (Loc, @@ -1698,12 +1703,9 @@ package body Exp_Dist is Append_To (Vis_Decls, Make_Object_Declaration (Loc, - Defining_Identifier => - Proxy_Object_Addr, - Constant_Present => - True, - Object_Definition => - New_Occurrence_Of (RTE (RE_Address), Loc))); + Defining_Identifier => Proxy_Object_Addr, + Constant_Present => True, + Object_Definition => New_Occurrence_Of (RTE (RE_Address), Loc))); -- private @@ -1714,8 +1716,7 @@ package body Exp_Dist is Append_To (Pvt_Decls, Make_Full_Type_Declaration (Loc, - Defining_Identifier => - Proxy_Type_Full_View, + Defining_Identifier => Proxy_Type_Full_View, Type_Definition => Build_Remote_Subprogram_Proxy_Type (Loc, New_Occurrence_Of (All_Calls_Remote_E, Loc)))); @@ -1743,19 +1744,15 @@ package body Exp_Dist is if Nkind (Subp_Decl_Spec) = N_Procedure_Specification then Perform_Call := Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (Subp_Name, Loc), - Parameter_Associations => - Actuals); + Name => New_Occurrence_Of (Subp_Name, Loc), + Parameter_Associations => Actuals); else Perform_Call := Make_Simple_Return_Statement (Loc, Expression => - Make_Function_Call (Loc, - Name => - New_Occurrence_Of (Subp_Name, Loc), - Parameter_Associations => - Actuals)); + Make_Function_Call (Loc, + Name => New_Occurrence_Of (Subp_Name, Loc), + Parameter_Associations => Actuals)); end if; Formal := First (Parameter_Specifications (Subp_Decl_Spec)); @@ -1771,31 +1768,23 @@ package body Exp_Dist is Append_To (Pvt_Decls, Make_Object_Declaration (Loc, - Defining_Identifier => - Make_Defining_Identifier (Loc, - Name_uO), - Aliased_Present => - True, - Object_Definition => - New_Occurrence_Of (Proxy_Type, Loc))); + Defining_Identifier => Make_Defining_Identifier (Loc, Name_uO), + Aliased_Present => True, + Object_Definition => New_Occurrence_Of (Proxy_Type, Loc))); -- A : constant System.Address := O'Address; Append_To (Pvt_Decls, Make_Object_Declaration (Loc, Defining_Identifier => - Make_Defining_Identifier (Loc, - Chars (Proxy_Object_Addr)), - Constant_Present => - True, - Object_Definition => - New_Occurrence_Of (RTE (RE_Address), Loc), + Make_Defining_Identifier (Loc, Chars (Proxy_Object_Addr)), + Constant_Present => True, + Object_Definition => New_Occurrence_Of (RTE (RE_Address), Loc), Expression => Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of ( Defining_Identifier (Last (Pvt_Decls)), Loc), - Attribute_Name => - Name_Address))); + Attribute_Name => Name_Address))); Append_To (Decls, Make_Package_Declaration (Loc, @@ -1809,12 +1798,10 @@ package body Exp_Dist is Append_To (Decls, Make_Package_Body (Loc, Defining_Unit_Name => - Make_Defining_Identifier (Loc, - Chars (Pkg_Name)), + Make_Defining_Identifier (Loc, Chars (Pkg_Name)), Declarations => New_List ( Make_Subprogram_Body (Loc, - Specification => - Subp_Body_Spec, + Specification => Subp_Body_Spec, Declarations => New_List, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, @@ -2058,10 +2045,8 @@ package body Exp_Dist is Chars => Name_Address, Expression => Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Constant_Object, Loc), - Attribute_Name => - Name_Address))); + Prefix => New_Occurrence_Of (Constant_Object, Loc), + Attribute_Name => Name_Address))); end; end if; @@ -2077,8 +2062,7 @@ package body Exp_Dist is Make_Object_Declaration (Loc, Defining_Identifier => Object, Constant_Present => Present (Expr) and then not Variable, - Object_Definition => - New_Occurrence_Of (Etyp, Loc), + Object_Definition => New_Occurrence_Of (Etyp, Loc), Expression => Expr)); if Constant_Present (Last (Decls)) then @@ -2110,17 +2094,14 @@ package body Exp_Dist is Make_Assignment_Statement (Loc, Name => Make_Selected_Component (Loc, - Prefix => - New_Occurrence_Of (Pointer, Loc), + Prefix => New_Occurrence_Of (Pointer, Loc), Selector_Name => New_Occurrence_Of (First_Tag_Component (Designated_Type (Etype (Pointer))), Loc)), Expression => Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Stub_Type, Loc), - Attribute_Name => - Name_Tag))); + Prefix => New_Occurrence_Of (Stub_Type, Loc), + Attribute_Name => Name_Tag))); -- Note: The assignment to Pointer._Tag is safe here because -- we carefully ensured that Stub_Type has exactly the same layout @@ -2227,8 +2208,7 @@ package body Exp_Dist is Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Defining_Entity (Pkg_Spec), Loc), - Attribute_Name => - Name_Version))); + Attribute_Name => Name_Version))); Append_To (L, Reg); Analyze (Reg); end Build_Passive_Partition_Stub; @@ -2302,6 +2282,22 @@ package body Exp_Dist is New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc)))))); end Build_Remote_Subprogram_Proxy_Type; + -------------------- + -- Build_Stub_Tag -- + -------------------- + + function Build_Stub_Tag + (Loc : Source_Ptr; + RACW_Type : Entity_Id) return Node_Id + is + Stub_Type : constant Entity_Id := Corresponding_Stub_Type (RACW_Type); + begin + return + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Stub_Type, Loc), + Attribute_Name => Name_Tag); + end Build_Stub_Tag; + ------------------------------------ -- Build_Subprogram_Calling_Stubs -- ------------------------------------ @@ -2689,8 +2685,7 @@ package body Exp_Dist is Append_To (Stmts, Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_NVList_Create), Loc), + Name => New_Occurrence_Of (RTE (RE_NVList_Create), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (NVList, Loc)))); end Declare_Create_NVList; @@ -2818,7 +2813,9 @@ package body Exp_Dist is declare HSS_Stmts : constant List_Id := Statements (Handled_Statement_Sequence (Unit_Node)); + First_HSS_Stmt : constant Node_Id := First (HSS_Stmts); + begin if No (First_HSS_Stmt) then Append_List_To (HSS_Stmts, Stubs_Stmts); @@ -2878,7 +2875,8 @@ package body Exp_Dist is (Loc : Source_Ptr; Decls : List_Id; RPC_Receiver : Entity_Id; - Stub_Elements : Stub_Structure) is + Stub_Elements : Stub_Structure) + is begin -- The RPC receiver body should not be the completion of the -- declaration recorded in the stub structure, because then the @@ -2931,18 +2929,18 @@ package body Exp_Dist is Attribute_Name => Name_Address); end if; - Add_RACW_Write_Attribute ( - RACW_Type, - Stub_Type, - Stub_Type_Access, - RPC_Receiver, - Body_Decls); - - Add_RACW_Read_Attribute ( - RACW_Type, - Stub_Type, - Stub_Type_Access, - Body_Decls); + Add_RACW_Write_Attribute + (RACW_Type, + Stub_Type, + Stub_Type_Access, + RPC_Receiver, + Body_Decls); + + Add_RACW_Read_Attribute + (RACW_Type, + Stub_Type, + Stub_Type_Access, + Body_Decls); end Add_RACW_Features; ----------------------------- @@ -3001,6 +2999,7 @@ package body Exp_Dist is Insert_After (Proc_Decl, Attr_Decl); if No (Body_Decls) then + -- Case of processing an RACW type from another unit than the -- main one: do not generate a body. @@ -3273,35 +3272,31 @@ package body Exp_Dist is -- a remote object. Remote_Statements := New_List ( - Pack_Node_Into_Stream_Access (Loc, - Stream => Stream_Parameter, - Object => + Stream => Stream_Parameter, + Object => Make_Selected_Component (Loc, - Prefix => Unchecked_Convert_To (Stub_Type_Access, - Object), - Selector_Name => - Make_Identifier (Loc, Name_Origin)), - Etyp => RTE (RE_Partition_ID)), + Prefix => + Unchecked_Convert_To (Stub_Type_Access, Object), + Selector_Name => Make_Identifier (Loc, Name_Origin)), + Etyp => RTE (RE_Partition_ID)), Pack_Node_Into_Stream_Access (Loc, Stream => Stream_Parameter, Object => Make_Selected_Component (Loc, - Prefix => Unchecked_Convert_To (Stub_Type_Access, - Object), - Selector_Name => - Make_Identifier (Loc, Name_Receiver)), + Prefix => + Unchecked_Convert_To (Stub_Type_Access, Object), + Selector_Name => Make_Identifier (Loc, Name_Receiver)), Etyp => RTE (RE_Unsigned_64)), Pack_Node_Into_Stream_Access (Loc, Stream => Stream_Parameter, Object => Make_Selected_Component (Loc, - Prefix => Unchecked_Convert_To (Stub_Type_Access, - Object), - Selector_Name => - Make_Identifier (Loc, Name_Addr)), + Prefix => + Unchecked_Convert_To (Stub_Type_Access, Object), + Selector_Name => Make_Identifier (Loc, Name_Addr)), Etyp => RTE (RE_Unsigned_64))); -- Build code fragment corresponding to marshalling of a null object @@ -3328,7 +3323,9 @@ package body Exp_Dist is Make_Op_Eq (Loc, Left_Opnd => Object, Right_Opnd => Make_Null (Loc)), + Then_Statements => Null_Statements, + Elsif_Parts => New_List ( Make_Elsif_Part (Loc, Condition => @@ -3337,6 +3334,7 @@ package body Exp_Dist is Make_Attribute_Reference (Loc, Prefix => Object, Attribute_Name => Name_Tag), + Right_Opnd => Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Stub_Type, Loc), @@ -3451,7 +3449,7 @@ package body Exp_Dist is begin Proc_Decls := New_List ( - -- Common declarations + -- Common declarations Make_Object_Declaration (Loc, Defining_Identifier => Origin, @@ -3465,15 +3463,15 @@ package body Exp_Dist is Parameter_Associations => New_List ( New_Occurrence_Of (Package_Name, Loc)))), - -- Declaration use only in the local case: proxy address + -- Declaration use only in the local case: proxy address Make_Object_Declaration (Loc, Defining_Identifier => Proxy_Addr, Object_Definition => New_Occurrence_Of (RTE (RE_Unsigned_64), Loc)), - -- Declarations used only in the remote case: stub object and - -- stub pointer. + -- Declarations used only in the remote case: stub object and + -- stub pointer. Make_Object_Declaration (Loc, Defining_Identifier => Local_Stub, @@ -3492,7 +3490,8 @@ package body Exp_Dist is Attribute_Name => Name_Unchecked_Access))); Set_Etype (Stub_Ptr, Stub_Elements.Stub_Type_Access); - -- Build_Get_Unique_RP_Call needs this information + + -- Build_Get_Unique_RP_Call needs above information -- Note: Here we assume that the Fat_Type is a record -- containing just a pointer to a proxy or stub object. @@ -3509,8 +3508,7 @@ package body Exp_Dist is -- end if; Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Get_RAS_Info), Loc), + Name => New_Occurrence_Of (RTE (RE_Get_RAS_Info), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Package_Name, Loc), New_Occurrence_Of (Subp_Id, Loc), @@ -3527,9 +3525,11 @@ package body Exp_Dist is Make_Function_Call (Loc, New_Occurrence_Of ( RTE (RE_Get_Local_Partition_Id), Loc))), + Right_Opnd => Make_Op_Not (Loc, New_Occurrence_Of (All_Calls_Remote, Loc))), + Then_Statements => New_List ( Make_Simple_Return_Statement (Loc, Unchecked_Convert_To (Fat_Type, @@ -3548,12 +3548,12 @@ package body Exp_Dist is Set_Field (Name_Addr, New_Occurrence_Of (Proxy_Addr, Loc)), - -- E.4.1(9) A remote call is asynchronous if it is a call to - -- a procedure, or a call through a value of an access-to-procedure - -- type, to which a pragma Asynchronous applies. + -- E.4.1(9) A remote call is asynchronous if it is a call to + -- a procedure or a call through a value of an access-to-procedure + -- type to which a pragma Asynchronous applies. - -- Parameter Asynch_P is true when the procedure is asynchronous; - -- Expression Asynch_T is true when the type is asynchronous. + -- Asynch_P is true when the procedure is asynchronous; + -- Asynch_T is true when the type is asynchronous. Set_Field (Name_Asynchronous, Make_Or_Else (Loc, @@ -3704,8 +3704,7 @@ package body Exp_Dist is New_List ( Make_Procedure_Call_Statement (Loc, Name => - New_Occurrence_Of ( - Defining_Entity (Stubs), Loc), + New_Occurrence_Of (Defining_Entity (Stubs), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Request_Parameter, Loc)))))); end Append_Stubs_To; @@ -3748,10 +3747,12 @@ package body Exp_Dist is Make_Op_Eq (Loc, New_Occurrence_Of (Subp_Id, Loc), Make_Integer_Literal (Loc, 0)), + Then_Statements => New_List ( Make_Assignment_Statement (Loc, Name => New_Occurrence_Of (Subp_Id, Loc), + Expression => Make_Selected_Component (Loc, Prefix => @@ -3766,6 +3767,7 @@ package body Exp_Dist is Make_Selected_Component (Loc, Prefix => Request_Parameter, Selector_Name => Name_Params))))), + Selector_Name => Make_Identifier (Loc, Name_Subp_Id)))))); @@ -3787,6 +3789,7 @@ package body Exp_Dist is New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc))), Result_Definition => New_Occurrence_Of (RTE (RE_Unsigned_64), Loc))); + Append_To (Decls, Current_Declaration); Analyze (Current_Declaration); @@ -3869,6 +3872,7 @@ package body Exp_Dist is Choices => New_List ( Make_Integer_Literal (Loc, Current_Subprogram_Number)), + Expression => Make_Aggregate (Loc, Component_Associations => New_List ( @@ -3880,10 +3884,8 @@ package body Exp_Dist is Proxy_Object_Addr, Loc)))))); Append_Stubs_To (Pkg_RPC_Receiver_Cases, - Stubs => - Current_Stubs, - Subprogram_Number => - Current_Subprogram_Number); + Stubs => Current_Stubs, + Subprogram_Number => Current_Subprogram_Number); end; Current_Subprogram_Number := Current_Subprogram_Number + 1; @@ -3902,15 +3904,12 @@ package body Exp_Dist is Append_To (Pkg_RPC_Receiver_Cases, Make_Case_Statement_Alternative (Loc, - Discrete_Choices => - New_List (Make_Others_Choice (Loc)), - Statements => - New_List (Make_Null_Statement (Loc)))); + Discrete_Choices => New_List (Make_Others_Choice (Loc)), + Statements => New_List (Make_Null_Statement (Loc)))); Append_To (Pkg_RPC_Receiver_Statements, Make_Case_Statement (Loc, - Expression => - New_Occurrence_Of (Subp_Id, Loc), + Expression => New_Occurrence_Of (Subp_Id, Loc), Alternatives => Pkg_RPC_Receiver_Cases)); Append_To (Decls, @@ -3930,8 +3929,9 @@ package body Exp_Dist is First_RCI_Subprogram_Id), High_Bound => Make_Integer_Literal (Loc, - First_RCI_Subprogram_Id - + List_Length (Subp_Info_List) - 1))))))); + Intval => + First_RCI_Subprogram_Id + + List_Length (Subp_Info_List) - 1))))))); -- For a degenerate RCI with no visible subprograms, Subp_Info_List -- has zero length, and the declaration is for an empty array, in @@ -3962,13 +3962,11 @@ package body Exp_Dist is Make_Selected_Component (Loc, Prefix => Make_Indexed_Component (Loc, - Prefix => - New_Occurrence_Of (Subp_Info_Array, Loc), + Prefix => New_Occurrence_Of (Subp_Info_Array, Loc), Expressions => New_List ( Convert_To (Standard_Integer, Make_Identifier (Loc, Name_Subp_Id)))), - Selector_Name => - Make_Identifier (Loc, Name_Addr)); + Selector_Name => Make_Identifier (Loc, Name_Addr)); -- Case of no visible subprogram: just raise Constraint_Error, we -- know for sure we got junk from a remote partition. @@ -3984,15 +3982,14 @@ package body Exp_Dist is Make_Subprogram_Body (Loc, Specification => Copy_Specification (Loc, Parent (Lookup_RAS_Info)), - Declarations => - No_List, + Declarations => No_List, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Statements => New_List ( Make_Simple_Return_Statement (Loc, Expression => - OK_Convert_To (RTE (RE_Unsigned_64), - Subp_Info_Addr)))))); + OK_Convert_To + (RTE (RE_Unsigned_64), Subp_Info_Addr)))))); end; Analyze (Last (Decls)); @@ -4012,10 +4009,8 @@ package body Exp_Dist is Append_To (Register_Pkg_Actuals, Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Pkg_RPC_Receiver, Loc), - Attribute_Name => - Name_Unrestricted_Access)); + Prefix => New_Occurrence_Of (Pkg_RPC_Receiver, Loc), + Attribute_Name => Name_Unrestricted_Access)); -- Version @@ -4023,26 +4018,21 @@ package body Exp_Dist is Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Defining_Entity (Pkg_Spec), Loc), - Attribute_Name => - Name_Version)); + Attribute_Name => Name_Version)); -- Subp_Info Append_To (Register_Pkg_Actuals, Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Subp_Info_Array, Loc), - Attribute_Name => - Name_Address)); + Prefix => New_Occurrence_Of (Subp_Info_Array, Loc), + Attribute_Name => Name_Address)); -- Subp_Info_Len Append_To (Register_Pkg_Actuals, Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Subp_Info_Array, Loc), - Attribute_Name => - Name_Length)); + Prefix => New_Occurrence_Of (Subp_Info_Array, Loc), + Attribute_Name => Name_Length)); -- Generate the call @@ -4180,10 +4170,8 @@ package body Exp_Dist is Attribute_Name => Name_Write, Expressions => New_List ( Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Stream_Parameter, Loc), - Attribute_Name => - Name_Access), + Prefix => New_Occurrence_Of (Stream_Parameter, Loc), + Attribute_Name => Name_Access), Target_RPC_Receiver))); -- Then put the Subprogram_Id of the subprogram we want to call in @@ -4191,14 +4179,11 @@ package body Exp_Dist is Append_To (Statements, Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc), - Attribute_Name => - Name_Write, + Prefix => New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc), + Attribute_Name => Name_Write, Expressions => New_List ( Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Stream_Parameter, Loc), + Prefix => New_Occurrence_Of (Stream_Parameter, Loc), Attribute_Name => Name_Access), Subprogram_Id))); @@ -4214,7 +4199,7 @@ package body Exp_Dist is begin if Is_RACW_Controlling_Formal - (Current_Parameter, Stub_Type) + (Current_Parameter, Stub_Type) then -- In the case of a controlling formal argument, we marshall -- its addr field rather than the local stub. @@ -4230,8 +4215,9 @@ package body Exp_Dist is Etyp => RTE (RE_Unsigned_64))); else - Value := New_Occurrence_Of - (Defining_Identifier (Current_Parameter), Loc); + Value := + New_Occurrence_Of + (Defining_Identifier (Current_Parameter), Loc); -- Access type parameters are transmitted as in out -- parameters. However, a dereference is needed so that @@ -4255,8 +4241,7 @@ package body Exp_Dist is then Append_To (Statements, Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Etyp, Loc), + Prefix => New_Occurrence_Of (Etyp, Loc), Attribute_Name => Output_From_Constrained (Constrained), Expressions => New_List ( @@ -4302,13 +4287,12 @@ package body Exp_Dist is Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Standard_Boolean, Loc), - Attribute_Name => - Name_Write, + Attribute_Name => Name_Write, Expressions => New_List ( Make_Attribute_Reference (Loc, Prefix => - New_Occurrence_Of (Stream_Parameter, Loc), - Attribute_Name => + New_Occurrence_Of + (Stream_Parameter, Loc), Attribute_Name => Name_Access), New_Occurrence_Of (Extra_Parameter, Loc)))); end if; @@ -4334,8 +4318,7 @@ package body Exp_Dist is Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Stream_Parameter, Loc), - Attribute_Name => - Name_Access)))); + Attribute_Name => Name_Access)))); else Asynchronous_Statements := No_List; end if; @@ -4354,14 +4337,12 @@ package body Exp_Dist is Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Stream_Parameter, Loc), - Attribute_Name => - Name_Access), + Attribute_Name => Name_Access), Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Result_Parameter, Loc), - Attribute_Name => - Name_Access)))); + Attribute_Name => Name_Access)))); -- Read the exception occurrence from the result stream and -- reraise it. It does no harm if this is a Null_Occurrence since @@ -4372,15 +4353,13 @@ package body Exp_Dist is Prefix => New_Occurrence_Of (RTE (RE_Exception_Occurrence), Loc), - Attribute_Name => - Name_Read, + Attribute_Name => Name_Read, Expressions => New_List ( Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Result_Parameter, Loc), - Attribute_Name => - Name_Access), + Attribute_Name => Name_Access), New_Occurrence_Of (Exception_Return_Parameter, Loc)))); Append_To (Non_Asynchronous_Statements, @@ -4453,8 +4432,7 @@ package body Exp_Dist is Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Result_Parameter, Loc), - Attribute_Name => - Name_Access), + Attribute_Name => Name_Access), Value))); end if; end; @@ -4545,9 +4523,9 @@ package body Exp_Dist is New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc), Attribute_Name => Name_Input, Expressions => New_List ( - Make_Selected_Component (Loc, - Prefix => Request, - Selector_Name => Name_Params))))); + Make_Selected_Component (Loc, + Prefix => Request, + Selector_Name => Name_Params))))); Stmts := New_List; @@ -4785,9 +4763,9 @@ package body Exp_Dist is New_Occurrence_Of (RTE (RE_Exception_Occurrence), Loc), Attribute_Name => Name_Write, Expressions => New_List ( - Make_Selected_Component (Loc, - Prefix => Request_Parameter, - Selector_Name => Name_Result), + Make_Selected_Component (Loc, + Prefix => Request_Parameter, + Selector_Name => Name_Result), New_Occurrence_Of (RTE (RE_Null_Occurrence), Loc))); if Dynamically_Asynchronous then @@ -4870,15 +4848,19 @@ package body Exp_Dist is Append_To (Decls, Input_With_Tag_Check (Loc, Var_Type => Etyp, - Stream => Make_Selected_Component (Loc, - Prefix => Request_Parameter, - Selector_Name => Name_Params))); + Stream => + Make_Selected_Component (Loc, + Prefix => Request_Parameter, + Selector_Name => Name_Params))); -- Prepare function call expression - Expr := Make_Function_Call (Loc, - New_Occurrence_Of (Defining_Unit_Name - (Specification (Last (Decls))), Loc)); + Expr := + Make_Function_Call (Loc, + Name => + New_Occurrence_Of + (Defining_Unit_Name + (Specification (Last (Decls))), Loc)); end if; end if; @@ -5216,6 +5198,19 @@ package body Exp_Dist is return Body_Decls; end Get_And_Reset_RACW_Bodies; + ----------------------- + -- Get_Stub_Elements -- + ----------------------- + + function Get_Stub_Elements (RACW_Type : Entity_Id) return Stub_Structure is + Desig : constant Entity_Id := + Etype (Designated_Type (RACW_Type)); + Stub_Elements : constant Stub_Structure := Stubs_Table.Get (Desig); + begin + pragma Assert (Stub_Elements /= Empty_Stub_Structure); + return Stub_Elements; + end Get_Stub_Elements; + ----------------------- -- Get_Subprogram_Id -- ----------------------- @@ -5502,16 +5497,11 @@ package body Exp_Dist is procedure Add_RACW_From_Any (RACW_Type : Entity_Id; - Stub_Type : Entity_Id; - Stub_Type_Access : Entity_Id; Body_Decls : List_Id); -- Add the From_Any TSS for this RACW type procedure Add_RACW_To_Any - (Designated_Type : Entity_Id; - RACW_Type : Entity_Id; - Stub_Type : Entity_Id; - Stub_Type_Access : Entity_Id; + (RACW_Type : Entity_Id; Body_Decls : List_Id); -- Add the To_Any TSS for this RACW type @@ -5598,21 +5588,12 @@ package body Exp_Dist is begin Add_RACW_From_Any (RACW_Type => RACW_Type, - Stub_Type => Stub_Type, - Stub_Type_Access => Stub_Type_Access, Body_Decls => Body_Decls); Add_RACW_To_Any - (Designated_Type => Desig, - RACW_Type => RACW_Type, - Stub_Type => Stub_Type, - Stub_Type_Access => Stub_Type_Access, + (RACW_Type => RACW_Type, Body_Decls => Body_Decls); - -- In the PolyORB case, the RACW 'Read and 'Write attributes are - -- implemented in terms of the From_Any and To_Any TSSs, so these - -- TSSs must be expanded before 'Read and 'Write. - Add_RACW_Write_Attribute (RACW_Type => RACW_Type, Stub_Type => Stub_Type, @@ -5637,8 +5618,6 @@ package body Exp_Dist is procedure Add_RACW_From_Any (RACW_Type : Entity_Id; - Stub_Type : Entity_Id; - Stub_Type_Access : Entity_Id; Body_Decls : List_Id) is Loc : constant Source_Ptr := Sloc (RACW_Type); @@ -5652,28 +5631,12 @@ package body Exp_Dist is Func_Decl : Node_Id; Func_Body : Node_Id; - Decls : List_Id; Statements : List_Id; - Stub_Statements : List_Id; - Local_Statements : List_Id; -- Various parts of the subprogram Any_Parameter : constant Entity_Id := Make_Defining_Identifier (Loc, Name_A); - Reference : Entity_Id; - Is_Local : Entity_Id; - Addr : Entity_Id; - Local_Stub : Entity_Id; - Stubbed_Result : Entity_Id; - - Stub_Condition : Node_Id; - -- An expression that determines whether we create a stub for the - -- newly-unpacked RACW. Normally we create a stub only for remote - -- objects, but in the case of an RACW used to implement a RAS, we - -- also create a stub for local subprograms if a pragma - -- All_Calls_Remote applies. - Asynchronous_Flag : constant Entity_Id := Asynchronous_Flags_Table.Get (RACW_Type); -- The flag object declared in Add_RACW_Asynchronous_Flag @@ -5702,119 +5665,6 @@ package body Exp_Dist is return; end if; - -- Object declarations - - Reference := - Make_Defining_Identifier (Loc, New_Internal_Name ('R')); - Is_Local := - Make_Defining_Identifier (Loc, New_Internal_Name ('L')); - Addr := - Make_Defining_Identifier (Loc, New_Internal_Name ('A')); - Local_Stub := - Make_Defining_Identifier (Loc, New_Internal_Name ('L')); - Stubbed_Result := - Make_Defining_Identifier (Loc, New_Internal_Name ('S')); - - Decls := New_List ( - Make_Object_Declaration (Loc, - Defining_Identifier => - Reference, - Object_Definition => - New_Occurrence_Of (RTE (RE_Object_Ref), Loc), - Expression => - Make_Function_Call (Loc, - Name => - New_Occurrence_Of (RTE (RE_FA_ObjRef), Loc), - Parameter_Associations => New_List ( - New_Occurrence_Of (Any_Parameter, Loc)))), - - Make_Object_Declaration (Loc, - Defining_Identifier => Local_Stub, - Aliased_Present => True, - Object_Definition => New_Occurrence_Of (Stub_Type, Loc)), - - Make_Object_Declaration (Loc, - Defining_Identifier => Stubbed_Result, - Object_Definition => - New_Occurrence_Of (Stub_Type_Access, Loc), - Expression => - Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Local_Stub, Loc), - Attribute_Name => - Name_Unchecked_Access)), - - Make_Object_Declaration (Loc, - Defining_Identifier => Is_Local, - Object_Definition => - New_Occurrence_Of (Standard_Boolean, Loc)), - - Make_Object_Declaration (Loc, - Defining_Identifier => Addr, - Object_Definition => - New_Occurrence_Of (RTE (RE_Address), Loc))); - - -- Build_Get_Unique_RP_Call needs the type of Stubbed_Result - - Set_Etype (Stubbed_Result, Stub_Type_Access); - - -- If the ref Is_Nil, return a null pointer - - Statements := New_List ( - Make_Implicit_If_Statement (RACW_Type, - Condition => - Make_Function_Call (Loc, - Name => - New_Occurrence_Of (RTE (RE_Is_Nil), Loc), - Parameter_Associations => New_List ( - New_Occurrence_Of (Reference, Loc))), - Then_Statements => New_List ( - Make_Simple_Return_Statement (Loc, - Expression => - Make_Null (Loc))))); - - Append_To (Statements, - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Get_Local_Address), Loc), - Parameter_Associations => New_List ( - New_Occurrence_Of (Reference, Loc), - New_Occurrence_Of (Is_Local, Loc), - New_Occurrence_Of (Addr, Loc)))); - - -- If the object is located on another partition, then a stub object - -- will be created with all the information needed to rebuild the - -- real object at the other end. This stanza is always used in the - -- case of RAS types, for which a stub is required even for local - -- subprograms. - - Stub_Statements := New_List ( - Make_Assignment_Statement (Loc, - Name => Make_Selected_Component (Loc, - Prefix => Stubbed_Result, - Selector_Name => Name_Target), - Expression => - Make_Function_Call (Loc, - Name => - New_Occurrence_Of (RTE (RE_Entity_Of), Loc), - Parameter_Associations => New_List ( - New_Occurrence_Of (Reference, Loc)))), - - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Inc_Usage), Loc), - Parameter_Associations => New_List ( - Make_Selected_Component (Loc, - Prefix => Stubbed_Result, - Selector_Name => Name_Target))), - - Make_Assignment_Statement (Loc, - Name => Make_Selected_Component (Loc, - Prefix => Stubbed_Result, - Selector_Name => Name_Asynchronous), - Expression => - New_Occurrence_Of (Asynchronous_Flag, Loc))); - -- ??? Issue with asynchronous calls here: the Asynchronous flag is -- set on the stub type if, and only if, the RACW type has a pragma -- Asynchronous. This is incorrect for RACWs that implement RAS @@ -5825,52 +5675,24 @@ package body Exp_Dist is -- the Asynchronous component in the stub type in the RAS's _From_Any -- TSS. - Append_List_To (Stub_Statements, - Build_Get_Unique_RP_Call (Loc, Stubbed_Result, Stub_Type)); - - -- Distinguish between the local and remote cases, and execute the - -- appropriate piece of code. - - Stub_Condition := New_Occurrence_Of (Is_Local, Loc); - - if Is_RAS then - Stub_Condition := Make_And_Then (Loc, - Left_Opnd => - Stub_Condition, - Right_Opnd => - Make_Selected_Component (Loc, - Prefix => - Unchecked_Convert_To ( - RTE (RE_RAS_Proxy_Type_Access), - New_Occurrence_Of (Addr, Loc)), - Selector_Name => - Make_Identifier (Loc, - Name_All_Calls_Remote))); - end if; - - Local_Statements := New_List ( - Make_Simple_Return_Statement (Loc, - Expression => - Unchecked_Convert_To (RACW_Type, - New_Occurrence_Of (Addr, Loc)))); - - Append_To (Statements, - Make_Implicit_If_Statement (RACW_Type, - Condition => - Stub_Condition, - Then_Statements => Local_Statements, - Else_Statements => Stub_Statements)); - - Append_To (Statements, + Statements := New_List ( Make_Simple_Return_Statement (Loc, Expression => Unchecked_Convert_To (RACW_Type, - New_Occurrence_Of (Stubbed_Result, Loc)))); + Make_Function_Call (Loc, + Name => New_Occurrence_Of (RTE (RE_Get_RACW), Loc), + Parameter_Associations => New_List ( + Make_Function_Call (Loc, + Name => New_Occurrence_Of (RTE (RE_FA_ObjRef), Loc), + Parameter_Associations => New_List ( + New_Occurrence_Of (Any_Parameter, Loc))), + Build_Stub_Tag (Loc, RACW_Type), + New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc), + New_Occurrence_Of (Asynchronous_Flag, Loc)))))); Func_Body := Make_Subprogram_Body (Loc, - Specification => - Copy_Specification (Loc, Func_Spec), - Declarations => Decls, + Specification => Copy_Specification (Loc, Func_Spec), + Declarations => No_List, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Statements => Statements)); @@ -5898,21 +5720,24 @@ package body Exp_Dist is Body_Node : Node_Id; - Decls : List_Id; - Statements : constant List_Id := New_List; + Decls : constant List_Id := New_List; + Statements : constant List_Id := New_List; + Reference : constant Entity_Id := + Make_Defining_Identifier (Loc, Name_R); -- Various parts of the procedure - Pnam : constant Entity_Id := - Make_Defining_Identifier (Loc, - New_Internal_Name ('R')); + Pnam : constant Entity_Id := Make_Defining_Identifier (Loc, + New_Internal_Name ('R')); + + Is_RAS : constant Boolean := not Comes_From_Source (RACW_Type); - Source_Ref : Entity_Id; Asynchronous_Flag : constant Entity_Id := Asynchronous_Flags_Table.Get (RACW_Type); pragma Assert (Present (Asynchronous_Flag)); function Stream_Parameter return Node_Id; function Result return Node_Id; + -- Functions to create occurrences of the formal parameter names ------------ @@ -5957,15 +5782,11 @@ package body Exp_Dist is return; end if; - Source_Ref := Make_Defining_Identifier - (Loc, New_Internal_Name ('R')); - - -- Generate object declarations - - Decls := New_List ( + Append_To (Decls, Make_Object_Declaration (Loc, - Defining_Identifier => Source_Ref, - Object_Definition => + Defining_Identifier => + Reference, + Object_Definition => New_Occurrence_Of (RTE (RE_Object_Ref), Loc))); Append_List_To (Statements, New_List ( @@ -5975,19 +5796,21 @@ package body Exp_Dist is Attribute_Name => Name_Read, Expressions => New_List ( Stream_Parameter, - New_Occurrence_Of (Source_Ref, Loc))), + New_Occurrence_Of (Reference, Loc))), + Make_Assignment_Statement (Loc, - Name => + Name => Result, Expression => - PolyORB_Support.Helpers.Build_From_Any_Call ( - RACW_Type, + Unchecked_Convert_To (RACW_Type, Make_Function_Call (Loc, - Name => - New_Occurrence_Of (RTE (RE_TA_ObjRef), Loc), + Name => + New_Occurrence_Of (RTE (RE_Get_RACW), Loc), Parameter_Associations => New_List ( - New_Occurrence_Of (Source_Ref, Loc))), - Decls)))); + New_Occurrence_Of (Reference, Loc), + Build_Stub_Tag (Loc, RACW_Type), + New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc), + New_Occurrence_Of (Asynchronous_Flag, Loc))))))); Set_Declarations (Body_Node, Decls); Append_To (Body_Decls, Body_Node); @@ -5998,23 +5821,19 @@ package body Exp_Dist is --------------------- procedure Add_RACW_To_Any - (Designated_Type : Entity_Id; - RACW_Type : Entity_Id; - Stub_Type : Entity_Id; - Stub_Type_Access : Entity_Id; + (RACW_Type : Entity_Id; Body_Decls : List_Id) is Loc : constant Source_Ptr := Sloc (RACW_Type); - Is_RAS : constant Boolean := not Comes_From_Source (RACW_Type); - Fnam : constant Entity_Id := Make_Defining_Identifier (Loc, Chars => New_External_Name (Chars (RACW_Type), 'T')); + Is_RAS : constant Boolean := not Comes_From_Source (RACW_Type); + Stub_Elements : constant Stub_Structure := - Stubs_Table.Get (Designated_Type); - pragma Assert (Stub_Elements /= Empty_Stub_Structure); + Get_Stub_Elements (RACW_Type); Func_Spec : Node_Id; Func_Decl : Node_Id; @@ -6022,10 +5841,6 @@ package body Exp_Dist is Decls : List_Id; Statements : List_Id; - Null_Statements : List_Id; - Local_Statements : List_Id := No_List; - Stub_Statements : List_Id; - If_Node : Node_Id; -- Various parts of the subprogram RACW_Parameter : constant Entity_Id := @@ -6063,120 +5878,62 @@ package body Exp_Dist is return; end if; - -- Object declarations + -- Generate: + + -- R : constant Object_Ref := + -- Get_Reference + -- (Address!(RACW), + -- "typ", + -- Stub_Type'Tag, + -- Is_RAS, + -- RPC_Receiver'Access); + -- A : Any; Decls := New_List ( Make_Object_Declaration (Loc, - Defining_Identifier => - Reference, - Object_Definition => - New_Occurrence_Of (RTE (RE_Object_Ref), Loc)), - Make_Object_Declaration (Loc, - Defining_Identifier => - Any, - Object_Definition => - New_Occurrence_Of (RTE (RE_Any), Loc))); - - -- If the object is null, nothing to do (Reference is already - -- a Nil ref.) - - Null_Statements := New_List (Make_Null_Statement (Loc)); - - if Is_RAS then - - -- If the object is a RAS designating a local subprogram, we - -- already have a target reference. - - Local_Statements := New_List ( - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Set_Ref), Loc), - Parameter_Associations => New_List ( - New_Occurrence_Of (Reference, Loc), - Make_Selected_Component (Loc, - Prefix => - Unchecked_Convert_To (RTE (RE_RAS_Proxy_Type_Access), - New_Occurrence_Of (RACW_Parameter, Loc)), - Selector_Name => Make_Identifier (Loc, Name_Target))))); - - else - -- If the object is a local RACW object, use Get_Reference now to - -- obtain a reference. - - Local_Statements := New_List ( - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Get_Reference), Loc), - Parameter_Associations => New_List ( - Unchecked_Convert_To ( - RTE (RE_Address), - New_Occurrence_Of (RACW_Parameter, Loc)), - Make_String_Literal (Loc, - Full_Qualified_Name (Designated_Type)), - Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of ( - Defining_Identifier ( - Stub_Elements.RPC_Receiver_Decl), Loc), - Attribute_Name => - Name_Access), - New_Occurrence_Of (Reference, Loc)))); - end if; - - -- If the object is located on another partition, use the target from - -- the stub. + Defining_Identifier => Reference, + Constant_Present => True, + Object_Definition => + New_Occurrence_Of (RTE (RE_Object_Ref), Loc), + Expression => + Make_Function_Call (Loc, + Name => New_Occurrence_Of (RTE (RE_Get_Reference), Loc), + Parameter_Associations => New_List ( + Unchecked_Convert_To (RTE (RE_Address), + New_Occurrence_Of (RACW_Parameter, Loc)), + Make_String_Literal (Loc, + Strval => Full_Qualified_Name + (Etype (Designated_Type (RACW_Type)))), + Build_Stub_Tag (Loc, RACW_Type), + New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc), + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of + (Defining_Identifier + (Stub_Elements.RPC_Receiver_Decl), Loc), + Attribute_Name => Name_Access)))), - Stub_Statements := New_List ( - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Set_Ref), Loc), - Parameter_Associations => New_List ( - New_Occurrence_Of (Reference, Loc), - Make_Selected_Component (Loc, - Prefix => Unchecked_Convert_To (Stub_Type_Access, - New_Occurrence_Of (RACW_Parameter, Loc)), - Selector_Name => - Make_Identifier (Loc, Name_Target))))); + Make_Object_Declaration (Loc, + Defining_Identifier => Any, + Object_Definition => New_Occurrence_Of (RTE (RE_Any), Loc))); - -- Distinguish between the null, local and remote cases, and execute - -- the appropriate piece of code. + -- Generate: - If_Node := - Make_Implicit_If_Statement (RACW_Type, - Condition => - Make_Op_Eq (Loc, - Left_Opnd => New_Occurrence_Of (RACW_Parameter, Loc), - Right_Opnd => Make_Null (Loc)), - Then_Statements => Null_Statements, - Elsif_Parts => New_List ( - Make_Elsif_Part (Loc, - Condition => - Make_Op_Ne (Loc, - Left_Opnd => - Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (RACW_Parameter, Loc), - Attribute_Name => Name_Tag), - Right_Opnd => - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Stub_Type, Loc), - Attribute_Name => Name_Tag)), - Then_Statements => Local_Statements)), - Else_Statements => Stub_Statements); + -- Any := TA_ObjRef (Reference); + -- Set_TC (Any, RPC_Receiver.Obj_TypeCode); + -- return Any; Statements := New_List ( - If_Node, Make_Assignment_Statement (Loc, - Name => - New_Occurrence_Of (Any, Loc), + Name => New_Occurrence_Of (Any, Loc), Expression => Make_Function_Call (Loc, Name => New_Occurrence_Of (RTE (RE_TA_ObjRef), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Reference, Loc)))), + Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Set_TC), Loc), + Name => New_Occurrence_Of (RTE (RE_Set_TC), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Any, Loc), Make_Selected_Component (Loc, @@ -6184,14 +5941,13 @@ package body Exp_Dist is Defining_Identifier ( Stub_Elements.RPC_Receiver_Decl), Selector_Name => Name_Obj_TypeCode))), + Make_Simple_Return_Statement (Loc, - Expression => - New_Occurrence_Of (Any, Loc))); + Expression => New_Occurrence_Of (Any, Loc))); Func_Body := Make_Subprogram_Body (Loc, - Specification => - Copy_Specification (Loc, Func_Spec), + Specification => Copy_Specification (Loc, Func_Spec), Declarations => Decls, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, @@ -6229,9 +5985,8 @@ package body Exp_Dist is Func_Spec := Make_Function_Specification (Loc, - Defining_Unit_Name => - Fnam, - Result_Definition => New_Occurrence_Of (RTE (RE_TypeCode), Loc)); + Defining_Unit_Name => Fnam, + Result_Definition => New_Occurrence_Of (RTE (RE_TypeCode), Loc)); -- NOTE: The usage occurrences of RACW_Parameter must refer to the -- entity in the declaration spec, not those of the body spec. @@ -6246,8 +6001,7 @@ package body Exp_Dist is Func_Body := Make_Subprogram_Body (Loc, - Specification => - Copy_Specification (Loc, Func_Spec), + Specification => Copy_Specification (Loc, Func_Spec), Declarations => Empty_List, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, @@ -6256,8 +6010,8 @@ package body Exp_Dist is Expression => Make_Selected_Component (Loc, Prefix => - Defining_Identifier ( - Stub_Elements.RPC_Receiver_Decl), + Defining_Identifier + (Stub_Elements.RPC_Receiver_Decl), Selector_Name => Name_Obj_TypeCode))))); Append_To (Body_Decls, Func_Body); @@ -6279,11 +6033,16 @@ package body Exp_Dist is Loc : constant Source_Ptr := Sloc (RACW_Type); + Is_RAS : constant Boolean := not Comes_From_Source (RACW_Type); + + Stub_Elements : constant Stub_Structure := + Get_Stub_Elements (RACW_Type); + Body_Node : Node_Id; Proc_Decl : Node_Id; Attr_Decl : Node_Id; - Statements : constant List_Id := New_List; + Statements : constant List_Id := New_List; Pnam : constant Entity_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R')); @@ -6296,15 +6055,8 @@ package body Exp_Dist is ------------ function Object return Node_Id is - Object_Ref : constant Node_Id := - Make_Identifier (Loc, Name_V); - begin - -- Etype must be set for Build_To_Any_Call - - Set_Etype (Object_Ref, RACW_Type); - - return Object_Ref; + return Make_Identifier (Loc, Name_V); end Object; ---------------------- @@ -6346,11 +6098,21 @@ package body Exp_Dist is Stream => Stream_Parameter, Object => Make_Function_Call (Loc, - Name => - New_Occurrence_Of (RTE (RE_FA_ObjRef), Loc), + Name => New_Occurrence_Of (RTE (RE_Get_Reference), Loc), Parameter_Associations => New_List ( - PolyORB_Support.Helpers.Build_To_Any_Call - (Object, Body_Decls))), + Unchecked_Convert_To (RTE (RE_Address), Object), + Make_String_Literal (Loc, + Strval => Full_Qualified_Name + (Etype (Designated_Type (RACW_Type)))), + Build_Stub_Tag (Loc, RACW_Type), + New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc), + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of + (Defining_Identifier + (Stub_Elements.RPC_Receiver_Decl), Loc), + Attribute_Name => Name_Access))), + Etyp => RTE (RE_Object_Ref))); Append_To (Body_Decls, Body_Node); @@ -6388,13 +6150,10 @@ package body Exp_Dist is -- corresponding record type. RACW_Type : constant Entity_Id := - Underlying_RACW_Type (Ras_Type); - Desig : constant Entity_Id := - Etype (Designated_Type (RACW_Type)); + Underlying_RACW_Type (Ras_Type); Stub_Elements : constant Stub_Structure := - Stubs_Table.Get (Desig); - pragma Assert (Stub_Elements /= Empty_Stub_Structure); + Get_Stub_Elements (RACW_Type); Proc : constant Entity_Id := Make_Defining_Identifier (Loc, @@ -6506,8 +6265,7 @@ package body Exp_Dist is New_Occurrence_Of (Stub_Elements.Stub_Type, Loc)), Make_Object_Declaration (Loc, - Defining_Identifier => - Stub_Ptr, + Defining_Identifier => Stub_Ptr, Object_Definition => New_Occurrence_Of (Stub_Elements.Stub_Type_Access, Loc), Expression => @@ -6523,8 +6281,7 @@ package body Exp_Dist is Proc_Statements := New_List ( Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Get_RAS_Info), Loc), + Name => New_Occurrence_Of (RTE (RE_Get_RAS_Info), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Package_Name, Loc), New_Occurrence_Of (Subp_Id, Loc), @@ -6535,8 +6292,7 @@ package body Exp_Dist is -- obtain the local address of its proxy (A). Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Get_Local_Address), Loc), + Name => New_Occurrence_Of (RTE (RE_Get_Local_Address), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Subp_Ref, Loc), New_Occurrence_Of (Is_Local, Loc), @@ -6550,8 +6306,7 @@ package body Exp_Dist is -- if L then Make_Implicit_If_Statement (N, - Condition => - New_Occurrence_Of (Is_Local, Loc), + Condition => New_Occurrence_Of (Is_Local, Loc), Then_Statements => New_List ( @@ -6561,12 +6316,11 @@ package body Exp_Dist is Condition => Make_Op_Eq (Loc, Make_Selected_Component (Loc, - Prefix => - Unchecked_Convert_To ( - RTE (RE_RAS_Proxy_Type_Access), - New_Occurrence_Of (Local_Addr, Loc)), - Selector_Name => - Make_Identifier (Loc, Name_Target)), + Prefix => + Unchecked_Convert_To + (RTE (RE_RAS_Proxy_Type_Access), + New_Occurrence_Of (Local_Addr, Loc)), + Selector_Name => Make_Identifier (Loc, Name_Target)), Make_Null (Loc)), Then_Statements => New_List ( @@ -6576,32 +6330,29 @@ package body Exp_Dist is Make_Assignment_Statement (Loc, Name => Make_Selected_Component (Loc, - Prefix => - Unchecked_Convert_To ( - RTE (RE_RAS_Proxy_Type_Access), - New_Occurrence_Of (Local_Addr, Loc)), - Selector_Name => - Make_Identifier (Loc, Name_Target)), + Prefix => + Unchecked_Convert_To + (RTE (RE_RAS_Proxy_Type_Access), + New_Occurrence_Of (Local_Addr, Loc)), + Selector_Name => Make_Identifier (Loc, Name_Target)), Expression => Make_Function_Call (Loc, - Name => - New_Occurrence_Of (RTE (RE_Entity_Of), Loc), + Name => New_Occurrence_Of (RTE (RE_Entity_Of), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Subp_Ref, Loc)))), -- Inc_Usage (A.Target); Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Inc_Usage), Loc), + Name => New_Occurrence_Of (RTE (RE_Inc_Usage), Loc), Parameter_Associations => New_List ( Make_Selected_Component (Loc, Prefix => - Unchecked_Convert_To ( - RTE (RE_RAS_Proxy_Type_Access), - New_Occurrence_Of (Local_Addr, Loc)), - Selector_Name => Make_Identifier (Loc, - Name_Target)))))), + Unchecked_Convert_To + (RTE (RE_RAS_Proxy_Type_Access), + New_Occurrence_Of (Local_Addr, Loc)), + Selector_Name => + Make_Identifier (Loc, Name_Target)))))), -- end if; -- if not All_Calls_Remote then @@ -6611,12 +6362,14 @@ package body Exp_Dist is Make_Implicit_If_Statement (N, Condition => Make_Op_Not (Loc, - New_Occurrence_Of (All_Calls_Remote, Loc)), + Right_Opnd => + New_Occurrence_Of (All_Calls_Remote, Loc)), Then_Statements => New_List ( Make_Simple_Return_Statement (Loc, - Unchecked_Convert_To (Fat_Type, - New_Occurrence_Of (Local_Addr, Loc)))))))); + Expression => + Unchecked_Convert_To + (Fat_Type, New_Occurrence_Of (Local_Addr, Loc)))))))); Append_List_To (Proc_Statements, New_List ( @@ -6624,16 +6377,14 @@ package body Exp_Dist is Set_Field (Name_Target, Make_Function_Call (Loc, - Name => - New_Occurrence_Of (RTE (RE_Entity_Of), Loc), + Name => New_Occurrence_Of (RTE (RE_Entity_Of), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Subp_Ref, Loc)))), -- Inc_Usage (Stub.Target); Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Inc_Usage), Loc), + Name => New_Occurrence_Of (RTE (RE_Inc_Usage), Loc), Parameter_Associations => New_List ( Make_Selected_Component (Loc, Prefix => Stub_Ptr, @@ -6648,13 +6399,13 @@ package body Exp_Dist is Set_Field (Name_Asynchronous, Make_Or_Else (Loc, - New_Occurrence_Of (Asynch_P, Loc), - New_Occurrence_Of (Boolean_Literals ( - Is_Asynchronous (Ras_Type)), Loc))))); + Left_Opnd => New_Occurrence_Of (Asynch_P, Loc), + Right_Opnd => + New_Occurrence_Of + (Boolean_Literals (Is_Asynchronous (Ras_Type)), Loc))))); Append_List_To (Proc_Statements, - Build_Get_Unique_RP_Call (Loc, - Stub_Ptr, Stub_Elements.Stub_Type)); + Build_Get_Unique_RP_Call (Loc, Stub_Ptr, Stub_Elements.Stub_Type)); Append_To (Proc_Statements, Make_Simple_Return_Statement (Loc, @@ -6740,14 +6491,11 @@ package body Exp_Dist is Func_Spec := Make_Function_Specification (Loc, - Defining_Unit_Name => - Fnam, + Defining_Unit_Name => Fnam, Parameter_Specifications => New_List ( Make_Parameter_Specification (Loc, - Defining_Identifier => - Any_Parameter, - Parameter_Type => - New_Occurrence_Of (RTE (RE_Any), Loc))), + Defining_Identifier => Any_Parameter, + Parameter_Type => New_Occurrence_Of (RTE (RE_Any), Loc))), Result_Definition => New_Occurrence_Of (RAS_Type, Loc)); Discard_Node ( @@ -6792,36 +6540,30 @@ package body Exp_Dist is Set_Etype (RACW_Parameter, Underlying_RACW_Type (RAS_Type)); Decls := New_List ( Make_Object_Declaration (Loc, - Defining_Identifier => - Any, - Object_Definition => - New_Occurrence_Of (RTE (RE_Any), Loc), - Expression => + Defining_Identifier => Any, + Object_Definition => New_Occurrence_Of (RTE (RE_Any), Loc), + Expression => PolyORB_Support.Helpers.Build_To_Any_Call (RACW_Parameter, No_List))); Statements := New_List ( Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Set_TC), Loc), + Name => New_Occurrence_Of (RTE (RE_Set_TC), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Any, Loc), PolyORB_Support.Helpers.Build_TypeCode_Call (Loc, RAS_Type, Decls))), + Make_Simple_Return_Statement (Loc, - Expression => - New_Occurrence_Of (Any, Loc))); + Expression => New_Occurrence_Of (Any, Loc))); Func_Spec := Make_Function_Specification (Loc, - Defining_Unit_Name => - Fnam, + Defining_Unit_Name => Fnam, Parameter_Specifications => New_List ( Make_Parameter_Specification (Loc, - Defining_Identifier => - RAS_Parameter, - Parameter_Type => - New_Occurrence_Of (RAS_Type, Loc))), + Defining_Identifier => RAS_Parameter, + Parameter_Type => New_Occurrence_Of (RAS_Type, Loc))), Result_Definition => New_Occurrence_Of (RTE (RE_Any), Loc)); Discard_Node ( @@ -6844,17 +6586,16 @@ package body Exp_Dist is Fnam : constant Entity_Id := Make_Defining_Identifier (Loc, Make_TSS_Name (RAS_Type, TSS_TypeCode)); - Func_Spec : Node_Id; - - Decls : constant List_Id := New_List; - Name_String, Repo_Id_String : String_Id; + Func_Spec : Node_Id; + Decls : constant List_Id := New_List; + Name_String : String_Id; + Repo_Id_String : String_Id; begin Func_Spec := Make_Function_Specification (Loc, - Defining_Unit_Name => - Fnam, - Result_Definition => New_Occurrence_Of (RTE (RE_TypeCode), Loc)); + Defining_Unit_Name => Fnam, + Result_Definition => New_Occurrence_Of (RTE (RE_TypeCode), Loc)); PolyORB_Support.Helpers.Build_Name_And_Repository_Id (RAS_Type, Name_Str => Name_String, Repo_Id_Str => Repo_Id_String); @@ -6869,24 +6610,25 @@ package body Exp_Dist is Make_Simple_Return_Statement (Loc, Expression => Make_Function_Call (Loc, - Name => - New_Occurrence_Of (RTE (RE_TC_Build), Loc), + Name => New_Occurrence_Of (RTE (RE_TC_Build), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (RTE (RE_TC_Object), Loc), Make_Aggregate (Loc, Expressions => New_List ( Make_Function_Call (Loc, - Name => New_Occurrence_Of ( - RTE (RE_TA_String), Loc), + Name => + New_Occurrence_Of + (RTE (RE_TA_String), Loc), Parameter_Associations => New_List ( Make_String_Literal (Loc, Name_String))), Make_Function_Call (Loc, - Name => New_Occurrence_Of ( - RTE (RE_TA_String), Loc), + Name => + New_Occurrence_Of + (RTE (RE_TA_String), Loc), Parameter_Associations => New_List ( Make_String_Literal (Loc, - Repo_Id_String)))))))))))); + Strval => Repo_Id_String)))))))))))); Set_TSS (RAS_Type, Fnam); end Add_RAS_TypeCode; @@ -6905,14 +6647,14 @@ package body Exp_Dist is Make_Defining_Identifier (Loc, New_Internal_Name ('H')); Pkg_RPC_Receiver_Object : Node_Id; - Pkg_RPC_Receiver_Body : Node_Id; Pkg_RPC_Receiver_Decls : List_Id; Pkg_RPC_Receiver_Statements : List_Id; - Pkg_RPC_Receiver_Cases : constant List_Id := New_List; + + Pkg_RPC_Receiver_Cases : constant List_Id := New_List; -- A Pkg_RPC_Receiver is built to decode the request - Request : Node_Id; + Request : Node_Id; -- Request object received from neutral layer Subp_Id : Entity_Id; @@ -6920,16 +6662,19 @@ package body Exp_Dist is -- distribution core. Subp_Index : Entity_Id; - -- Internal index as determined by matching either the - -- method name from the request structure, or the local - -- subprogram address (in case of a RAS). + -- Internal index as determined by matching either the method name + -- from the request structure, or the local subprogram address (in + -- case of a RAS). Is_Local : constant Entity_Id := - Make_Defining_Identifier (Loc, New_Internal_Name ('L')); + Make_Defining_Identifier (Loc, + Chars => New_Internal_Name ('L')); + Local_Address : constant Entity_Id := - Make_Defining_Identifier (Loc, New_Internal_Name ('A')); - -- Address of a local subprogram designated by a - -- reference corresponding to a RAS. + Make_Defining_Identifier (Loc, + Chars => New_Internal_Name ('A')); + -- Address of a local subprogram designated by a reference + -- corresponding to a RAS. Dispatch_On_Address : constant List_Id := New_List; Dispatch_On_Name : constant List_Id := New_List; @@ -6984,8 +6729,8 @@ package body Exp_Dist is Defining_Entity (Stubs), Loc), Parameter_Associations => New_List (New_Occurrence_Of (Request, Loc)))); - if Nkind (Specification (Declaration)) - = N_Function_Specification + + if Nkind (Specification (Declaration)) = N_Function_Specification or else not Is_Asynchronous (Defining_Entity (Specification (Declaration))) then @@ -6996,8 +6741,7 @@ package body Exp_Dist is Make_Case_Statement_Alternative (Loc, Discrete_Choices => New_List (Make_Integer_Literal (Loc, Subp_Number)), - Statements => - Case_Stmts)); + Statements => Case_Stmts)); Append_To (Dispatch_On_Name, Make_Elsif_Part (Loc, @@ -7008,25 +6752,23 @@ package body Exp_Dist is Parameter_Associations => New_List ( New_Occurrence_Of (Subp_Id, Loc), New_Occurrence_Of (Subp_Dist_Name, Loc))), + Then_Statements => New_List ( Make_Assignment_Statement (Loc, New_Occurrence_Of (Subp_Index, Loc), - Make_Integer_Literal (Loc, - Subp_Number))))); + Make_Integer_Literal (Loc, Subp_Number))))); Append_To (Dispatch_On_Address, Make_Elsif_Part (Loc, Condition => Make_Op_Eq (Loc, - Left_Opnd => - New_Occurrence_Of (Local_Address, Loc), - Right_Opnd => - New_Occurrence_Of (Subp_Proxy_Addr, Loc)), + Left_Opnd => New_Occurrence_Of (Local_Address, Loc), + Right_Opnd => New_Occurrence_Of (Subp_Proxy_Addr, Loc)), + Then_Statements => New_List ( Make_Assignment_Statement (Loc, New_Occurrence_Of (Subp_Index, Loc), - Make_Integer_Literal (Loc, - Subp_Number))))); + Make_Integer_Literal (Loc, Subp_Number))))); end Append_Stubs_To; -- Start of processing for Add_Receiving_Stubs_To_Declarations @@ -7064,20 +6806,19 @@ package body Exp_Dist is Append_To (Pkg_RPC_Receiver_Decls, Make_Object_Declaration (Loc, - Defining_Identifier => - Is_Local, + Defining_Identifier => Is_Local, Object_Definition => New_Occurrence_Of (Standard_Boolean, Loc))); + Append_To (Pkg_RPC_Receiver_Decls, Make_Object_Declaration (Loc, - Defining_Identifier => - Local_Address, + Defining_Identifier => Local_Address, Object_Definition => New_Occurrence_Of (RTE (RE_Address), Loc))); + Append_To (Pkg_RPC_Receiver_Statements, Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Get_Local_Address), Loc), + Name => New_Occurrence_Of (RTE (RE_Get_Local_Address), Loc), Parameter_Associations => New_List ( Make_Selected_Component (Loc, Prefix => Request, @@ -7112,11 +6853,12 @@ package body Exp_Dist is Subp_Val : String_Id; Subp_Dist_Name : constant Entity_Id := - Make_Defining_Identifier (Loc, - New_External_Name ( - Related_Id => Chars (Subp_Def), - Suffix => 'D', - Suffix_Index => -1)); + Make_Defining_Identifier (Loc, + Chars => + New_External_Name + (Related_Id => Chars (Subp_Def), + Suffix => 'D', + Suffix_Index => -1)); Proxy_Object_Addr : Entity_Id; @@ -7137,29 +6879,26 @@ package body Exp_Dist is -- Build RAS proxy Add_RAS_Proxy_And_Analyze (Decls, - Vis_Decl => - Current_Declaration, - All_Calls_Remote_E => - All_Calls_Remote_E, - Proxy_Object_Addr => - Proxy_Object_Addr); + Vis_Decl => Current_Declaration, + All_Calls_Remote_E => All_Calls_Remote_E, + Proxy_Object_Addr => Proxy_Object_Addr); -- Compute distribution identifier - Assign_Subprogram_Identifier ( - Subp_Def, - Current_Subprogram_Number, - Subp_Val); + Assign_Subprogram_Identifier + (Subp_Def, + Current_Subprogram_Number, + Subp_Val); - pragma Assert (Current_Subprogram_Number = - Get_Subprogram_Id (Subp_Def)); + pragma Assert + (Current_Subprogram_Number = Get_Subprogram_Id (Subp_Def)); Append_To (Decls, Make_Object_Declaration (Loc, Defining_Identifier => Subp_Dist_Name, Constant_Present => True, - Object_Definition => New_Occurrence_Of ( - Standard_String, Loc), + Object_Definition => + New_Occurrence_Of (Standard_String, Loc), Expression => Make_String_Literal (Loc, Subp_Val))); Analyze (Last (Decls)); @@ -7172,21 +6911,21 @@ package body Exp_Dist is Append_To (Subp_Info_List, Make_Component_Association (Loc, Choices => New_List ( - Make_Integer_Literal (Loc, - Current_Subprogram_Number)), + Make_Integer_Literal (Loc, Current_Subprogram_Number)), + Expression => Make_Aggregate (Loc, Expressions => New_List ( Make_Attribute_Reference (Loc, Prefix => - New_Occurrence_Of ( - Subp_Dist_Name, Loc), + New_Occurrence_Of (Subp_Dist_Name, Loc), Attribute_Name => Name_Address), + Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of ( - Subp_Dist_Name, Loc), + Prefix => + New_Occurrence_Of (Subp_Dist_Name, Loc), Attribute_Name => Name_Length), + New_Occurrence_Of (Proxy_Object_Addr, Loc))))); Append_Stubs_To (Pkg_RPC_Receiver_Cases, @@ -7216,12 +6955,14 @@ package body Exp_Dist is Make_Index_Or_Discriminant_Constraint (Loc, New_List ( Make_Range (Loc, - Low_Bound => Make_Integer_Literal (Loc, - First_RCI_Subprogram_Id), + Low_Bound => + Make_Integer_Literal (Loc, + Intval => First_RCI_Subprogram_Id), High_Bound => Make_Integer_Literal (Loc, - First_RCI_Subprogram_Id - + List_Length (Subp_Info_List) - 1))))))); + Intval => + First_RCI_Subprogram_Id + + List_Length (Subp_Info_List) - 1))))))); if Present (First (Subp_Info_List)) then Set_Expression (Last (Decls), @@ -7247,27 +6988,22 @@ package body Exp_Dist is Make_Implicit_If_Statement (Pkg_Spec, Condition => Make_Op_Ne (Loc, - Left_Opnd => New_Occurrence_Of - (Local_Address, Loc), + Left_Opnd => New_Occurrence_Of (Local_Address, Loc), Right_Opnd => New_Occurrence_Of (RTE (RE_Null_Address), Loc)), + Then_Statements => New_List ( Make_Implicit_If_Statement (Pkg_Spec, - Condition => - New_Occurrence_Of (Standard_False, Loc), + Condition => New_Occurrence_Of (Standard_False, Loc), Then_Statements => New_List ( Make_Null_Statement (Loc)), - Elsif_Parts => - Dispatch_On_Address)), + Elsif_Parts => Dispatch_On_Address)), Else_Statements => New_List ( Make_Implicit_If_Statement (Pkg_Spec, - Condition => - New_Occurrence_Of (Standard_False, Loc), - Then_Statements => New_List ( - Make_Null_Statement (Loc)), - Elsif_Parts => - Dispatch_On_Name)))); + Condition => New_Occurrence_Of (Standard_False, Loc), + Then_Statements => New_List (Make_Null_Statement (Loc)), + Elsif_Parts => Dispatch_On_Name)))); else -- For a degenerate RCI with no visible subprograms, @@ -7295,15 +7031,12 @@ package body Exp_Dist is Append_To (Pkg_RPC_Receiver_Cases, Make_Case_Statement_Alternative (Loc, - Discrete_Choices => - New_List (Make_Others_Choice (Loc)), - Statements => - New_List (Make_Null_Statement (Loc)))); + Discrete_Choices => New_List (Make_Others_Choice (Loc)), + Statements => New_List (Make_Null_Statement (Loc)))); Append_To (Pkg_RPC_Receiver_Statements, Make_Case_Statement (Loc, - Expression => - New_Occurrence_Of (Subp_Index, Loc), + Expression => New_Occurrence_Of (Subp_Index, Loc), Alternatives => Pkg_RPC_Receiver_Cases)); -- Pkg_RPC_Receiver body is now complete: insert it into the tree and @@ -7317,70 +7050,71 @@ package body Exp_Dist is Defining_Identifier => Make_Defining_Identifier (Loc, New_Internal_Name ('R')), Aliased_Present => True, - Object_Definition => - New_Occurrence_Of (RTE (RE_Servant), Loc)); + Object_Definition => New_Occurrence_Of (RTE (RE_Servant), Loc)); Append_To (Decls, Pkg_RPC_Receiver_Object); Analyze (Last (Decls)); Get_Library_Unit_Name_String (Pkg_Spec); + + -- Name + Append_To (Register_Pkg_Actuals, - -- Name Make_String_Literal (Loc, Strval => String_From_Name_Buffer)); + -- Version + Append_To (Register_Pkg_Actuals, - -- Version Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Defining_Entity (Pkg_Spec), Loc), - Attribute_Name => - Name_Version)); + Attribute_Name => Name_Version)); + + -- Handler Append_To (Register_Pkg_Actuals, - -- Handler Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Pkg_RPC_Receiver, Loc), Attribute_Name => Name_Access)); + -- Receiver + Append_To (Register_Pkg_Actuals, - -- Receiver Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of ( - Defining_Identifier ( - Pkg_RPC_Receiver_Object), Loc), - Attribute_Name => - Name_Access)); + Defining_Identifier (Pkg_RPC_Receiver_Object), Loc), + Attribute_Name => Name_Access)); + + -- Subp_Info Append_To (Register_Pkg_Actuals, - -- Subp_Info Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Subp_Info_Array, Loc), - Attribute_Name => - Name_Address)); + Prefix => New_Occurrence_Of (Subp_Info_Array, Loc), + Attribute_Name => Name_Address)); + + -- Subp_Info_Len Append_To (Register_Pkg_Actuals, - -- Subp_Info_Len Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Subp_Info_Array, Loc), - Attribute_Name => - Name_Length)); + Prefix => New_Occurrence_Of (Subp_Info_Array, Loc), + Attribute_Name => Name_Length)); + + -- Is_All_Calls_Remote Append_To (Register_Pkg_Actuals, - -- Is_All_Calls_Remote New_Occurrence_Of (All_Calls_Remote_E, Loc)); + -- ??? + Append_To (Stmts, Make_Procedure_Call_Statement (Loc, Name => New_Occurrence_Of (RTE (RE_Register_Pkg_Receiving_Stub), Loc), Parameter_Associations => Register_Pkg_Actuals)); Analyze (Last (Stmts)); - end Add_Receiving_Stubs_To_Declarations; --------------------------------- @@ -7455,8 +7189,7 @@ package body Exp_Dist is begin -- ??? document general form of stub subprograms for the PolyORB case - Request := - Make_Defining_Identifier (Loc, New_Internal_Name ('R')); + Request := Make_Defining_Identifier (Loc, New_Internal_Name ('R')); Append_To (Decls, Make_Object_Declaration (Loc, @@ -7466,11 +7199,13 @@ package body Exp_Dist is New_Occurrence_Of (RTE (RE_Request_Access), Loc))); Result := - Make_Defining_Identifier (Loc, New_Internal_Name ('R')); + Make_Defining_Identifier (Loc, + Chars => New_Internal_Name ('R')); if Is_Function then - Result_TC := PolyORB_Support.Helpers.Build_TypeCode_Call (Loc, - Etype (Result_Definition (Spec)), Decls); + Result_TC := + PolyORB_Support.Helpers.Build_TypeCode_Call + (Loc, Etype (Result_Definition (Spec)), Decls); else Result_TC := New_Occurrence_Of (RTE (RE_TC_Void), Loc); end if; @@ -7485,8 +7220,7 @@ package body Exp_Dist is Make_Aggregate (Loc, Component_Associations => New_List ( Make_Component_Association (Loc, - Choices => New_List ( - Make_Identifier (Loc, Name_Name)), + Choices => New_List (Make_Identifier (Loc, Name_Name)), Expression => New_Occurrence_Of (RTE (RE_Result_Name), Loc)), Make_Component_Association (Loc, @@ -7494,15 +7228,12 @@ package body Exp_Dist is Make_Identifier (Loc, Name_Argument)), Expression => Make_Function_Call (Loc, - Name => - New_Occurrence_Of (RTE (RE_Create_Any), Loc), - Parameter_Associations => New_List ( - Result_TC))), + Name => New_Occurrence_Of (RTE (RE_Create_Any), Loc), + Parameter_Associations => New_List (Result_TC))), Make_Component_Association (Loc, - Choices => New_List ( + Choices => New_List ( Make_Identifier (Loc, Name_Arg_Modes)), - Expression => - Make_Integer_Literal (Loc, 0)))))); + Expression => Make_Integer_Literal (Loc, 0)))))); if not Is_Known_Asynchronous then Exception_Return_Parameter := @@ -7531,6 +7262,7 @@ package body Exp_Dist is Is_First_Controlling_Formal := not First_Controlling_Formal_Seen; First_Controlling_Formal_Seen := True; + else Is_Controlling_Formal := False; Is_First_Controlling_Formal := False; @@ -7538,8 +7270,7 @@ package body Exp_Dist is if Is_Controlling_Formal then - -- In the case of a controlling formal argument, we send its - -- reference. + -- For a controlling formal argument, we send its reference Etyp := RACW_Type; @@ -7547,11 +7278,10 @@ package body Exp_Dist is Etyp := Etype (Parameter_Type (Current_Parameter)); end if; - -- The first controlling formal parameter is treated specially: it - -- is used to set the target object of the call. + -- The first controlling formal parameter is treated specially: + -- it is used to set the target object of the call. if not Is_First_Controlling_Formal then - declare Constrained : constant Boolean := Is_Constrained (Etyp) @@ -7584,10 +7314,8 @@ package body Exp_Dist is else Actual_Parameter := OK_Convert_To (Etyp, Make_Attribute_Reference (Loc, - Prefix => - Actual_Parameter, - Attribute_Name => - Name_Unrestricted_Access)); + Prefix => Actual_Parameter, + Attribute_Name => Name_Unrestricted_Access)); end if; end if; @@ -7602,26 +7330,24 @@ package body Exp_Dist is -- parameter (always passed as a reference) other than -- the first one. - Expr := PolyORB_Support.Helpers.Build_To_Any_Call ( - Actual_Parameter, Decls); + Expr := PolyORB_Support.Helpers.Build_To_Any_Call + (Actual_Parameter, Decls); + else Expr := Make_Function_Call (Loc, - Name => - New_Occurrence_Of (RTE (RE_Create_Any), Loc), + Name => New_Occurrence_Of (RTE (RE_Create_Any), Loc), Parameter_Associations => New_List ( - PolyORB_Support.Helpers.Build_TypeCode_Call (Loc, - Etyp, Decls))); + PolyORB_Support.Helpers.Build_TypeCode_Call + (Loc, Etyp, Decls))); end if; Append_To (Decls, Make_Object_Declaration (Loc, - Defining_Identifier => - Any, + Defining_Identifier => Any, Aliased_Present => False, Object_Definition => New_Occurrence_Of (RTE (RE_Any), Loc), - Expression => - Expr)); + Expression => Expr)); Append_To (Statements, Add_Parameter_To_NVList (Loc, @@ -7639,10 +7365,10 @@ package body Exp_Dist is New_Occurrence_Of ( Defining_Identifier (Current_Parameter), Loc), Expression => - PolyORB_Support.Helpers.Build_From_Any_Call ( - Etype (Parameter_Type (Current_Parameter)), - New_Occurrence_Of (Any, Loc), - Decls))); + PolyORB_Support.Helpers.Build_From_Any_Call + (Etype (Parameter_Type (Current_Parameter)), + New_Occurrence_Of (Any, Loc), + Decls))); end if; end; @@ -7652,8 +7378,8 @@ package body Exp_Dist is -- this status is transmitted as well. -- This should be done for accessibility as well ??? - if Nkind (Parameter_Type (Current_Parameter)) - /= N_Access_Definition + if Nkind (Parameter_Type (Current_Parameter)) /= + N_Access_Definition and then Need_Extra_Constrained (Current_Parameter) then -- In this block, we do not use the extra formal that has been @@ -7664,28 +7390,27 @@ package body Exp_Dist is declare Extra_Any_Parameter : constant Entity_Id := - Make_Defining_Identifier - (Loc, New_Internal_Name ('P')); + Make_Defining_Identifier + (Loc, New_Internal_Name ('P')); Parameter_Exp : constant Node_Id := Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of ( Defining_Identifier (Current_Parameter), Loc), Attribute_Name => Name_Constrained); + begin Set_Etype (Parameter_Exp, Etype (Standard_Boolean)); Append_To (Decls, Make_Object_Declaration (Loc, - Defining_Identifier => - Extra_Any_Parameter, + Defining_Identifier => Extra_Any_Parameter, Aliased_Present => False, Object_Definition => New_Occurrence_Of (RTE (RE_Any), Loc), Expression => - PolyORB_Support.Helpers.Build_To_Any_Call ( - Parameter_Exp, - Decls))); + PolyORB_Support.Helpers.Build_To_Any_Call + (Parameter_Exp, Decls))); Append_To (Extra_Formal_Statements, Add_Parameter_To_NVList (Loc, @@ -7707,6 +7432,7 @@ package body Exp_Dist is Make_Procedure_Call_Statement (Loc, Name => New_Occurrence_Of (RTE (RE_Request_Create), Loc), + Parameter_Associations => New_List ( Target_Object, Subprogram_Id, @@ -7717,14 +7443,18 @@ package body Exp_Dist is Append_To (Parameter_Associations (Last (Statements)), New_Occurrence_Of (Request, Loc)); - pragma Assert ( - not (Is_Known_Non_Asynchronous and Is_Known_Asynchronous)); + pragma Assert + (not (Is_Known_Non_Asynchronous and Is_Known_Asynchronous)); + if Is_Known_Non_Asynchronous or Is_Known_Asynchronous then - Asynchronous_P := New_Occurrence_Of ( - Boolean_Literals (Is_Known_Asynchronous), Loc); + Asynchronous_P := + New_Occurrence_Of + (Boolean_Literals (Is_Known_Asynchronous), Loc); + else pragma Assert (Present (Asynchronous)); Asynchronous_P := New_Copy_Tree (Asynchronous); + -- The expression node Asynchronous will be used to build an 'if' -- statement at the end of Build_General_Calling_Stubs: we need to -- make a copy here. @@ -7766,17 +7496,16 @@ package body Exp_Dist is Append_To (Non_Asynchronous_Statements, Make_Tag_Check (Loc, Make_Simple_Return_Statement (Loc, - PolyORB_Support.Helpers.Build_From_Any_Call ( - Etype (Result_Definition (Spec)), - Make_Selected_Component (Loc, - Prefix => Result, - Selector_Name => Name_Argument), - Decls)))); + PolyORB_Support.Helpers.Build_From_Any_Call + (Etype (Result_Definition (Spec)), + Make_Selected_Component (Loc, + Prefix => Result, + Selector_Name => Name_Argument), + Decls)))); end if; end if; - Append_List_To (Non_Asynchronous_Statements, - After_Statements); + Append_List_To (Non_Asynchronous_Statements, After_Statements); if Is_Known_Asynchronous then Append_List_To (Statements, Asynchronous_Statements); @@ -7813,8 +7542,10 @@ package body Exp_Dist is Append_To (Decls, Make_Object_Declaration (Loc, Defining_Identifier => Target_Reference, + Object_Definition => New_Occurrence_Of (RTE (RE_Object_Ref), Loc), + Expression => Make_Function_Call (Loc, Name => @@ -7823,7 +7554,8 @@ package body Exp_Dist is Make_Selected_Component (Loc, Prefix => Controlling_Parameter, Selector_Name => Name_Target))))); - -- Controlling_Parameter has the same components as + + -- Note: Controlling_Parameter has the same components as -- System.Partition_Interface.RACW_Stub_Type. Target_Info.Object := New_Occurrence_Of (Target_Reference, Loc); @@ -7831,11 +7563,11 @@ package body Exp_Dist is else Target_Info.Object := Make_Selected_Component (Loc, - Prefix => - Make_Identifier (Loc, Chars (RCI_Locator)), + Prefix => Make_Identifier (Loc, Chars (RCI_Locator)), Selector_Name => Make_Identifier (Loc, Name_Get_RCI_Package_Ref)); end if; + return Target_Info; end Build_Stub_Target; @@ -7871,20 +7603,19 @@ package body Exp_Dist is Make_Defining_Identifier (Loc, Name_Target), Component_Definition => Make_Component_Definition (Loc, - Aliased_Present => - False, + Aliased_Present => False, Subtype_Indication => New_Occurrence_Of (RTE (RE_Entity_Ptr), Loc))), Make_Component_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Name_Asynchronous), + Component_Definition => Make_Component_Definition (Loc, Aliased_Present => False, Subtype_Indication => - New_Occurrence_Of ( - Standard_Boolean, Loc))))))); + New_Occurrence_Of (Standard_Boolean, Loc))))))); RPC_Receiver_Decl := Make_Object_Declaration (Loc, @@ -8032,8 +7763,8 @@ package body Exp_Dist is New_Occurrence_Of (Parent_Primitive, Loc); else Called_Subprogram := - New_Occurrence_Of ( - Defining_Unit_Name (Specification (Vis_Decl)), Loc); + New_Occurrence_Of + (Defining_Unit_Name (Specification (Vis_Decl)), Loc); end if; Declare_Create_NVList (Loc, Arguments, Outer_Decls, Outer_Statements); @@ -8050,11 +7781,12 @@ package body Exp_Dist is Any : Entity_Id := Empty; Object : constant Entity_Id := Make_Defining_Identifier (Loc, - New_Internal_Name ('P')); + Chars => New_Internal_Name ('P')); Expr : Node_Id := Empty; - Is_Controlling_Formal : constant Boolean - := Is_RACW_Controlling_Formal (Current_Parameter, Stub_Type); + Is_Controlling_Formal : constant Boolean := + Is_RACW_Controlling_Formal + (Current_Parameter, Stub_Type); Is_First_Controlling_Formal : Boolean := False; @@ -8075,30 +7807,30 @@ package body Exp_Dist is Is_First_Controlling_Formal := not First_Controlling_Formal_Seen; First_Controlling_Formal_Seen := True; + else Etyp := Etype (Parameter_Type (Current_Parameter)); end if; Constrained := - Is_Constrained (Etyp) - or else Is_Elementary_Type (Etyp); + Is_Constrained (Etyp) or else Is_Elementary_Type (Etyp); if not Is_First_Controlling_Formal then - Any := Make_Defining_Identifier (Loc, - New_Internal_Name ('A')); + Any := + Make_Defining_Identifier (Loc, + Chars => New_Internal_Name ('A')); + Append_To (Outer_Decls, Make_Object_Declaration (Loc, - Defining_Identifier => - Any, + Defining_Identifier => Any, Object_Definition => New_Occurrence_Of (RTE (RE_Any), Loc), Expression => Make_Function_Call (Loc, - Name => - New_Occurrence_Of (RTE (RE_Create_Any), Loc), + Name => New_Occurrence_Of (RTE (RE_Create_Any), Loc), Parameter_Associations => New_List ( - PolyORB_Support.Helpers.Build_TypeCode_Call (Loc, - Etyp, Outer_Decls))))); + PolyORB_Support.Helpers.Build_TypeCode_Call + (Loc, Etyp, Outer_Decls))))); Append_To (Outer_Statements, Add_Parameter_To_NVList (Loc, @@ -8111,34 +7843,34 @@ package body Exp_Dist is if Is_First_Controlling_Formal then declare Addr : constant Entity_Id := - Make_Defining_Identifier (Loc, - New_Internal_Name ('A')); + Make_Defining_Identifier (Loc, + Chars => New_Internal_Name ('A')); + Is_Local : constant Entity_Id := - Make_Defining_Identifier (Loc, - New_Internal_Name ('L')); - begin + Make_Defining_Identifier (Loc, + Chars => New_Internal_Name ('L')); + begin -- Special case: obtain the first controlling formal -- from the target of the remote call, instead of the -- argument list. Append_To (Outer_Decls, Make_Object_Declaration (Loc, - Defining_Identifier => - Addr, + Defining_Identifier => Addr, Object_Definition => New_Occurrence_Of (RTE (RE_Address), Loc))); + Append_To (Outer_Decls, Make_Object_Declaration (Loc, - Defining_Identifier => - Is_Local, + Defining_Identifier => Is_Local, Object_Definition => New_Occurrence_Of (Standard_Boolean, Loc))); + Append_To (Outer_Statements, Make_Procedure_Call_Statement (Loc, Name => - New_Occurrence_Of ( - RTE (RE_Get_Local_Address), Loc), + New_Occurrence_Of (RTE (RE_Get_Local_Address), Loc), Parameter_Associations => New_List ( Make_Selected_Component (Loc, Prefix => @@ -8169,13 +7901,12 @@ package body Exp_Dist is if Constrained then Append_To (Statements, Make_Assignment_Statement (Loc, - Name => - New_Occurrence_Of (Object, Loc), - Expression => - Expr)); + Name => New_Occurrence_Of (Object, Loc), + Expression => Expr)); Expr := Empty; else null; + -- Expr will be used to initialize (and constrain) the -- parameter when it is declared. end if; @@ -8216,13 +7947,11 @@ package body Exp_Dist is then Append_To (After_Statements, Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Move_Any_Value), Loc), + Name => New_Occurrence_Of (RTE (RE_Move_Any_Value), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Any, Loc), - PolyORB_Support.Helpers.Build_To_Any_Call ( - New_Occurrence_Of (Object, Loc), - Decls)))); + PolyORB_Support.Helpers.Build_To_Any_Call + (New_Occurrence_Of (Object, Loc), Decls)))); end if; -- For RACW controlling formals, the Etyp of Object is always @@ -8231,25 +7960,27 @@ package body Exp_Dist is if Is_Controlling_Formal then if Nkind (Parameter_Type (Current_Parameter)) /= - N_Access_Definition + N_Access_Definition then Append_To (Parameter_List, Make_Parameter_Association (Loc, Selector_Name => - New_Occurrence_Of ( - Defining_Identifier (Current_Parameter), Loc), + New_Occurrence_Of + (Defining_Identifier (Current_Parameter), Loc), Explicit_Actual_Parameter => Make_Explicit_Dereference (Loc, - Unchecked_Convert_To (RACW_Type, - OK_Convert_To (RTE (RE_Address), - New_Occurrence_Of (Object, Loc)))))); + Prefix => + Unchecked_Convert_To (RACW_Type, + OK_Convert_To (RTE (RE_Address), + New_Occurrence_Of (Object, Loc)))))); else Append_To (Parameter_List, Make_Parameter_Association (Loc, Selector_Name => - New_Occurrence_Of ( - Defining_Identifier (Current_Parameter), Loc), + New_Occurrence_Of + (Defining_Identifier (Current_Parameter), Loc), + Explicit_Actual_Parameter => Unchecked_Convert_To (RACW_Type, OK_Convert_To (RTE (RE_Address), @@ -8280,21 +8011,22 @@ package body Exp_Dist is Extra_Constrained (Defining_Identifier (Current_Parameter)); + Extra_Any : constant Entity_Id := - Make_Defining_Identifier - (Loc, New_Internal_Name ('A')); + Make_Defining_Identifier (Loc, + Chars => New_Internal_Name ('A')); Formal_Entity : constant Entity_Id := - Make_Defining_Identifier - (Loc, Chars (Extra_Parameter)); + Make_Defining_Identifier (Loc, + Chars => Chars (Extra_Parameter)); Formal_Type : constant Entity_Id := Etype (Extra_Parameter); + begin Append_To (Outer_Decls, Make_Object_Declaration (Loc, - Defining_Identifier => - Extra_Any, + Defining_Identifier => Extra_Any, Object_Definition => New_Occurrence_Of (RTE (RE_Any), Loc), Expression => @@ -8320,13 +8052,12 @@ package body Exp_Dist is Append_To (Statements, Make_Assignment_Statement (Loc, - Name => - New_Occurrence_Of (Formal_Entity, Loc), + Name => New_Occurrence_Of (Formal_Entity, Loc), Expression => - PolyORB_Support.Helpers.Build_From_Any_Call ( - Formal_Type, - New_Occurrence_Of (Extra_Any, Loc), - Decls))); + PolyORB_Support.Helpers.Build_From_Any_Call + (Formal_Type, + New_Occurrence_Of (Extra_Any, Loc), + Decls))); Set_Extra_Constrained (Object, Formal_Entity); end; end if; @@ -8341,24 +8072,23 @@ package body Exp_Dist is Append_To (Outer_Statements, Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Request_Arguments), Loc), + Name => New_Occurrence_Of (RTE (RE_Request_Arguments), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Request_Parameter, Loc), New_Occurrence_Of (Arguments, Loc)))); if Nkind (Specification (Vis_Decl)) = N_Function_Specification then - -- The remote subprogram is a function. We build an inner block to - -- be able to hold a potentially unconstrained result in a - -- variable. + -- The remote subprogram is a function: Build an inner block to be + -- able to hold a potentially unconstrained result in a variable. declare Etyp : constant Entity_Id := Etype (Result_Definition (Specification (Vis_Decl))); Result : constant Node_Id := Make_Defining_Identifier (Loc, - New_Internal_Name ('R')); + Chars => New_Internal_Name ('R')); + begin Inner_Decls := New_List ( Make_Object_Declaration (Loc, @@ -8374,7 +8104,7 @@ package body Exp_Dist is -- For a remote call to a function with a class-wide type, -- check that the returned value satisfies the requirements - -- of E.4(18). + -- of (RM E.4(18)). Append_To (Inner_Decls, Make_Transportable_Check (Loc, @@ -8385,13 +8115,12 @@ package body Exp_Dist is Set_Etype (Result, Etyp); Append_To (After_Statements, Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Set_Result), Loc), + Name => New_Occurrence_Of (RTE (RE_Set_Result), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Request_Parameter, Loc), - PolyORB_Support.Helpers.Build_To_Any_Call ( - New_Occurrence_Of (Result, Loc), - Decls)))); + PolyORB_Support.Helpers.Build_To_Any_Call + (New_Occurrence_Of (Result, Loc), Decls)))); + -- A DSA function does not have out or inout arguments end; @@ -8412,8 +8141,7 @@ package body Exp_Dist is Append_To (After_Statements, Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Request_Set_Out), Loc), + Name => New_Occurrence_Of (RTE (RE_Request_Set_Out), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Request_Parameter, Loc)))); @@ -8451,7 +8179,6 @@ package body Exp_Dist is Statements => New_List (Make_Null_Statement (Loc)))); else - -- In the other cases, if an exception is raised, then the -- exception occurrence is propagated. @@ -8460,8 +8187,7 @@ package body Exp_Dist is Append_To (Outer_Statements, Make_Block_Statement (Loc, - Declarations => - Decls, + Declarations => Decls, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Statements => Statements))); @@ -8622,8 +8348,8 @@ package body Exp_Dist is Fnam : Entity_Id := Empty; Lib_RE : RE_Id := RE_Null; Result : Node_Id; - begin + begin -- First simple case where the From_Any function is present -- in the type's TSS. @@ -8761,24 +8487,22 @@ package body Exp_Dist is if Is_Itype (Typ) then Build_From_Any_Function (Loc => Loc, - Typ => Etype (Typ), - Decl => Decl, - Fnam => Fnam); + Typ => Etype (Typ), + Decl => Decl, + Fnam => Fnam); return; end if; - Fnam := Make_Stream_Procedure_Function_Name (Loc, - Typ, Name_uFrom_Any); + Fnam := + Make_Stream_Procedure_Function_Name (Loc, Typ, Name_uFrom_Any); Spec := Make_Function_Specification (Loc, Defining_Unit_Name => Fnam, Parameter_Specifications => New_List ( Make_Parameter_Specification (Loc, - Defining_Identifier => - Any_Parameter, - Parameter_Type => - New_Occurrence_Of (RTE (RE_Any), Loc))), + Defining_Identifier => Any_Parameter, + Parameter_Type => New_Occurrence_Of (RTE (RE_Any), Loc))), Result_Definition => New_Occurrence_Of (Typ, Loc)); -- The following is taken care of by Exp_Dist.Add_RACW_From_Any @@ -8790,7 +8514,7 @@ package body Exp_Dist is if Has_Stream_Attribute_Definition (Typ, TSS_Stream_Output, At_Any_Place => True) - or else + or else Has_Stream_Attribute_Definition (Typ, TSS_Stream_Write, At_Any_Place => True) then @@ -8804,12 +8528,11 @@ package body Exp_Dist is Append_To (Stms, Make_Simple_Return_Statement (Loc, Expression => - OK_Convert_To ( - Typ, - Build_From_Any_Call ( - Root_Type (Typ), - New_Occurrence_Of (Any_Parameter, Loc), - Decls)))); + OK_Convert_To (Typ, + Build_From_Any_Call + (Root_Type (Typ), + New_Occurrence_Of (Any_Parameter, Loc), + Decls)))); elsif Is_Record_Type (Typ) and then not Is_Derived_Type (Typ) @@ -8819,19 +8542,20 @@ package body Exp_Dist is Append_To (Stms, Make_Simple_Return_Statement (Loc, Expression => - OK_Convert_To ( - Typ, - Build_From_Any_Call ( - Etype (Typ), - New_Occurrence_Of (Any_Parameter, Loc), - Decls)))); + OK_Convert_To (Typ, + Build_From_Any_Call + (Etype (Typ), + New_Occurrence_Of (Any_Parameter, Loc), + Decls)))); + else declare - Disc : Entity_Id := Empty; + Disc : Entity_Id := Empty; Discriminant_Associations : List_Id; - Rdef : constant Node_Id := - Type_Definition (Declaration_Node (Typ)); - Component_Counter : Int := 0; + Rdef : constant Node_Id := + Type_Definition + (Declaration_Node (Typ)); + Component_Counter : Int := 0; -- The returned object @@ -8850,8 +8574,8 @@ package body Exp_Dist is procedure FA_Append_Record_Traversal is new Append_Record_Traversal - (Rec => Res, - Add_Process_Element => FA_Rec_Add_Process_Element); + (Rec => Res, + Add_Process_Element => FA_Rec_Add_Process_Element); -------------------------------- -- FA_Rec_Add_Process_Element -- @@ -8890,7 +8614,7 @@ package body Exp_Dist is -- A variant part declare - Variant : Node_Id; + Variant : Node_Id; Struct_Counter : Int := 0; Block_Decls : constant List_Id := New_List; @@ -8907,16 +8631,16 @@ package body Exp_Dist is begin Append_To (Decls, Make_Object_Declaration (Loc, - Defining_Identifier => - Struct_Any, - Constant_Present => - True, - Object_Definition => + Defining_Identifier => Struct_Any, + Constant_Present => True, + Object_Definition => New_Occurrence_Of (RTE (RE_Any), Loc), - Expression => + Expression => Make_Function_Call (Loc, - Name => New_Occurrence_Of ( - RTE (RE_Extract_Union_Value), Loc), + Name => + New_Occurrence_Of + (RTE (RE_Extract_Union_Value), Loc), + Parameter_Associations => New_List ( Build_Get_Aggregate_Element (Loc, Any => Any, @@ -8935,8 +8659,7 @@ package body Exp_Dist is Append_To (Stmts, Make_Block_Statement (Loc, - Declarations => - Block_Decls, + Declarations => Block_Decls, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Statements => Block_Stmts))); @@ -8946,15 +8669,14 @@ package body Exp_Dist is Expression => Make_Selected_Component (Loc, Prefix => Rec, - Selector_Name => - Chars (Name (Field))), - Alternatives => - Alt_List)); + Selector_Name => Chars (Name (Field))), + Alternatives => Alt_List)); Variant := First_Non_Pragma (Variants (Field)); while Present (Variant) loop - Choice_List := New_Copy_List_Tree - (Discrete_Choices (Variant)); + Choice_List := + New_Copy_List_Tree + (Discrete_Choices (Variant)); VP_Stmts := New_List; @@ -8975,12 +8697,12 @@ package body Exp_Dist is Append_To (Alt_List, Make_Case_Statement_Alternative (Loc, Discrete_Choices => Choice_List, - Statements => - VP_Stmts)); + Statements => VP_Stmts)); Next_Non_Pragma (Variant); end loop; end; end if; + Counter := Counter + 1; end FA_Rec_Add_Process_Element; @@ -9002,11 +8724,11 @@ package body Exp_Dist is begin Append_To (Decls, Make_Object_Declaration (Loc, - Defining_Identifier => - Disc_Var_Name, - Constant_Present => True, - Object_Definition => + Defining_Identifier => Disc_Var_Name, + Constant_Present => True, + Object_Definition => New_Occurrence_Of (Disc_Type, Loc), + Expression => Build_From_Any_Call (Disc_Type, Build_Get_Aggregate_Element (Loc, @@ -9016,6 +8738,7 @@ package body Exp_Dist is Idx => Make_Integer_Literal (Loc, Intval => Component_Counter)), Decls))); + Component_Counter := Component_Counter + 1; Append_To (Discriminant_Associations, @@ -9045,10 +8768,8 @@ package body Exp_Dist is Append_To (Decls, Make_Object_Declaration (Loc, - Defining_Identifier => - Res, - Object_Definition => - Res_Definition)); + Defining_Identifier => Res, + Object_Definition => Res_Definition)); -- ... then all components @@ -9105,6 +8826,7 @@ package body Exp_Dist is -- sufficient to determine the typecode of Datum -- (which can be a TC_SEQUENCE or TC_ARRAY -- depending on the value of Constrained). + -- Therefore we retrieve the typecode which has -- been constructed in Append_Array_Traversal with -- a call to Get_Any_Type. @@ -9139,10 +8861,8 @@ package body Exp_Dist is New_Occurrence_Of (Counter, Loc), Expression => Make_Op_Add (Loc, - Left_Opnd => - New_Occurrence_Of (Counter, Loc), - Right_Opnd => - Make_Integer_Literal (Loc, 1)))); + Left_Opnd => New_Occurrence_Of (Counter, Loc), + Right_Opnd => Make_Integer_Literal (Loc, 1)))); if Nkind (Datum) /= N_Attribute_Reference then @@ -9152,10 +8872,8 @@ package body Exp_Dist is if Etype (Datum) /= RTE (RE_Any) then Set_Expression (Assignment, - Build_From_Any_Call ( - Component_Type (Typ), - Element_Any, - Decls)); + Build_From_Any_Call + (Component_Type (Typ), Element_Any, Decls)); else Set_Expression (Assignment, Element_Any); end if; @@ -9210,32 +8928,36 @@ package body Exp_Dist is Make_Object_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Lnam), - Constant_Present => - True, + Constant_Present => True, Object_Definition => New_Occurrence_Of (Indt, Loc), Expression => - Build_From_Any_Call ( - Indt, - Build_Get_Aggregate_Element (Loc, - Any => Any_Parameter, - TC => Build_TypeCode_Call (Loc, - Indt, Decls), - Idx => Make_Integer_Literal (Loc, J - 1)), + Build_From_Any_Call + (Indt, + Build_Get_Aggregate_Element (Loc, + Any => Any_Parameter, + TC => Build_TypeCode_Call + (Loc, Indt, Decls), + Idx => + Make_Integer_Literal (Loc, J - 1)), Decls))); Append_To (Decls, Make_Object_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Hnam), - Constant_Present => - True, + + Constant_Present => True, + Object_Definition => New_Occurrence_Of (Indt, Loc), + Expression => Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Indt, Loc), + Attribute_Name => Name_Val, + Expressions => New_List ( Make_Op_Subtract (Loc, Left_Opnd => @@ -9244,6 +8966,7 @@ package body Exp_Dist is OK_Convert_To ( Standard_Long_Integer, Make_Identifier (Loc, Lnam)), + Right_Opnd => OK_Convert_To ( Standard_Long_Integer, @@ -9257,7 +8980,8 @@ package body Exp_Dist is New_Occurrence_Of ( Any_Parameter, Loc), Make_Integer_Literal (Loc, - J))))), + Intval => J))))), + Right_Opnd => Make_Integer_Literal (Loc, 1)))))); @@ -9275,8 +8999,7 @@ package body Exp_Dist is Initial_Counter_Value := Ndim; Res_Subtype_Indication := Make_Subtype_Indication (Loc, - Subtype_Mark => - Res_Subtype_Indication, + Subtype_Mark => Res_Subtype_Indication, Constraint => Make_Index_Or_Discriminant_Constraint (Loc, Constraints => Ranges)); @@ -9300,15 +9023,15 @@ package body Exp_Dist is Append_To (Decls, Make_Object_Declaration (Loc, Defining_Identifier => Component_TC, - Constant_Present => True, - Object_Definition => + Constant_Present => True, + Object_Definition => New_Occurrence_Of (RTE (RE_TypeCode), Loc), - Expression => + Expression => Build_TypeCode_Call (Loc, Component_Type (Typ), Decls))); - Append_From_Any_Array_Iterator (Stms, - Any_Parameter, Counter); + Append_From_Any_Array_Iterator + (Stms, Any_Parameter, Counter); Append_To (Stms, Make_Simple_Return_Statement (Loc, @@ -9319,12 +9042,11 @@ package body Exp_Dist is Append_To (Stms, Make_Simple_Return_Statement (Loc, Expression => - Unchecked_Convert_To ( - Typ, - Build_From_Any_Call ( - Find_Numeric_Representation (Typ), - New_Occurrence_Of (Any_Parameter, Loc), - Decls)))); + Unchecked_Convert_To (Typ, + Build_From_Any_Call + (Find_Numeric_Representation (Typ), + New_Occurrence_Of (Any_Parameter, Loc), + Decls)))); else Use_Opaque_Representation := True; @@ -9347,10 +9069,8 @@ package body Exp_Dist is Append_To (Decls, Make_Object_Declaration (Loc, - Defining_Identifier => - Strm, - Aliased_Present => - True, + Defining_Identifier => Strm, + Aliased_Present => True, Object_Definition => New_Occurrence_Of (RTE (RE_Buffer_Stream_Type), Loc))); @@ -9367,8 +9087,7 @@ package body Exp_Dist is Append_To (Stms, Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Any_To_BS), Loc), + Name => New_Occurrence_Of (RTE (RE_Any_To_BS), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Any_Parameter, Loc), New_Occurrence_Of (Strm, Loc)))); @@ -9385,8 +9104,7 @@ package body Exp_Dist is Make_Object_Declaration (Loc, Defining_Identifier => Res, Constant_Present => True, - Object_Definition => - New_Occurrence_Of (Typ, Loc), + Object_Definition => New_Occurrence_Of (Typ, Loc), Expression => Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of (Typ, Loc), @@ -9403,8 +9121,7 @@ package body Exp_Dist is Name => New_Occurrence_Of (RTE (RE_Release_Buffer), Loc), Parameter_Associations => - New_List ( - New_Occurrence_Of (Strm, Loc))), + New_List (New_Occurrence_Of (Strm, Loc))), Make_Simple_Return_Statement (Loc, Expression => New_Occurrence_Of (Res, Loc)))))); @@ -9433,8 +9150,7 @@ package body Exp_Dist is begin return Make_Function_Call (Loc, Name => - New_Occurrence_Of ( - RTE (RE_Get_Aggregate_Element), Loc), + New_Occurrence_Of (RTE (RE_Get_Aggregate_Element), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Any, Loc), TC, @@ -9650,19 +9366,15 @@ package body Exp_Dist is Defining_Unit_Name => Fnam, Parameter_Specifications => New_List ( Make_Parameter_Specification (Loc, - Defining_Identifier => - Expr_Parameter, - Parameter_Type => - New_Occurrence_Of (Typ, Loc))), - Result_Definition => New_Occurrence_Of (RTE (RE_Any), Loc)); + Defining_Identifier => Expr_Parameter, + Parameter_Type => New_Occurrence_Of (Typ, Loc))), + Result_Definition => New_Occurrence_Of (RTE (RE_Any), Loc)); Set_Etype (Expr_Parameter, Typ); Any_Decl := Make_Object_Declaration (Loc, - Defining_Identifier => - Any, - Object_Definition => - New_Occurrence_Of (RTE (RE_Any), Loc)); + Defining_Identifier => Any, + Object_Definition => New_Occurrence_Of (RTE (RE_Any), Loc)); Use_Opaque_Representation := False; @@ -9704,8 +9416,8 @@ package body Exp_Dist is New_Occurrence_Of (Expr_Parameter, Loc)); begin - Set_Expression (Any_Decl, - Build_To_Any_Call (Expr, Decls)); + Set_Expression + (Any_Decl, Build_To_Any_Call (Expr, Decls)); end; -- Comment needed here (and label on declare block ???) @@ -9868,10 +9580,8 @@ package body Exp_Dist is Append_To (Block_Stmts, Make_Case_Statement (Loc, - Expression => - Make_Discriminant_Reference, - Alternatives => - Alt_List)); + Expression => Make_Discriminant_Reference, + Alternatives => Alt_List)); Variant := First_Non_Pragma (Variants (Field)); while Present (Variant) loop @@ -9889,9 +9599,9 @@ package body Exp_Dist is RTE (RE_Add_Aggregate_Element), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Union_Any, Loc), - Build_To_Any_Call ( - Make_Discriminant_Reference, - Block_Decls)))); + Build_To_Any_Call + (Make_Discriminant_Reference, + Block_Decls)))); -- Populate inner struct aggregate @@ -9935,7 +9645,7 @@ package body Exp_Dist is Append_To (Alt_List, Make_Case_Statement_Alternative (Loc, Discrete_Choices => Choice_List, - Statements => VP_Stmts)); + Statements => VP_Stmts)); Next_Non_Pragma (Variant); end loop; @@ -10204,8 +9914,7 @@ package body Exp_Dist is Append_To (Stms, Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_BS_To_Any), Loc), + Name => New_Occurrence_Of (RTE (RE_BS_To_Any), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Strm, Loc), New_Occurrence_Of (Any, Loc)))); @@ -10215,8 +9924,7 @@ package body Exp_Dist is Append_To (Stms, Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Release_Buffer), Loc), + Name => New_Occurrence_Of (RTE (RE_Release_Buffer), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Strm, Loc)))); end; @@ -10239,8 +9947,8 @@ package body Exp_Dist is Decl := Make_Subprogram_Body (Loc, - Specification => Spec, - Declarations => Decls, + Specification => Spec, + Declarations => Decls, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Statements => Stms)); @@ -10442,8 +10150,7 @@ package body Exp_Dist is begin Append_To (Parameter_List, Make_Function_Call (Loc, - Name => - New_Occurrence_Of (RTE (RE_TA_String), Loc), + Name => New_Occurrence_Of (RTE (RE_TA_String), Loc), Parameter_Associations => New_List ( Make_String_Literal (Loc, S)))); end Add_String_Parameter; @@ -10459,10 +10166,8 @@ package body Exp_Dist is begin Append_To (Parameter_List, Make_Function_Call (Loc, - Name => - New_Occurrence_Of (RTE (RE_TA_TC), Loc), - Parameter_Associations => New_List ( - TC_Node))); + Name => New_Occurrence_Of (RTE (RE_TA_TC), Loc), + Parameter_Associations => New_List (TC_Node))); end Add_TypeCode_Parameter; ------------------------ @@ -10476,8 +10181,7 @@ package body Exp_Dist is begin Append_To (Parameter_List, Make_Function_Call (Loc, - Name => - New_Occurrence_Of (RTE (RE_TA_LI), Loc), + Name => New_Occurrence_Of (RTE (RE_TA_LI), Loc), Parameter_Associations => New_List (Expr_Node))); end Add_Long_Parameter; @@ -10538,7 +10242,7 @@ package body Exp_Dist is Append_To (Stms, Make_Simple_Return_Statement (Loc, Expression => - Make_Constructed_TypeCode (Kind, Parameters))); + Make_Constructed_TypeCode (Kind, Parameters))); end Return_Constructed_TypeCode; ------------------ @@ -10577,8 +10281,8 @@ package body Exp_Dist is -- A regular component - Add_TypeCode_Parameter ( - Build_TypeCode_Call (Loc, Etype (Field), Decls), Params); + Add_TypeCode_Parameter + (Build_TypeCode_Call (Loc, Etype (Field), Decls), Params); Get_Name_String (Chars (Field)); Add_String_Parameter (String_From_Name_Buffer, Params); @@ -10718,7 +10422,7 @@ package body Exp_Dist is declare Default_Node : constant Node_Id := - Pick (Union_TC_Params, 4); + Pick (Union_TC_Params, 4); New_Default_Node : constant Node_Id := Make_Function_Call (Loc, @@ -10761,7 +10465,7 @@ package body Exp_Dist is declare Exp : constant Node_Id := - New_Copy_Tree (Choice); + New_Copy_Tree (Choice); begin Append_To (Union_TC_Params, Build_To_Any_Call (Exp, Decls)); @@ -10769,14 +10473,13 @@ package body Exp_Dist is Add_Params_For_Variant_Components; end case; + Next (Choice); Choice_Index := Choice_Index + 1; - end loop; Next_Non_Pragma (Variant); end loop; - end; end if; end TC_Rec_Add_Process_Element; @@ -10798,19 +10501,20 @@ package body Exp_Dist is Spec := Make_Function_Specification (Loc, - Defining_Unit_Name => Fnam, + Defining_Unit_Name => Fnam, Parameter_Specifications => Empty_List, - Result_Definition => + Result_Definition => New_Occurrence_Of (RTE (RE_TypeCode), Loc)); Build_Name_And_Repository_Id (Typ, Name_Str => Type_Name_Str, Repo_Id_Str => Type_Repo_Id_Str); + Initialize_Parameter_List (Type_Name_Str, Type_Repo_Id_Str, Parameters); if Has_Stream_Attribute_Definition (Typ, TSS_Stream_Output, At_Any_Place => True) - or else + or else Has_Stream_Attribute_Definition (Typ, TSS_Stream_Write, At_Any_Place => True) then @@ -10875,20 +10579,23 @@ package body Exp_Dist is -- | [VP Name] if Nkind (Declaration_Node (Typ)) = N_Subtype_Declaration then - Return_Alias_TypeCode ( - Build_TypeCode_Call (Loc, Etype (Typ), Decls)); + Return_Alias_TypeCode + (Build_TypeCode_Call (Loc, Etype (Typ), Decls)); + else declare Disc : Entity_Id := Empty; Rdef : constant Node_Id := - Type_Definition (Declaration_Node (Typ)); + Type_Definition (Declaration_Node (Typ)); Dummy_Counter : Int := 0; + begin -- Construct the discriminants typecodes if Has_Discriminants (Typ) then Disc := First_Discriminant (Typ); end if; + while Present (Disc) loop Add_TypeCode_Parameter ( Build_TypeCode_Call (Loc, Etype (Disc), Decls), @@ -10917,9 +10624,8 @@ package body Exp_Dist is Indx : Node_Id := First_Index (Typ); begin - Inner_TypeCode := Build_TypeCode_Call (Loc, - Component_Type (Typ), - Decls); + Inner_TypeCode := + Build_TypeCode_Call (Loc, Component_Type (Typ), Decls); for J in 1 .. Ndim loop if Constrained then @@ -10928,13 +10634,11 @@ package body Exp_Dist is Build_To_Any_Call ( OK_Convert_To (RTE (RE_Long_Unsigned), Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Typ, Loc), - Attribute_Name => - Name_Length, + Prefix => New_Occurrence_Of (Typ, Loc), + Attribute_Name => Name_Length, Expressions => New_List ( Make_Integer_Literal (Loc, - Ndim - J + 1)))), + Intval => Ndim - J + 1)))), Decls), Build_To_Any_Call (Inner_TypeCode, Decls))); @@ -10981,8 +10685,8 @@ package body Exp_Dist is Decl := Make_Subprogram_Body (Loc, - Specification => Spec, - Declarations => Decls, + Specification => Spec, + Declarations => Decls, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Statements => Stms)); @@ -11086,7 +10790,6 @@ package body Exp_Dist is Make_Indexed_Component (Loc, New_Occurrence_Of (Arry, Loc), Indices); - begin Set_Etype (Element_Expr, Component_Type (Typ)); Add_Process_Element (Stmts, @@ -11118,8 +10821,8 @@ package body Exp_Dist is declare Loop_Any : Node_Id := Inner_Any; - begin + begin -- For the first dimension of a constrained array, we add -- elements directly in the corresponding Any; there is no -- intervening inner Any. @@ -11169,8 +10872,7 @@ package body Exp_Dist is if Constrained then Inner_Any_TypeCode_Expr := Make_Function_Call (Loc, - Name => - New_Occurrence_Of (RTE (RE_Get_TC), Loc), + Name => New_Occurrence_Of (RTE (RE_Get_TC), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Any, Loc))); else @@ -11185,11 +10887,10 @@ package body Exp_Dist is else Inner_Any_TypeCode_Expr := Make_Function_Call (Loc, - Name => - New_Occurrence_Of (RTE (RE_Content_Type), Loc), + Name => New_Occurrence_Of (RTE (RE_Content_Type), Loc), Parameter_Associations => New_List ( Make_Identifier (Loc, - New_External_Name ('T', Depth - 1)))); + Chars => New_External_Name ('T', Depth - 1)))); end if; Append_To (Decls, @@ -11281,7 +10982,8 @@ package body Exp_Dist is if Is_Tagged_Type (Typ) then return Make_Defining_Identifier (Loc, Nam); else - return Make_Defining_Identifier (Loc, + return + Make_Defining_Identifier (Loc, Chars => New_External_Name (Nam, ' ', Increment_Serial_Number)); end if; @@ -11457,7 +11159,8 @@ package body Exp_Dist is (Loc : Source_Ptr; Decls : List_Id; RPC_Receiver : Entity_Id; - Stub_Elements : Stub_Structure) is + Stub_Elements : Stub_Structure) + is begin case Get_PCS_Name is when Name_PolyORB_DSA => @@ -11479,25 +11182,26 @@ package body Exp_Dist is Stub_Type : Entity_Id; Stub_Type_Access : Entity_Id; RPC_Receiver_Decl : Node_Id; - Body_Decls : List_Id) is + Body_Decls : List_Id) + is begin case Get_PCS_Name is when Name_PolyORB_DSA => - PolyORB_Support.Add_RACW_Features ( - RACW_Type, - Desig, - Stub_Type, - Stub_Type_Access, - RPC_Receiver_Decl, - Body_Decls); + PolyORB_Support.Add_RACW_Features + (RACW_Type, + Desig, + Stub_Type, + Stub_Type_Access, + RPC_Receiver_Decl, + Body_Decls); when others => - GARLIC_Support.Add_RACW_Features ( - RACW_Type, - Stub_Type, - Stub_Type_Access, - RPC_Receiver_Decl, - Body_Decls); + GARLIC_Support.Add_RACW_Features + (RACW_Type, + Stub_Type, + Stub_Type_Access, + RPC_Receiver_Decl, + Body_Decls); end case; end Specific_Add_RACW_Features; @@ -11507,7 +11211,8 @@ package body Exp_Dist is procedure Specific_Add_RAST_Features (Vis_Decl : Node_Id; - RAS_Type : Entity_Id) is + RAS_Type : Entity_Id) + is begin case Get_PCS_Name is when Name_PolyORB_DSA => @@ -11529,11 +11234,11 @@ package body Exp_Dist is begin case Get_PCS_Name is when Name_PolyORB_DSA => - PolyORB_Support.Add_Receiving_Stubs_To_Declarations ( - Pkg_Spec, Decls, Stmts); + PolyORB_Support.Add_Receiving_Stubs_To_Declarations + (Pkg_Spec, Decls, Stmts); when others => - GARLIC_Support.Add_Receiving_Stubs_To_Declarations ( - Pkg_Spec, Decls, Stmts); + GARLIC_Support.Add_Receiving_Stubs_To_Declarations + (Pkg_Spec, Decls, Stmts); end case; end Specific_Add_Receiving_Stubs_To_Declarations; @@ -11558,34 +11263,35 @@ package body Exp_Dist is begin case Get_PCS_Name is when Name_PolyORB_DSA => - PolyORB_Support.Build_General_Calling_Stubs ( - Decls, - Statements, - Target.Object, - Subprogram_Id, - Asynchronous, - Is_Known_Asynchronous, - Is_Known_Non_Asynchronous, - Is_Function, - Spec, - Stub_Type, - RACW_Type, - Nod); + PolyORB_Support.Build_General_Calling_Stubs + (Decls, + Statements, + Target.Object, + Subprogram_Id, + Asynchronous, + Is_Known_Asynchronous, + Is_Known_Non_Asynchronous, + Is_Function, + Spec, + Stub_Type, + RACW_Type, + Nod); + when others => - GARLIC_Support.Build_General_Calling_Stubs ( - Decls, - Statements, - Target.Partition, - Target.RPC_Receiver, - Subprogram_Id, - Asynchronous, - Is_Known_Asynchronous, - Is_Known_Non_Asynchronous, - Is_Function, - Spec, - Stub_Type, - RACW_Type, - Nod); + GARLIC_Support.Build_General_Calling_Stubs + (Decls, + Statements, + Target.Partition, + Target.RPC_Receiver, + Subprogram_Id, + Asynchronous, + Is_Known_Asynchronous, + Is_Known_Non_Asynchronous, + Is_Function, + Spec, + Stub_Type, + RACW_Type, + Nod); end case; end Specific_Build_General_Calling_Stubs; @@ -11611,6 +11317,7 @@ package body Exp_Dist is Subp_Index, Stmts, Decl); + when others => GARLIC_Support.Build_RPC_Receiver_Body (RPC_Receiver, @@ -11637,6 +11344,7 @@ package body Exp_Dist is when Name_PolyORB_DSA => return PolyORB_Support.Build_Stub_Target (Loc, Decls, RCI_Locator, Controlling_Parameter); + when others => return GARLIC_Support.Build_Stub_Target (Loc, Decls, RCI_Locator, Controlling_Parameter); @@ -11659,6 +11367,7 @@ package body Exp_Dist is PolyORB_Support.Build_Stub_Type ( RACW_Type, Stub_Type, Stub_Type_Decl, RPC_Receiver_Decl); + when others => GARLIC_Support.Build_Stub_Type ( RACW_Type, Stub_Type, @@ -11677,21 +11386,22 @@ package body Exp_Dist is begin case Get_PCS_Name is when Name_PolyORB_DSA => - return PolyORB_Support.Build_Subprogram_Receiving_Stubs ( - Vis_Decl, - Asynchronous, - Dynamically_Asynchronous, - Stub_Type, - RACW_Type, - Parent_Primitive); + return PolyORB_Support.Build_Subprogram_Receiving_Stubs + (Vis_Decl, + Asynchronous, + Dynamically_Asynchronous, + Stub_Type, + RACW_Type, + Parent_Primitive); + when others => - return GARLIC_Support.Build_Subprogram_Receiving_Stubs ( - Vis_Decl, - Asynchronous, - Dynamically_Asynchronous, - Stub_Type, - RACW_Type, - Parent_Primitive); + return GARLIC_Support.Build_Subprogram_Receiving_Stubs + (Vis_Decl, + Asynchronous, + Dynamically_Asynchronous, + Stub_Type, + RACW_Type, + Parent_Primitive); end case; end Specific_Build_Subprogram_Receiving_Stubs; @@ -11722,10 +11432,12 @@ package body Exp_Dist is end if; return - Etype (Subtype_Indication ( - Component_Definition ( - First (Component_Items (Component_List ( - Type_Definition (Declaration_Node (Record_Type)))))))); + Etype (Subtype_Indication + (Component_Definition + (First (Component_Items + (Component_List + (Type_Definition + (Declaration_Node (Record_Type)))))))); end Underlying_RACW_Type; end Exp_Dist; diff --git a/gcc/ada/exp_dist.ads b/gcc/ada/exp_dist.ads index cc2323f26c0..a1418d3f6bb 100644 --- a/gcc/ada/exp_dist.ads +++ b/gcc/ada/exp_dist.ads @@ -26,12 +26,16 @@ -- This package contains utility routines used for the generation of the -- stubs relevant to the distribution annex. -with Namet; use Namet; -with Types; use Types; +with Namet; use Namet; +with Snames; use Snames; +with Types; use Types; package Exp_Dist is - PCS_Version_Number : constant := 1; + PCS_Version_Number : constant array (PCS_Names) of Int := + (Name_No_DSA => 1, + Name_GARLIC_DSA => 1, + Name_PolyORB_DSA => 2); -- PCS interface version. This is used to check for consistency between the -- compiler used to generate distribution stubs and the PCS implementation. -- It must be incremented whenever a change is made to the generated code diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index 650e2eaad3f..a0efccc3f06 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -959,7 +959,9 @@ package body Rtsfind is if Get_PCS_Name = Name_No_DSA then Check_RPC_Failure ("distribution feature not supported"); - elsif Get_PCS_Version /= Exp_Dist.PCS_Version_Number then + elsif Get_PCS_Version /= + Exp_Dist.PCS_Version_Number (Get_PCS_Name) + then Check_RPC_Failure ("PCS version mismatch"); end if; diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 2c16961c009..6fbfd9de895 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -1078,6 +1078,7 @@ package Rtsfind is RE_DSA_Implementation, -- System.Partition_Interface RE_PCS_Version, -- System.Partition_Interface + RE_Get_RACW, -- System.Partition_Interface RE_Get_RCI_Package_Receiver, -- System.Partition_Interface RE_Get_Unique_Remote_Pointer, -- System.Partition_Interface RE_RACW_Stub_Type_Access, -- System.Partition_Interface @@ -2209,6 +2210,7 @@ package Rtsfind is RE_DSA_Implementation => System_Partition_Interface, RE_PCS_Version => System_Partition_Interface, + RE_Get_RACW => System_Partition_Interface, RE_Get_RCI_Package_Receiver => System_Partition_Interface, RE_Get_Unique_Remote_Pointer => System_Partition_Interface, RE_RACW_Stub_Type_Access => System_Partition_Interface, diff --git a/gcc/ada/sem_dist.adb b/gcc/ada/sem_dist.adb index 0be68edc9f3..211bdddb49e 100644 --- a/gcc/ada/sem_dist.adb +++ b/gcc/ada/sem_dist.adb @@ -64,7 +64,9 @@ package body Sem_Dist is procedure Add_Stub_Constructs (N : Node_Id) is U : constant Node_Id := Unit (N); Spec : Entity_Id := Empty; - Exp : Node_Id := U; -- Unit that will be expanded + + Exp : Node_Id := U; + -- Unit that will be expanded begin pragma Assert (Distribution_Stub_Mode /= No_Stubs); @@ -84,7 +86,6 @@ package body Sem_Dist is or else Is_Remote_Call_Interface (Spec)); if Distribution_Stub_Mode = Generate_Caller_Stub_Body then - if Is_Shared_Passive (Spec) then null; elsif Nkind (U) = N_Package_Body then @@ -95,7 +96,6 @@ package body Sem_Dist is end if; else - if Is_Shared_Passive (Spec) then Build_Passive_Partition_Stub (Exp); else @@ -186,7 +186,6 @@ package body Sem_Dist is if Parent_Name /= No_String then Start_String (Parent_Name); Store_String_Char (Get_Char_Code ('.')); - else Start_String; end if; @@ -242,15 +241,13 @@ package body Sem_Dist is Par : Node_Id; begin - if (Nkind (N) = N_Function_Call - or else Nkind (N) = N_Procedure_Call_Statement) + if Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement) and then Nkind (Name (N)) in N_Has_Entity and then Is_Remote_Call_Interface (Entity (Name (N))) and then Has_All_Calls_Remote (Scope (Entity (Name (N)))) and then Comes_From_Source (N) then Par := Parent (Entity (Name (N))); - while Present (Par) and then (Nkind (Par) /= N_Package_Specification or else Is_Wrapper_Package (Defining_Entity (Par))) @@ -294,9 +291,10 @@ package body Sem_Dist is ------------------------------------ function Package_Specification_Of_Scope (E : Entity_Id) return Node_Id is - N : Node_Id := Parent (E); + N : Node_Id; begin + N := Parent (E); while Nkind (N) /= N_Package_Specification loop N := Parent (N); end loop; @@ -317,11 +315,10 @@ package body Sem_Dist is Typ : constant Entity_Id := Etype (N); begin - Ety := Entity (Prefix (N)); - -- In case prefix is not a library unit entity, get the entity -- of library unit. + Ety := Entity (Prefix (N)); while (Present (Scope (Ety)) and then Scope (Ety) /= Standard_Standard) and not Is_Child_Unit (Ety) @@ -363,7 +360,6 @@ package body Sem_Dist is else Get_Pt_Id_Call := Make_Function_Call (Loc, Get_Pt_Id); - end if; -- Replace the attribute node by a conversion of the function call @@ -426,10 +422,11 @@ package body Sem_Dist is Tick_Access_Conv_Call := Make_Function_Call (Loc, - Name => New_Occurrence_Of (Attribute_Subp, Loc), + Name => New_Occurrence_Of (Attribute_Subp, Loc), Parameter_Associations => New_List ( - Make_String_Literal (Loc, Full_Qualified_Name (RS_Pkg_E)), + Make_String_Literal (Loc, + Strval => Full_Qualified_Name (RS_Pkg_E)), Build_Subprogram_Id (Loc, Remote_Subp), New_Occurrence_Of (Async_E, Loc), New_Occurrence_Of (All_Calls_Remote_E, Loc))); @@ -527,8 +524,7 @@ package body Sem_Dist is Append_To (Priv_Decls, Make_Full_Type_Declaration (Loc, - Defining_Identifier => - Full_Obj_Type, + Defining_Identifier => Full_Obj_Type, Type_Definition => Make_Record_Definition (Loc, Abstract_Present => True, @@ -558,39 +554,33 @@ package body Sem_Dist is All_Present => True, Subtype_Indication => Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Obj_Type, Loc), - Attribute_Name => - Name_Class)))); + Prefix => New_Occurrence_Of (Obj_Type, Loc), + Attribute_Name => Name_Class)))); + Set_Is_Remote_Call_Interface (RACW_Type, Is_RCI); Set_Is_Remote_Types (RACW_Type, Is_RT); Subpkg_Decl := Make_Package_Declaration (Loc, Make_Package_Specification (Loc, - Defining_Unit_Name => - Subpkg, - Visible_Declarations => - Vis_Decls, - Private_Declarations => - Priv_Decls, - End_Label => - New_Occurrence_Of (Subpkg, Loc))); + Defining_Unit_Name => Subpkg, + Visible_Declarations => Vis_Decls, + Private_Declarations => Priv_Decls, + End_Label => New_Occurrence_Of (Subpkg, Loc))); + Set_Is_Remote_Call_Interface (Subpkg, Is_RCI); Set_Is_Remote_Types (Subpkg, Is_RT); Insert_After_And_Analyze (N, Subpkg_Decl); -- Generate package body to receive RACW calling stubs - -- Note: Analyze_Declarations has an absolute requirement that - -- the declaration list be non-empty, so we provide a dummy null - -- statement here. + + -- Note: Analyze_Declarations has an absolute requirement that the + -- declaration list be non-empty, so provide dummy null statement here. Subpkg_Body := Make_Package_Body (Loc, - Defining_Unit_Name => - Make_Defining_Identifier (Loc, Chars (Subpkg)), - Declarations => New_List ( - Make_Null_Statement (Loc))); + Defining_Unit_Name => Make_Defining_Identifier (Loc, Chars (Subpkg)), + Declarations => New_List (Make_Null_Statement (Loc))); Insert_After_And_Analyze (Subpkg_Decl, Subpkg_Body); -- Many parts of the analyzer and expander expect @@ -612,10 +602,10 @@ package body Sem_Dist is Make_Defining_Identifier (Loc, Name_Ras), Component_Definition => Make_Component_Definition (Loc, - Aliased_Present => - False, + Aliased_Present => False, Subtype_Indication => New_Occurrence_Of (RACW_Type, Loc))))))); + Set_Equivalent_Type (User_Type, Fat_Type); Set_Corresponding_Remote_Type (Fat_Type, User_Type); Insert_After_And_Analyze (Subpkg_Body, Fat_Type_Decl); @@ -656,7 +646,6 @@ package body Sem_Dist is end if; elsif Nkind (Deref_Subp_Call) = N_Indexed_Component then - Params := Expressions (Deref_Subp_Call); if Present (Params) then @@ -681,13 +670,12 @@ package body Sem_Dist is if Ekind (Deref_Proc) = E_Function then Call_Node := Make_Function_Call (Loc, - Name => New_Occurrence_Of (Deref_Proc, Loc), + Name => New_Occurrence_Of (Deref_Proc, Loc), Parameter_Associations => Params); - else Call_Node := Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (Deref_Proc, Loc), + Name => New_Occurrence_Of (Deref_Proc, Loc), Parameter_Associations => Params); end if; @@ -711,8 +699,8 @@ package body Sem_Dist is and then (Is_Remote_Call_Interface (ET) or else Is_Remote_Types (ET)) and then Present (Corresponding_Remote_Type (ET)) - and then (Nkind (Parent (Parent (P))) = N_Procedure_Call_Statement - or else Nkind (Parent (Parent (P))) = N_Indexed_Component) + and then Nkind_In (Parent (Parent (P)), N_Procedure_Call_Statement, + N_Indexed_Component) and then Expander_Active then RAS_E_Dereference (P); @@ -788,17 +776,14 @@ package body Sem_Dist is -- We do not have to handle this case return False; - end if; Rewrite (N, Make_Aggregate (Loc, Component_Associations => New_List ( Make_Component_Association (Loc, - Choices => New_List ( - Make_Identifier (Loc, Name_Ras)), - Expression => - Make_Null (Loc))))); + Choices => New_List (Make_Identifier (Loc, Name_Ras)), + Expression => Make_Null (Loc))))); Analyze_And_Resolve (N, Target_Type); return True; end Remote_AST_Null_Value; -- 2.30.2