From patchwork Mon Oct 25 15:26:43 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 69163 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 8873CB6EEB for ; Tue, 26 Oct 2010 15:13:51 +1100 (EST) Received: (qmail 26639 invoked by alias); 26 Oct 2010 04:13:48 -0000 Received: (qmail 26618 invoked by uid 22791); 26 Oct 2010 04:13:41 -0000 X-SWARE-Spam-Status: No, hits=-1.7 required=5.0 tests=AWL,BAYES_00 X-Spam-Check-By: sourceware.org Received: from eggs.gnu.org (HELO eggs.gnu.org) (140.186.70.92) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 26 Oct 2010 04:13:35 +0000 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1PAOx8-0002wI-K6 for gcc-patches@gcc.gnu.org; Mon, 25 Oct 2010 11:27:16 -0400 Received: from mel.act-europe.fr ([194.98.77.210]:36987) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1PAOx7-0002sh-VL for gcc-patches@gcc.gnu.org; Mon, 25 Oct 2010 11:27:14 -0400 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 6DE49CB02D1; Mon, 25 Oct 2010 17:26:43 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id WNxbA+bSnwn9; Mon, 25 Oct 2010 17:26:43 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id 568F5CB0226; Mon, 25 Oct 2010 17:26:43 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 3928CD9BB5; Mon, 25 Oct 2010 17:26:43 +0200 (CEST) Date: Mon, 25 Oct 2010 17:26:43 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Thomas Quinot Subject: [Ada] Nested packages and instantiations in RCIs Message-ID: <20101025152643.GA25766@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org This change adds missing circuitry to handle nested packages, package instantiations and subprogram instantiations when generating DSA stubs for a remote call interface unit. No test (requires a PCS). Tested on x86_64-pc-linux-gnu, committed on trunk 2010-10-25 Thomas Quinot * sem_ch12.adb (Analyze_Package_Instantiation): For an instantiation in an RCI spec, omit package body if instantiation comes from source, even as a nested package. * exp_dist.adb (Add_Calling_Stubs_To_Declarations, *_Support.Add_Receiving_Stubs_To_Declarations): Handle the case of nested packages, package instantiations and subprogram instantiations. Index: sem_ch12.adb =================================================================== --- sem_ch12.adb (revision 165916) +++ sem_ch12.adb (working copy) @@ -3314,12 +3314,13 @@ package body Sem_Ch12 is end if; end; - -- If we are generating the calling stubs from the instantiation of - -- a generic RCI package, we will not use the body of the generic - -- package. + -- If we are generating calling stubs, we never need a body for an + -- instantiation from source. However normal processing occurs for + -- any generic instantiation appearing in generated code, since we + -- do not generate stubs in that case. if Distribution_Stub_Mode = Generate_Caller_Stub_Body - and then Is_Compilation_Unit (Defining_Entity (N)) + and then Comes_From_Source (N) then Needs_Body := False; end if; @@ -4000,6 +4001,9 @@ package body Sem_Ch12 is Check_Formal_Packages (Pack_Id); Set_Is_Generic_Instance (Pack_Id, False); + -- Why do we clear Is_Generic_Instance??? We set it 20 lines + -- above??? + -- Body of the enclosing package is supplied when instantiating the -- subprogram body, after semantic analysis is completed. Index: exp_dist.adb =================================================================== --- exp_dist.adb (revision 165916) +++ exp_dist.adb (working copy) @@ -41,6 +41,7 @@ with Sem_Aux; use Sem_Aux; with Sem_Cat; use Sem_Cat; with Sem_Ch3; use Sem_Ch3; with Sem_Ch8; use Sem_Ch8; +with Sem_Ch12; use Sem_Ch12; with Sem_Dist; use Sem_Dist; with Sem_Eval; use Sem_Eval; with Sem_Util; use Sem_Util; @@ -225,9 +226,7 @@ package body Exp_Dist is -- In either case, this means stubs cannot contain a default-initialized -- object declaration of such type. - procedure Add_Calling_Stubs_To_Declarations - (Pkg_Spec : Node_Id; - Decls : List_Id); + procedure Add_Calling_Stubs_To_Declarations (Pkg_Spec : Node_Id); -- Add calling stubs to the declarative part function Could_Be_Asynchronous (Spec : Node_Id) return Boolean; @@ -915,27 +914,145 @@ package body Exp_Dist is -- since this require separate mechanisms ('Input is a function while -- 'Read is a procedure). + generic + with procedure Process_Subprogram_Declaration (Decl : Node_Id); + -- Generate calling or receiving stub for this subprogram declaration + + procedure Build_Package_Stubs (Pkg_Spec : Node_Id); + -- Recursively visit the given RCI Package_Specification, calling + -- Process_Subprogram_Declaration for each remote subprogram. + + ------------------------- + -- Build_Package_Stubs -- + ------------------------- + + procedure Build_Package_Stubs (Pkg_Spec : Node_Id) is + Decls : constant List_Id := Visible_Declarations (Pkg_Spec); + Decl : Node_Id; + + procedure Visit_Nested_Pkg (Nested_Pkg_Decl : Node_Id); + -- Recurse for the given nested package declaration + + ----------------------- + -- Visit_Nested_Spec -- + ----------------------- + + procedure Visit_Nested_Pkg (Nested_Pkg_Decl : Node_Id) is + Nested_Pkg_Spec : constant Node_Id := Specification (Nested_Pkg_Decl); + begin + Push_Scope (Scope_Of_Spec (Nested_Pkg_Spec)); + Build_Package_Stubs (Nested_Pkg_Spec); + Pop_Scope; + end Visit_Nested_Pkg; + + -- Start of processing for Build_Package_Stubs + + begin + Decl := First (Decls); + while Present (Decl) loop + case Nkind (Decl) is + when N_Subprogram_Declaration => + + -- Note: we test Comes_From_Source on Spec, not Decl, because + -- in the case of a subprogram instance, only the specification + -- (not the declaration) is marked as coming from source. + + if Comes_From_Source (Specification (Decl)) then + Process_Subprogram_Declaration (Decl); + end if; + + when N_Package_Declaration => + + -- Case of a nested package or package instantiation coming + -- from source. Note that the anonymous wrapper package for + -- subprogram instances is not flagged Is_Generic_Instance at + -- this point, so there is a distinct circuit to handle them + -- (see case N_Subprogram_Instantiation below). + + declare + Pkg_Ent : constant Entity_Id := + Defining_Unit_Name (Specification (Decl)); + begin + if Comes_From_Source (Decl) + or else + (Is_Generic_Instance (Pkg_Ent) + and then Comes_From_Source + (Get_Package_Instantiation_Node (Pkg_Ent))) + then + Visit_Nested_Pkg (Decl); + end if; + end; + + when N_Subprogram_Instantiation => + + -- The subprogram declaration for an instance of a generic + -- subprogram is wrapped in a package that does not come from + -- source, so we need to explicitly traverse it here. + + if Comes_From_Source (Decl) then + Visit_Nested_Pkg (Instance_Spec (Decl)); + end if; + + when others => + null; + end case; + Next (Decl); + end loop; + end Build_Package_Stubs; + --------------------------------------- -- Add_Calling_Stubs_To_Declarations -- --------------------------------------- - procedure Add_Calling_Stubs_To_Declarations - (Pkg_Spec : Node_Id; - Decls : List_Id) - is + procedure Add_Calling_Stubs_To_Declarations (Pkg_Spec : Node_Id) is + Loc : constant Source_Ptr := Sloc (Pkg_Spec); + Current_Subprogram_Number : Int := First_RCI_Subprogram_Id; -- Subprogram id 0 is reserved for calls received from -- remote access-to-subprogram dereferences. - Current_Declaration : Node_Id; - Loc : constant Source_Ptr := Sloc (Pkg_Spec); RCI_Instantiation : Node_Id; - Subp_Stubs : Node_Id; - Subp_Str : String_Id; - pragma Warnings (Off, Subp_Str); + procedure Visit_Subprogram (Decl : Node_Id); + -- Generate calling stub for one remote subprogram + + ---------------------- + -- Visit_Subprogram -- + ---------------------- + + procedure Visit_Subprogram (Decl : Node_Id) is + Loc : constant Source_Ptr := Sloc (Decl); + Spec : constant Node_Id := Specification (Decl); + Subp_Stubs : Node_Id; + Subp_Str : String_Id; + pragma Warnings (Off, Subp_Str); + + begin + Assign_Subprogram_Identifier + (Defining_Unit_Name (Spec), Current_Subprogram_Number, Subp_Str); + + Subp_Stubs := + Build_Subprogram_Calling_Stubs ( + Vis_Decl => Decl, + Subp_Id => + Build_Subprogram_Id (Loc, Defining_Unit_Name (Spec)), + Asynchronous => + Nkind (Spec) = N_Procedure_Specification + and then Is_Asynchronous (Defining_Unit_Name (Spec))); + + Append_To (List_Containing (Decl), Subp_Stubs); + Analyze (Subp_Stubs); + + Current_Subprogram_Number := Current_Subprogram_Number + 1; + end Visit_Subprogram; + + procedure Visit_Spec is new Build_Package_Stubs (Visit_Subprogram); + + -- Start of processing for Add_Calling_Stubs_To_Declarations begin + Push_Scope (Scope_Of_Spec (Pkg_Spec)); + -- The first thing added is an instantiation of the generic package -- System.Partition_Interface.RCI_Locator with the name of this remote -- package. This will act as an interface with the name server to @@ -945,51 +1062,21 @@ package body Exp_Dist is RCI_Instantiation := RCI_Package_Locator (Loc, Pkg_Spec); RCI_Cache := Defining_Unit_Name (RCI_Instantiation); - Append_To (Decls, RCI_Instantiation); + Append_To (Visible_Declarations (Pkg_Spec), RCI_Instantiation); Analyze (RCI_Instantiation); -- For each subprogram declaration visible in the spec, we do build a -- body. We also increment a counter to assign a different Subprogram_Id - -- to each subprograms. The receiving stubs processing do use the same + -- to each subprograms. The receiving stubs processing uses the same -- mechanism and will thus assign the same Id and do the correct -- dispatching. Overload_Counter_Table.Reset; PolyORB_Support.Reserve_NamingContext_Methods; - Current_Declaration := First (Visible_Declarations (Pkg_Spec)); - while Present (Current_Declaration) loop - if Nkind (Current_Declaration) = N_Subprogram_Declaration - and then Comes_From_Source (Current_Declaration) - then - Assign_Subprogram_Identifier - (Defining_Unit_Name (Specification (Current_Declaration)), - Current_Subprogram_Number, - Subp_Str); - - Subp_Stubs := - Build_Subprogram_Calling_Stubs ( - Vis_Decl => Current_Declaration, - Subp_Id => - Build_Subprogram_Id (Loc, - Defining_Unit_Name (Specification (Current_Declaration))), - Asynchronous => - Nkind (Specification (Current_Declaration)) = - N_Procedure_Specification - and then - Is_Asynchronous (Defining_Unit_Name (Specification - (Current_Declaration)))); - - Append_To (Decls, Subp_Stubs); - Analyze (Subp_Stubs); - - Current_Subprogram_Number := Current_Subprogram_Number + 1; - end if; - - -- Need to handle the case of nested packages??? + Visit_Spec (Pkg_Spec); - Next (Current_Declaration); - end loop; + Pop_Scope; end Add_Calling_Stubs_To_Declarations; ----------------------------- @@ -2819,12 +2906,8 @@ package body Exp_Dist is procedure Expand_Calling_Stubs_Bodies (Unit_Node : Node_Id) is Spec : constant Node_Id := Specification (Unit_Node); - Decls : constant List_Id := Visible_Declarations (Spec); begin - Push_Scope (Scope_Of_Spec (Spec)); - Add_Calling_Stubs_To_Declarations - (Specification (Unit_Node), Decls); - Pop_Scope; + Add_Calling_Stubs_To_Declarations (Spec); end Expand_Calling_Stubs_Bodies; ----------------------------------- @@ -3685,6 +3768,7 @@ package body Exp_Dist is Pkg_RPC_Receiver_Body : Node_Id; -- A Pkg_RPC_Receiver is built to decode the request + Lookup_RAS : Node_Id; Lookup_RAS_Info : constant Entity_Id := Make_Temporary (Loc, 'R'); -- A remote subprogram is created to allow peers to look up RAS -- information using subprogram ids. @@ -3693,9 +3777,8 @@ package body Exp_Dist is Subp_Index : Entity_Id; -- Subprogram_Id as read from the incoming stream - Current_Declaration : Node_Id; - Current_Subprogram_Number : Int := First_RCI_Subprogram_Id; - Current_Stubs : Node_Id; + Current_Subp_Number : Int := First_RCI_Subprogram_Id; + Current_Stubs : Node_Id; Subp_Info_Array : constant Entity_Id := Make_Temporary (Loc, 'I'); Subp_Info_List : constant List_Id := New_List; @@ -3713,6 +3796,9 @@ package body Exp_Dist is -- associating Subprogram_Number with the subprogram declared -- by Declaration, for which we have receiving stubs in Stubs. + procedure Visit_Subprogram (Decl : Node_Id); + -- Generate receiving stub for one remote subprogram + --------------------- -- Append_Stubs_To -- --------------------- @@ -3736,6 +3822,76 @@ package body Exp_Dist is New_Occurrence_Of (Request_Parameter, Loc)))))); end Append_Stubs_To; + ---------------------- + -- Visit_Subprogram -- + ---------------------- + + procedure Visit_Subprogram (Decl : Node_Id) is + Loc : constant Source_Ptr := Sloc (Decl); + Spec : constant Node_Id := Specification (Decl); + Subp_Def : constant Entity_Id := Defining_Unit_Name (Spec); + + Subp_Val : String_Id; + pragma Warnings (Off, Subp_Val); + + begin + -- Build receiving stub + + Current_Stubs := + Build_Subprogram_Receiving_Stubs + (Vis_Decl => Decl, + Asynchronous => + Nkind (Spec) = N_Procedure_Specification + and then Is_Asynchronous (Subp_Def)); + + Append_To (Decls, Current_Stubs); + Analyze (Current_Stubs); + + -- Build RAS proxy + + Add_RAS_Proxy_And_Analyze (Decls, + Vis_Decl => Decl, + All_Calls_Remote_E => All_Calls_Remote_E, + Proxy_Object_Addr => Proxy_Object_Addr); + + -- Compute distribution identifier + + Assign_Subprogram_Identifier + (Subp_Def, Current_Subp_Number, Subp_Val); + + pragma Assert (Current_Subp_Number = Get_Subprogram_Id (Subp_Def)); + + -- Add subprogram descriptor (RCI_Subp_Info) to the subprograms + -- table for this receiver. This aggregate must be kept consistent + -- with the declaration of RCI_Subp_Info in + -- System.Partition_Interface. + + Append_To (Subp_Info_List, + Make_Component_Association (Loc, + Choices => New_List ( + Make_Integer_Literal (Loc, Current_Subp_Number)), + + Expression => + Make_Aggregate (Loc, + Component_Associations => New_List ( + + -- Addr => + + Make_Component_Association (Loc, + Choices => + New_List (Make_Identifier (Loc, Name_Addr)), + Expression => + New_Occurrence_Of (Proxy_Object_Addr, Loc)))))); + + Append_Stubs_To (Pkg_RPC_Receiver_Cases, + Stubs => Current_Stubs, + Subprogram_Number => Current_Subp_Number); + + Current_Subp_Number := Current_Subp_Number + 1; + end Visit_Subprogram; + + procedure Visit_Spec is new Build_Package_Stubs (Visit_Subprogram); + -- Start of processing for Add_Receiving_Stubs_To_Declarations begin @@ -3800,7 +3956,7 @@ package body Exp_Dist is -- Build a subprogram for RAS information lookups - Current_Declaration := + Lookup_RAS := Make_Subprogram_Declaration (Loc, Specification => Make_Function_Specification (Loc, @@ -3816,19 +3972,17 @@ 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); + Append_To (Decls, Lookup_RAS); + Analyze (Lookup_RAS); Current_Stubs := Build_Subprogram_Receiving_Stubs - (Vis_Decl => Current_Declaration, + (Vis_Decl => Lookup_RAS, Asynchronous => False); Append_To (Decls, Current_Stubs); Analyze (Current_Stubs); Append_Stubs_To (Pkg_RPC_Receiver_Cases, - Stubs => - Current_Stubs, + Stubs => Current_Stubs, Subprogram_Number => 1); -- For each subprogram, the receiving stub will be built and a @@ -3841,87 +3995,7 @@ package body Exp_Dist is Overload_Counter_Table.Reset; - Current_Declaration := First (Visible_Declarations (Pkg_Spec)); - while Present (Current_Declaration) loop - if Nkind (Current_Declaration) = N_Subprogram_Declaration - and then Comes_From_Source (Current_Declaration) - then - declare - Loc : constant Source_Ptr := Sloc (Current_Declaration); - -- While specifically processing Current_Declaration, use - -- its Sloc as the location of all generated nodes. - - Subp_Def : constant Entity_Id := - Defining_Unit_Name - (Specification (Current_Declaration)); - - Subp_Val : String_Id; - pragma Warnings (Off, Subp_Val); - - begin - -- Build receiving stub - - Current_Stubs := - Build_Subprogram_Receiving_Stubs - (Vis_Decl => Current_Declaration, - Asynchronous => - Nkind (Specification (Current_Declaration)) = - N_Procedure_Specification - and then Is_Asynchronous (Subp_Def)); - - Append_To (Decls, Current_Stubs); - Analyze (Current_Stubs); - - -- 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); - - -- Compute distribution identifier - - Assign_Subprogram_Identifier - (Subp_Def, - Current_Subprogram_Number, - Subp_Val); - - pragma Assert - (Current_Subprogram_Number = Get_Subprogram_Id (Subp_Def)); - - -- Add subprogram descriptor (RCI_Subp_Info) to the - -- subprograms table for this receiver. The aggregate - -- below must be kept consistent with the declaration - -- of type RCI_Subp_Info in System.Partition_Interface. - - Append_To (Subp_Info_List, - Make_Component_Association (Loc, - Choices => New_List ( - Make_Integer_Literal (Loc, - Current_Subprogram_Number)), - - Expression => - Make_Aggregate (Loc, - Component_Associations => New_List ( - Make_Component_Association (Loc, - Choices => New_List ( - Make_Identifier (Loc, Name_Addr)), - Expression => - New_Occurrence_Of ( - Proxy_Object_Addr, Loc)))))); - - Append_Stubs_To (Pkg_RPC_Receiver_Cases, - Stubs => Current_Stubs, - Subprogram_Number => Current_Subprogram_Number); - end; - - Current_Subprogram_Number := Current_Subprogram_Number + 1; - end if; - - -- Need to handle case of a nested package??? - - Next (Current_Declaration); - end loop; + Visit_Spec (Pkg_Spec); -- If we receive an invalid Subprogram_Id, it is best to do nothing -- rather than raising an exception since we do not want someone @@ -6654,13 +6728,10 @@ package body Exp_Dist is Dispatch_On_Address : constant List_Id := New_List; Dispatch_On_Name : constant List_Id := New_List; - Current_Declaration : Node_Id; - Current_Stubs : Node_Id; - Current_Subprogram_Number : Int := First_RCI_Subprogram_Id; + Current_Subp_Number : Int := First_RCI_Subprogram_Id; Subp_Info_Array : constant Entity_Id := Make_Temporary (Loc, 'I'); - - Subp_Info_List : constant List_Id := New_List; + Subp_Info_List : constant List_Id := New_List; Register_Pkg_Actuals : constant List_Id := New_List; @@ -6681,6 +6752,9 @@ package body Exp_Dist is -- object, used in the context of calls through remote -- access-to-subprogram types. + procedure Visit_Subprogram (Decl : Node_Id); + -- Generate receiving stub for one remote subprogram + --------------------- -- Append_Stubs_To -- --------------------- @@ -6744,6 +6818,110 @@ package body Exp_Dist is Make_Integer_Literal (Loc, Subp_Number))))); end Append_Stubs_To; + ---------------------- + -- Visit_Subprogram -- + ---------------------- + + procedure Visit_Subprogram (Decl : Node_Id) is + Loc : constant Source_Ptr := Sloc (Decl); + Spec : constant Node_Id := Specification (Decl); + Subp_Def : constant Entity_Id := Defining_Unit_Name (Spec); + + Subp_Val : String_Id; + + Subp_Dist_Name : constant Entity_Id := + Make_Defining_Identifier (Loc, + Chars => + New_External_Name + (Related_Id => Chars (Subp_Def), + Suffix => 'D', + Suffix_Index => -1)); + + Current_Stubs : Node_Id; + Proxy_Obj_Addr : Entity_Id; + + begin + -- Build receiving stub + + Current_Stubs := + Build_Subprogram_Receiving_Stubs + (Vis_Decl => Decl, + Asynchronous => + Nkind (Spec) = N_Procedure_Specification + and then Is_Asynchronous (Subp_Def)); + + Append_To (Decls, Current_Stubs); + Analyze (Current_Stubs); + + -- Build RAS proxy + + Add_RAS_Proxy_And_Analyze (Decls, + Vis_Decl => Decl, + All_Calls_Remote_E => All_Calls_Remote_E, + Proxy_Object_Addr => Proxy_Obj_Addr); + + -- Compute distribution identifier + + Assign_Subprogram_Identifier + (Subp_Def, Current_Subp_Number, Subp_Val); + + pragma Assert + (Current_Subp_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), + Expression => + Make_String_Literal (Loc, Subp_Val))); + Analyze (Last (Decls)); + + -- Add subprogram descriptor (RCI_Subp_Info) to the subprograms + -- table for this receiver. The aggregate below must be kept + -- consistent with the declaration of RCI_Subp_Info in + -- System.Partition_Interface. + + Append_To (Subp_Info_List, + Make_Component_Association (Loc, + Choices => + New_List (Make_Integer_Literal (Loc, Current_Subp_Number)), + + Expression => + Make_Aggregate (Loc, + Expressions => New_List ( + + -- Name => + + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of (Subp_Dist_Name, Loc), + Attribute_Name => Name_Address), + + -- Name_Length => + + Make_Attribute_Reference (Loc, + Prefix => + New_Occurrence_Of (Subp_Dist_Name, Loc), + Attribute_Name => Name_Length), + + -- Addr => + + New_Occurrence_Of (Proxy_Obj_Addr, Loc))))); + + Append_Stubs_To (Pkg_RPC_Receiver_Cases, + Declaration => Decl, + Stubs => Current_Stubs, + Subp_Number => Current_Subp_Number, + Subp_Dist_Name => Subp_Dist_Name, + Subp_Proxy_Addr => Proxy_Obj_Addr); + + Current_Subp_Number := Current_Subp_Number + 1; + end Visit_Subprogram; + + procedure Visit_Spec is new Build_Package_Stubs (Visit_Subprogram); + -- Start of processing for Add_Receiving_Stubs_To_Declarations begin @@ -6804,113 +6982,7 @@ package body Exp_Dist is Overload_Counter_Table.Reset; Reserve_NamingContext_Methods; - Current_Declaration := First (Visible_Declarations (Pkg_Spec)); - while Present (Current_Declaration) loop - if Nkind (Current_Declaration) = N_Subprogram_Declaration - and then Comes_From_Source (Current_Declaration) - then - declare - Loc : constant Source_Ptr := Sloc (Current_Declaration); - -- While specifically processing Current_Declaration, use - -- its Sloc as the location of all generated nodes. - - Subp_Def : constant Entity_Id := - Defining_Unit_Name - (Specification (Current_Declaration)); - - Subp_Val : String_Id; - - Subp_Dist_Name : constant Entity_Id := - Make_Defining_Identifier (Loc, - Chars => - New_External_Name - (Related_Id => Chars (Subp_Def), - Suffix => 'D', - Suffix_Index => -1)); - - Proxy_Object_Addr : Entity_Id; - - begin - -- Build receiving stub - - Current_Stubs := - Build_Subprogram_Receiving_Stubs - (Vis_Decl => Current_Declaration, - Asynchronous => - Nkind (Specification (Current_Declaration)) = - N_Procedure_Specification - and then Is_Asynchronous (Subp_Def)); - - Append_To (Decls, Current_Stubs); - Analyze (Current_Stubs); - - -- 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); - - -- Compute distribution identifier - - Assign_Subprogram_Identifier - (Subp_Def, - Current_Subprogram_Number, - Subp_Val); - - 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), - Expression => - Make_String_Literal (Loc, Subp_Val))); - Analyze (Last (Decls)); - - -- Add subprogram descriptor (RCI_Subp_Info) to the - -- subprograms table for this receiver. The aggregate - -- below must be kept consistent with the declaration - -- of type RCI_Subp_Info in System.Partition_Interface. - - Append_To (Subp_Info_List, - Make_Component_Association (Loc, - Choices => New_List ( - 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), - Attribute_Name => Name_Address), - - Make_Attribute_Reference (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, - Declaration => Current_Declaration, - Stubs => Current_Stubs, - Subp_Number => Current_Subprogram_Number, - Subp_Dist_Name => Subp_Dist_Name, - Subp_Proxy_Addr => Proxy_Object_Addr); - end; - - Current_Subprogram_Number := Current_Subprogram_Number + 1; - end if; - - -- Need to handle case of a nested package??? - - Next (Current_Declaration); - end loop; + Visit_Spec (Pkg_Spec); Append_To (Decls, Make_Object_Declaration (Loc,