Skip to content

R
riscv-gcc-1
Commit 48ab1182 by Thomas Quinot Committed by Arnaud Charlet
Options

exp_dist.adb (Build_General_Calling_Stubs): New formal parameter RACW_Type, used… 

exp_dist.adb (Build_General_Calling_Stubs): New formal parameter RACW_Type, used in the PolyORB version.

2004-10-26  Thomas Quinot  <quinot@act-europe.fr>

	* exp_dist.adb (Build_General_Calling_Stubs): New formal parameter
	RACW_Type, used in the PolyORB version.
	Rename RCI_Info to RCI_Locator, for consistency between the PolyORB
	version and the GARLIC version.

	* snames.ads, snames.adb, s-parint.ads, s-parint.adb:
	Rename RCI_Info to RCI_Locator for better consistency between the
	GARLIC and PolyORB versions of the distributed systems annex.
	(DSA_Implementation_Name): This enumeration lists the possible
	implementations of the Partition Communication Subsystem for the
	Distributed Systems Annex (DSA). The three available implementations
	are the dummy stub implementation (No_DSA), and two versions based on
	two different distribution runtime libraries: GARLIC and PolyORB. Both
	the GARLIC PCS and the PolyORB PCS are part of the GLADE distribution
	technology.
	Change the literal GLADE_DSA to GARLIC_DSA to accurately describe
	that organization.

	* rtsfind.ads: Rename RCI_Info to RCI_Locator for better consistency
	between the GARLIC and PolyORB versions of the distributed systems
	annex.
	Remove RE_Unbounded_Reclaim_Pool since it is unused.

From-SVN: r89652
parent faf3cf91
Showing with 84 additions and 71 deletions
gcc/ada/exp_dist.adb
......@@ -132,6 +132,7 @@ package body Exp_Dist is
Is_Function : Boolean;
Spec : Node_Id;
Stub_Type : Entity_Id := Empty;
RACW_Type : Entity_Id := Empty;
Nod : Node_Id);
-- Build calling stubs for general purpose. The parameters are:
-- Decls : a place to put declarations
......@@ -159,6 +160,7 @@ package body Exp_Dist is
Asynchronous : Boolean;
Dynamically_Asynchronous : Boolean := False;
Stub_Type : Entity_Id := Empty;
RACW_Type : Entity_Id := Empty;
Locator : Entity_Id := Empty;
New_Name : Name_Id := No_Name) return Node_Id;
-- Build the calling stub for a given subprogram with the subprogram ID
......@@ -220,10 +222,9 @@ package body Exp_Dist is
-- Return True if nothing prevents the program whose specification is
-- given to be asynchronous (i.e. no out parameter).
function Get_Pkg_Name_String_Id (Decl_Node : Node_Id) return String_Id;
function Get_String_Id (Val : String) return String_Id;
-- Ugly functions used to retrieve a package name. Inherited from the
-- old exp_dist.adb and not rewritten yet ???
procedure Get_Pkg_Name_String (Decl_Node : Node_Id);
-- Retrieve the fully expanded name of the library unit declared by decl
-- into the name buffer.
function Pack_Entity_Into_Stream_Access
(Loc : Source_Ptr;
......@@ -308,7 +309,7 @@ package body Exp_Dist is
Hash => Hash,
Equal => "=");
-- Mapping between a RCI package on which All_Calls_Remote applies and
-- the generic instantiation of RCI_Info for this package.
-- the generic instantiation of RCI_Locator for this package.
package RCI_Calling_Stubs_Table is
new Simple_HTable (Header_Num => Hash_Index,
......@@ -369,7 +370,7 @@ package body Exp_Dist is
function RCI_Package_Locator
(Loc : Source_Ptr;
Package_Spec : Node_Id) return Node_Id;
-- Instantiate the generic package RCI_Info in order to locate the
-- Instantiate the generic package RCI_Locator in order to locate the
-- RCI package whose spec is given as argument.
function Make_Tag_Check (Loc : Source_Ptr; N : Node_Id) return Node_Id;
......@@ -429,7 +430,7 @@ package body Exp_Dist is
begin
-- The first thing added is an instantiation of the generic package
-- System.Partition_interface.RCI_Info with the name of the (current)
-- System.Partition_interface.RCI_Locator with the name of this
-- remote package. This will act as an interface with the name server
-- to determine the Partition_ID and the RPC_Receiver for the
-- receiver of this package.
......@@ -1935,6 +1936,8 @@ package body Exp_Dist is
Subp_Info_List : constant List_Id := New_List;
Register_Pkg_Actuals : constant List_Id := New_List;
Dummy_Register_Name : Name_Id;
Dummy_Register_Spec : Node_Id;
Dummy_Register_Decl : Node_Id;
......@@ -2277,46 +2280,61 @@ package body Exp_Dist is
Make_Package_Declaration (Loc,
Specification => Dummy_Register_Spec);
Append_To (Decls,
Dummy_Register_Decl);
Append_To (Decls, Dummy_Register_Decl);
Analyze (Dummy_Register_Decl);
Dummy_Register_Body :=
Make_Package_Body (Loc,
Defining_Unit_Name =>
Make_Defining_Identifier (Loc, Dummy_Register_Name),
Declarations => No_List,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Register_Receiving_Stub), Loc),
Parameter_Associations => New_List (
Get_Pkg_Name_String (Pkg_Spec);
Append_To (Register_Pkg_Actuals,
-- Name
Make_String_Literal (Loc,
Strval => Get_Pkg_Name_String_Id (Pkg_Spec)),
Strval => String_From_Name_Buffer));
Append_To (Register_Pkg_Actuals,
-- Receiver
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Pkg_RPC_Receiver, Loc),
Attribute_Name =>
Name_Unrestricted_Access),
Name_Unrestricted_Access));
Append_To (Register_Pkg_Actuals,
-- Version
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Defining_Entity (Pkg_Spec), Loc),
Attribute_Name =>
Name_Version),
Name_Version));
Append_To (Register_Pkg_Actuals,
-- Subp_Info
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Subp_Info_Array, Loc),
Attribute_Name =>
Name_Address),
Name_Address));
Append_To (Register_Pkg_Actuals,
-- Subp_Info_Len
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Subp_Info_Array, Loc),
Attribute_Name =>
Name_Length))))));
Name_Length));
Dummy_Register_Body :=
Make_Package_Body (Loc,
Defining_Unit_Name =>
Make_Defining_Identifier (Loc, Dummy_Register_Name),
Declarations => No_List,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Register_Receiving_Stub), Loc),
Parameter_Associations => Register_Pkg_Actuals))));
Append_To (Decls, Dummy_Register_Body);
Analyze (Dummy_Register_Body);
......@@ -2473,6 +2491,7 @@ package body Exp_Dist is
Is_Function : Boolean;
Spec : Node_Id;
Stub_Type : Entity_Id := Empty;
RACW_Type : Entity_Id := Empty;
Nod : Node_Id)
is
Loc : constant Source_Ptr := Sloc (Nod);
......@@ -2502,6 +2521,9 @@ 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, RACW_Type);
-- Unreferenced formal parameter.
begin
-- The general form of a calling stub for a given subprogram is:
......@@ -3038,6 +3060,7 @@ package body Exp_Dist is
procedure Build_Passive_Partition_Stub (U : Node_Id) is
Pkg_Spec : Node_Id;
Pkg_Name : String_Id;
L : List_Id;
Reg : Node_Id;
Loc : constant Source_Ptr := Sloc (U);
......@@ -3063,12 +3086,14 @@ package body Exp_Dist is
L := Declarations (U);
end if;
Get_Pkg_Name_String (Pkg_Spec);
Pkg_Name := String_From_Name_Buffer;
Reg :=
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Register_Passive_Package), Loc),
Parameter_Associations => New_List (
Make_String_Literal (Loc, Get_Pkg_Name_String_Id (Pkg_Spec)),
Make_String_Literal (Loc, Pkg_Name),
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Defining_Entity (Pkg_Spec), Loc),
......@@ -3120,6 +3145,7 @@ package body Exp_Dist is
Asynchronous : Boolean;
Dynamically_Asynchronous : Boolean := False;
Stub_Type : Entity_Id := Empty;
RACW_Type : Entity_Id := Empty;
Locator : Entity_Id := Empty;
New_Name : Name_Id := No_Name) return Node_Id
is
......@@ -3325,6 +3351,7 @@ package body Exp_Dist is
N_Function_Specification,
Spec => Spec_To_Use,
Stub_Type => Stub_Type,
RACW_Type => RACW_Type,
Nod => Vis_Decl);
RCI_Calling_Stubs_Table.Set
......@@ -4049,11 +4076,11 @@ package body Exp_Dist is
Pop_Scope;
end Expand_Receiving_Stubs_Bodies;
----------------------------
-- Get_Pkg_Name_string_Id --
----------------------------
-------------------------
-- Get_Pkg_Name_string --
-------------------------
function Get_Pkg_Name_String_Id (Decl_Node : Node_Id) return String_Id is
procedure Get_Pkg_Name_String (Decl_Node : Node_Id) is
Unit_Name_Id : constant Unit_Name_Type := Get_Unit_Name (Decl_Node);
begin
......@@ -4063,20 +4090,7 @@ package body Exp_Dist is
Name_Len := Name_Len - 7;
pragma Assert (Name_Buffer (Name_Len + 1) = ' ');
return Get_String_Id (Name_Buffer (1 .. Name_Len));
end Get_Pkg_Name_String_Id;
-------------------
-- Get_String_Id --
-------------------
function Get_String_Id (Val : String) return String_Id is
begin
Start_String;
Store_String_Chars (Val);
return End_String;
end Get_String_Id;
end Get_Pkg_Name_String;
-----------------------
-- Get_Subprogram_Id --
......@@ -4331,21 +4345,26 @@ package body Exp_Dist is
(Loc : Source_Ptr;
Package_Spec : Node_Id) return Node_Id
is
Inst : constant Node_Id :=
Inst : Node_Id;
Pkg_Name : String_Id;
begin
Get_Pkg_Name_String (Package_Spec);
Pkg_Name := String_From_Name_Buffer;
Inst :=
Make_Package_Instantiation (Loc,
Defining_Unit_Name =>
Make_Defining_Identifier (Loc, New_Internal_Name ('R')),
Name =>
New_Occurrence_Of (RTE (RE_RCI_Info), Loc),
New_Occurrence_Of (RTE (RE_RCI_Locator), Loc),
Generic_Associations => New_List (
Make_Generic_Association (Loc,
Selector_Name =>
Make_Identifier (Loc, Name_RCI_Name),
Explicit_Generic_Actual_Parameter =>
Make_String_Literal (Loc,
Strval => Get_Pkg_Name_String_Id (Package_Spec)))));
Strval => Pkg_Name))));
begin
RCI_Locator_Table.Set (Defining_Unit_Name (Package_Spec),
Defining_Unit_Name (Inst));
return Inst;
......
gcc/ada/rtsfind.ads
......@@ -1017,7 +1017,7 @@ package Rtsfind is
RE_Raise_Program_Error_Unknown_Tag, -- System.Partition_Interface
RE_Register_Passive_Package, -- System.Partition_Interface
RE_Register_Receiving_Stub, -- System.Partition_Interface
RE_RCI_Info, -- System.Partition_Interface
RE_RCI_Locator, -- System.Partition_Interface
RE_RCI_Subp_Info, -- System.Partition_Interface
RE_RCI_Subp_Info_Array, -- System.Partition_Interface
RE_Subprogram_Id, -- System.Partition_Interface
......@@ -1025,8 +1025,6 @@ package Rtsfind is
RE_Global_Pool_Object, -- System.Pool_Global
RE_Unbounded_Reclaim_Pool, -- System.Pool_Local
RE_Stack_Bounded_Pool, -- System.Pool_Size
RE_Do_Apc, -- System.RPC
......@@ -1077,7 +1075,6 @@ package Rtsfind is
RE_Get_Local_Address, -- System.PolyORB_Interface
RE_Get_Reference, -- System.PolyORB_Interface
RE_Local_Oid_To_Address, -- System.PolyORB_Interface
RE_RCI_Locator, -- System.PolyORB_Interface
RE_Asynchronous_P_To_Sync_Scope, -- System.PolyORB_Interface
RE_Buffer_Stream_Type, -- System.PolyORB_Interface
RE_Allocate_Buffer, -- System.PolyORB_Interface
......@@ -2099,7 +2096,7 @@ package Rtsfind is
RE_Raise_Program_Error_Unknown_Tag => System_Partition_Interface,
RE_Register_Passive_Package => System_Partition_Interface,
RE_Register_Receiving_Stub => System_Partition_Interface,
RE_RCI_Info => System_Partition_Interface,
RE_RCI_Locator => System_Partition_Interface,
RE_RCI_Subp_Info => System_Partition_Interface,
RE_RCI_Subp_Info_Array => System_Partition_Interface,
RE_Subprogram_Id => System_Partition_Interface,
......@@ -2147,7 +2144,6 @@ package Rtsfind is
RE_Get_Local_Address => System_PolyORB_Interface,
RE_Get_Reference => System_PolyORB_Interface,
RE_Local_Oid_To_Address => System_PolyORB_Interface,
RE_RCI_Locator => System_PolyORB_Interface,
RE_Asynchronous_P_To_Sync_Scope => System_PolyORB_Interface,
RE_Buffer_Stream_Type => System_PolyORB_Interface,
RE_Allocate_Buffer => System_PolyORB_Interface,
......@@ -2234,8 +2230,6 @@ package Rtsfind is
RE_Global_Pool_Object => System_Pool_Global,
RE_Unbounded_Reclaim_Pool => System_Pool_Local,
RE_Stack_Bounded_Pool => System_Pool_Size,
RE_Do_Apc => System_RPC,
......
gcc/ada/s-parint.adb
......@@ -219,11 +219,11 @@ package body System.Partition_Interface is
(Program_Error'Identity, Ada.Exceptions.Exception_Message (E));
end Raise_Program_Error_Unknown_Tag;
--------------
-- RCI_Info --
--------------
-----------------
-- RCI_Locator --
-----------------
package body RCI_Info is
package body RCI_Locator is
-----------------------------
-- Get_Active_Partition_ID --
......@@ -254,7 +254,7 @@ package body System.Partition_Interface is
return 0;
end Get_RCI_Package_Receiver;
end RCI_Info;
end RCI_Locator;
------------------------------
-- Register_Passive_Package --
......
gcc/ada/s-parint.ads
......@@ -42,7 +42,7 @@ package System.Partition_Interface is
pragma Elaborate_Body;
type DSA_Implementation_Name is (No_DSA, GLADE_DSA, PolyORB_DSA);
type DSA_Implementation_Name is (No_DSA, GARLIC_DSA, PolyORB_DSA);
DSA_Implementation : constant DSA_Implementation_Name := No_DSA;
-- RCI receiving stubs contain a table of descriptors for
......@@ -97,7 +97,7 @@ package System.Partition_Interface is
-- unit has has the same version than the caller's one.
function Get_Active_Partition_ID (Name : Unit_Name) return RPC.Partition_ID;
-- Similar in some respects to RCI_Info.Get_Active_Partition_ID
-- Similar in some respects to RCI_Locator.Get_Active_Partition_ID
function Get_Active_Version (Name : Unit_Name) return String;
-- Similar in some respects to Get_Active_Partition_ID
......@@ -114,7 +114,7 @@ package System.Partition_Interface is
function Get_RCI_Package_Receiver
(Name : Unit_Name) return Interfaces.Unsigned_64;
-- Similar in some respects to RCI_Info.Get_RCI_Package_Receiver
-- Similar in some respects to RCI_Locator.Get_RCI_Package_Receiver
procedure Get_Unique_Remote_Pointer
(Handler : in out RACW_Stub_Type_Access);
......@@ -149,10 +149,10 @@ package System.Partition_Interface is
generic
RCI_Name : String;
package RCI_Info is
package RCI_Locator is
function Get_RCI_Package_Receiver return Interfaces.Unsigned_64;
function Get_Active_Partition_ID return RPC.Partition_ID;
end RCI_Info;
end RCI_Locator;
-- RCI package information caching
procedure Run (Main : Main_Subprogram_Type := null);
......
gcc/ada/snames.adb
......@@ -122,7 +122,7 @@ package body Snames is
"text_io#" &
"wide_text_io#" &
"no_dsa#" &
"glade_dsa#" &
"garlic_dsa#" &
"polyorb_dsa#" &
"addr#" &
"async#" &
......
gcc/ada/snames.ads
......@@ -238,7 +238,7 @@ package Snames is
-- Names of implementations of the distributed systems annex
Name_No_DSA : constant Name_Id := N + 064;
Name_GLADE_DSA : constant Name_Id := N + 065;
Name_GARLIC_DSA : constant Name_Id := N + 065;
Name_PolyORB_DSA : constant Name_Id := N + 066;
-- Names of identifiers used in expanding distribution stubs
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment