diff options
Diffstat (limited to 'gcc/ada/exp_dist.adb')
| -rw-r--r-- | gcc/ada/exp_dist.adb | 135 |
1 files changed, 78 insertions, 57 deletions
diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 0fc6288604f..04a2187c8ce 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -3645,9 +3645,7 @@ package body Exp_Dist is (Vis_Decl : Node_Id; RAS_Type : Entity_Id) is - pragma Warnings (Off); pragma Unreferenced (RAS_Type); - pragma Warnings (On); begin Add_RAS_Access_TSS (Vis_Decl); end Add_RAST_Features; @@ -4111,10 +4109,8 @@ package body Exp_Dist is -- List of statements for extra formal parameters. It will appear -- after the regular statements for writing out parameters. - pragma Warnings (Off); pragma Unreferenced (RACW_Type); -- Used only for the PolyORB case - pragma Warnings (On); begin -- The general form of a calling stub for a given subprogram is: @@ -5601,9 +5597,7 @@ package body Exp_Dist is RPC_Receiver_Decl : Node_Id; Body_Decls : List_Id) is - pragma Warnings (Off); pragma Unreferenced (RPC_Receiver_Decl); - pragma Warnings (On); begin Add_RACW_From_Any @@ -5730,9 +5724,8 @@ package body Exp_Dist is Stub_Type_Access : Entity_Id; Body_Decls : List_Id) is - pragma Warnings (Off); pragma Unreferenced (Stub_Type, Stub_Type_Access); - pragma Warnings (On); + Loc : constant Source_Ptr := Sloc (RACW_Type); Proc_Decl : Node_Id; @@ -6047,9 +6040,7 @@ package body Exp_Dist is Stub_Type_Access : Entity_Id; Body_Decls : List_Id) is - pragma Warnings (Off); pragma Unreferenced (Stub_Type, Stub_Type_Access); - pragma Warnings (On); Loc : constant Source_Ptr := Sloc (RACW_Type); @@ -7157,13 +7148,37 @@ package body Exp_Dist is is Loc : constant Source_Ptr := Sloc (Nod); + Request : constant Entity_Id := + Make_Defining_Identifier (Loc, New_Internal_Name ('R')); + -- The request object constructed by these stubs + -- Could we use Name_R instead??? (see GLADE client stubs) + + function Make_Request_RTE_Call + (RE : RE_Id; + Actuals : List_Id := New_List) return Node_Id; + -- Generate a procedure call statement calling RE with the given + -- actuals. Request is appended to the list. + + --------------------------- + -- Make_Request_RTE_Call -- + --------------------------- + + function Make_Request_RTE_Call + (RE : RE_Id; + Actuals : List_Id := New_List) return Node_Id + is + begin + Append_To (Actuals, New_Occurrence_Of (Request, Loc)); + return Make_Procedure_Call_Statement (Loc, + Name => + New_Occurrence_Of (RTE (RE), Loc), + Parameter_Associations => Actuals); + end Make_Request_RTE_Call; + Arguments : Node_Id; -- Name of the named values list used to transmit parameters -- to the remote package - Request : Node_Id; - -- The request object constructed by these stubs - Result : Node_Id; -- Name of the result named value (in non-APC cases) which get the -- result of the remote subprogram. @@ -7194,8 +7209,8 @@ package body Exp_Dist is -- after the regular statements for writing out parameters. After_Statements : constant List_Id := New_List; - -- Statements to be executed after call returns (to assign - -- in out or out parameter values). + -- Statements to be executed after call returns (to assign IN OUT or + -- OUT parameter values). Etyp : Entity_Id; -- The type of the formal parameter being processed @@ -7209,7 +7224,6 @@ 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')); Append_To (Decls, Make_Object_Declaration (Loc, @@ -7449,19 +7463,13 @@ package body Exp_Dist is Append_List_To (Statements, Extra_Formal_Statements); Append_To (Statements, - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Request_Create), Loc), - - Parameter_Associations => New_List ( - Target_Object, - Subprogram_Id, - New_Occurrence_Of (Arguments, Loc), - New_Occurrence_Of (Result, Loc), - New_Occurrence_Of (RTE (RE_Nil_Exc_List), Loc)))); - - Append_To (Parameter_Associations (Last (Statements)), - New_Occurrence_Of (Request, Loc)); + Make_Request_RTE_Call (RE_Request_Create, New_List ( + Target_Object, + Subprogram_Id, + New_Occurrence_Of (Arguments, Loc), + New_Occurrence_Of (Result, Loc), + New_Occurrence_Of + (RTE (RE_Nil_Exc_List), Loc)))); pragma Assert (not (Is_Known_Non_Asynchronous and Is_Known_Asynchronous)); @@ -7487,22 +7495,22 @@ package body Exp_Dist is RTE (RE_Asynchronous_P_To_Sync_Scope), Loc), Expressions => New_List (Asynchronous_P))); - Append_To (Statements, - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE_Request_Invoke), Loc), - Parameter_Associations => New_List ( - New_Occurrence_Of (Request, Loc)))); + Append_To (Statements, Make_Request_RTE_Call (RE_Request_Invoke)); - Non_Asynchronous_Statements := New_List (Make_Null_Statement (Loc)); - Asynchronous_Statements := New_List (Make_Null_Statement (Loc)); + -- Asynchronous case - if not Is_Known_Asynchronous then + if not Is_Known_Non_Asynchronous then + Asynchronous_Statements := + New_List (Make_Request_RTE_Call (RE_Request_Destroy)); + end if; + + -- Non-asynchronous case + if not Is_Known_Asynchronous then -- Reraise an exception occurrence from the completed request. -- If the exception occurrence is empty, this is a no-op. - Append_To (Non_Asynchronous_Statements, + Non_Asynchronous_Statements := New_List ( Make_Procedure_Call_Statement (Loc, Name => New_Occurrence_Of (RTE (RE_Request_Raise_Occurrence), Loc), @@ -7511,6 +7519,9 @@ package body Exp_Dist is if Is_Function then + Append_To (Non_Asynchronous_Statements, + Make_Request_RTE_Call (RE_Request_Destroy)); + -- If this is a function call, read the value and return it Append_To (Non_Asynchronous_Statements, @@ -7522,11 +7533,18 @@ package body Exp_Dist is Prefix => Result, Selector_Name => Name_Argument), Decls)))); + + else + + -- Case of a procedure: deal with IN OUT and OUT formals + + Append_List_To (Non_Asynchronous_Statements, After_Statements); + + Append_To (Non_Asynchronous_Statements, + Make_Request_RTE_Call (RE_Request_Destroy)); end if; end if; - Append_List_To (Non_Asynchronous_Statements, After_Statements); - if Is_Known_Asynchronous then Append_List_To (Statements, Asynchronous_Statements); @@ -7602,9 +7620,8 @@ package body Exp_Dist is RPC_Receiver_Decl : out Node_Id) is Loc : constant Source_Ptr := Sloc (Stub_Type); - pragma Warnings (Off); + pragma Unreferenced (RACW_Type); - pragma Warnings (On); begin Stub_Type_Decl := @@ -7667,9 +7684,9 @@ package body Exp_Dist is Request := Make_Defining_Identifier (Loc, Name_R); RPC_Receiver_Spec := - Build_RPC_Receiver_Specification ( - RPC_Receiver => RPC_Receiver, - Request_Parameter => Request); + Build_RPC_Receiver_Specification + (RPC_Receiver => RPC_Receiver, + Request_Parameter => Request); Subp_Id := Make_Defining_Identifier (Loc, Name_P); Subp_Index := Make_Defining_Identifier (Loc, Name_I); @@ -8461,8 +8478,17 @@ package body Exp_Dist is else declare Decl : Entity_Id; + Typ : Entity_Id := U_Type; + begin - Build_From_Any_Function (Loc, U_Type, Decl, Fnam); + -- For the subtype representing a generic actual type, go + -- to the base type. + + if Is_Generic_Actual_Type (Typ) then + Typ := Base_Type (Typ); + end if; + + Build_From_Any_Function (Loc, Typ, Decl, Fnam); Append_To (Decls, Decl); end; end if; @@ -8528,7 +8554,7 @@ package body Exp_Dist is 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 + -- The RACW case is taken care of by Exp_Dist.Add_RACW_From_Any pragma Assert (not (Is_Remote_Access_To_Class_Wide_Type (Typ))); @@ -8565,11 +8591,10 @@ 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)))); + Build_From_Any_Call + (Etype (Typ), + New_Occurrence_Of (Any_Parameter, Loc), + Decls))); else declare @@ -9859,9 +9884,7 @@ package body Exp_Dist is Counter : Entity_Id; Datum : Node_Id) is - pragma Warnings (Off); pragma Unreferenced (Counter); - pragma Warnings (On); Element_Any : Node_Id; @@ -10352,9 +10375,7 @@ package body Exp_Dist is Rec : Entity_Id; Field : Node_Id) is - pragma Warnings (Off); pragma Unreferenced (Any, Counter, Rec); - pragma Warnings (On); begin if Nkind (Field) = N_Defining_Identifier then |