summaryrefslogtreecommitdiff
path: root/gcc/ada/exp_dist.adb
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2010-10-25 15:26:02 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2010-10-25 15:26:02 +0000
commit7edd507100cac168bcb4900951e44a515fca9c91 (patch)
treedbc2802781e13245b9de316aac743d8ec5a7862b /gcc/ada/exp_dist.adb
parentd7c2851fa475530f0e445e154ccacb9e5413388a (diff)
downloadgcc-7edd507100cac168bcb4900951e44a515fca9c91.tar.gz
2010-10-25 Pascal Obry <obry@adacore.com>
* adaint.c (__gnat_file_time_name_attr): Use GetFileAttributesEx to get the timestamp. A bit faster than opening/closing the file. (__gnat_stat_to_attr): Remove kludge for Windows. (__gnat_file_exists_attr): Likewise. The timestamp is now retreived using GetFileAttributesEx as faster. 2010-10-25 Javier Miranda <miranda@adacore.com> * sem_ch3.adb (Derive_Interface_Subprogram): New subprogram. (Derive_Subprograms): For abstract private types transfer to the full view entities of uncovered interface primitives. Required because if the interface primitives are left in the private part of the package they will be decorated as hidden when the analysis of the enclosing package completes (and hence the interface primitive is not visible for dispatching calls). 2010-10-25 Matthew Heaney <heaney@adacore.com> * Makefile.rtl, impunit.adb: Added bounded set and bounded map containers. * a-crbltr.ads: Added declaration of generic package for bounded tree types. * a-rbtgbo.ads, a-rbtgbo.adb, a-rbtgbk.ads, a-rbtgbk.adb, a-btgbso.ads, a-btgbso.adb, a-cborse.ads, a-cborse.adb, a-cborma.ads, a-cborma.adb: New. 2010-10-25 Thomas Quinot <quinot@adacore.com> * sem_util.adb: Minor reformatting. * usage.adb: Fix usage line for -gnatwh. 2010-10-25 Thomas Quinot <quinot@adacore.com> * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165920 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/exp_dist.adb')
-rw-r--r--gcc/ada/exp_dist.adb580
1 files changed, 326 insertions, 254 deletions
diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb
index fb91ce7a47a..3ad20602b38 100644
--- a/gcc/ada/exp_dist.adb
+++ b/gcc/ada/exp_dist.adb
@@ -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;
+ Visit_Spec (Pkg_Spec);
- -- Need to handle the case of nested packages???
-
- 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,