Skip to content

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

exp_dist.adb (PolyORB_Support.Build_TypeCode_Function): When creating typecode… 

exp_dist.adb (PolyORB_Support.Build_TypeCode_Function): When creating typecode parameters for a union (in a variant record)...

2007-08-14  Thomas Quinot  <quinot@adacore.com>

	* exp_dist.adb (PolyORB_Support.Build_TypeCode_Function): When creating
	typecode parameters for a union (in a variant record), remove
	extraneous layer of Any wrapping for member label.
	(Expand_Receiving_Stubs_Bodies): For an RCI package body that has
	elabration statements, register the package with the name server
	at the beginning, not at the end, of the elaboration statements so
	that they can create remote access to subprogram values that designate
	remote subprograms from the package.

From-SVN: r127449
parent 9f6ea00a
Showing with 127 additions and 132 deletions
gcc/ada/exp_dist.adb
...@@ -489,11 +489,12 @@ package body Exp_Dist is ...@@ -489,11 +489,12 @@ package body Exp_Dist is
type RPC_Target (PCS_Kind : PCS_Names) is record type RPC_Target (PCS_Kind : PCS_Names) is record
case PCS_Kind is case PCS_Kind is
when Name_PolyORB_DSA => when Name_PolyORB_DSA =>
Object : Node_Id; Object : Node_Id;
-- An expression whose value is a PolyORB reference to the target -- An expression whose value is a PolyORB reference to the target
-- object. -- object.
when others => when others =>
Partition : Entity_Id; Partition : Entity_Id;
-- A variable containing the Partition_ID of the target parition -- A variable containing the Partition_ID of the target parition
RPC_Receiver : Node_Id; RPC_Receiver : Node_Id;
...@@ -605,9 +606,8 @@ package body Exp_Dist is ...@@ -605,9 +606,8 @@ package body Exp_Dist is
-- Support for generating DSA code that uses the GARLIC PCS -- Support for generating DSA code that uses the GARLIC PCS
-- The subprograms below provide the GARLIC versions of -- The subprograms below provide the GARLIC versions of the
-- the corresponding Specific_<subprogram> routine declared -- corresponding Specific_<subprogram> routine declared above.
-- above.
procedure Add_RACW_Features procedure Add_RACW_Features
(RACW_Type : Entity_Id; (RACW_Type : Entity_Id;
...@@ -642,8 +642,8 @@ package body Exp_Dist is ...@@ -642,8 +642,8 @@ package body Exp_Dist is
Controlling_Parameter : Entity_Id) return RPC_Target; Controlling_Parameter : Entity_Id) return RPC_Target;
procedure Build_Stub_Type procedure Build_Stub_Type
(RACW_Type : Entity_Id; (RACW_Type : Entity_Id;
Stub_Type : Entity_Id; Stub_Type : Entity_Id;
Stub_Type_Decl : out Node_Id; Stub_Type_Decl : out Node_Id;
RPC_Receiver_Decl : out Node_Id); RPC_Receiver_Decl : out Node_Id);
...@@ -680,9 +680,8 @@ package body Exp_Dist is ...@@ -680,9 +680,8 @@ package body Exp_Dist is
-- Support for generating DSA code that uses the PolyORB PCS -- Support for generating DSA code that uses the PolyORB PCS
-- The subprograms below provide the PolyORB versions of -- The subprograms below provide the PolyORB versions of the
-- the corresponding Specific_<subprogram> routine declared -- corresponding Specific_<subprogram> routine declared above.
-- above.
procedure Add_RACW_Features procedure Add_RACW_Features
(RACW_Type : Entity_Id; (RACW_Type : Entity_Id;
...@@ -763,13 +762,15 @@ package body Exp_Dist is ...@@ -763,13 +762,15 @@ package body Exp_Dist is
-- over the PolyORB generic middleware components, it is necessary to -- over the PolyORB generic middleware components, it is necessary to
-- generate several supporting subprograms for each application data -- generate several supporting subprograms for each application data
-- type used in inter-partition communication. These subprograms are: -- type used in inter-partition communication. These subprograms are:
-- * a Typecode function returning a high-level description of the
-- type's structure; -- A Typecode function returning a high-level description of the
-- * two conversion functions allowing conversion of values of the -- type's structure;
-- type from and to the generic data containers used by PolyORB.
-- These generic containers are called 'Any' type values after -- Two conversion functions allowing conversion of values of the
-- the CORBA terminology, and hence the conversion subprograms -- type from and to the generic data containers used by PolyORB.
-- are named To_Any and From_Any. -- These generic containers are called 'Any' type values after the
-- CORBA terminology, and hence the conversion subprograms are
-- named To_Any and From_Any.
function Build_From_Any_Call function Build_From_Any_Call
(Typ : Entity_Id; (Typ : Entity_Id;
...@@ -871,18 +872,18 @@ package body Exp_Dist is ...@@ -871,18 +872,18 @@ package body Exp_Dist is
-- Subprogram id 0 is reserved for calls received from -- Subprogram id 0 is reserved for calls received from
-- remote access-to-subprogram dereferences. -- remote access-to-subprogram dereferences.
Current_Declaration : Node_Id; Current_Declaration : Node_Id;
Loc : constant Source_Ptr := Sloc (Pkg_Spec); Loc : constant Source_Ptr := Sloc (Pkg_Spec);
RCI_Instantiation : Node_Id; RCI_Instantiation : Node_Id;
Subp_Stubs : Node_Id; Subp_Stubs : Node_Id;
Subp_Str : String_Id; Subp_Str : String_Id;
begin begin
-- The first thing added is an instantiation of the generic package -- The first thing added is an instantiation of the generic package
-- System.Partition_Interface.RCI_Locator with the name of this -- System.Partition_Interface.RCI_Locator with the name of this remote
-- remote package. This will act as an interface with the name server -- package. This will act as an interface with the name server to
-- to determine the Partition_ID and the RPC_Receiver for the -- determine the Partition_ID and the RPC_Receiver for the receiver
-- receiver of this package. -- of this package.
RCI_Instantiation := RCI_Package_Locator (Loc, Pkg_Spec); RCI_Instantiation := RCI_Package_Locator (Loc, Pkg_Spec);
RCI_Cache := Defining_Unit_Name (RCI_Instantiation); RCI_Cache := Defining_Unit_Name (RCI_Instantiation);
...@@ -890,11 +891,11 @@ package body Exp_Dist is ...@@ -890,11 +891,11 @@ package body Exp_Dist is
Append_To (Decls, RCI_Instantiation); Append_To (Decls, RCI_Instantiation);
Analyze (RCI_Instantiation); Analyze (RCI_Instantiation);
-- For each subprogram declaration visible in the spec, we do -- For each subprogram declaration visible in the spec, we do build a
-- build a body. We also increment a counter to assign a different -- body. We also increment a counter to assign a different Subprogram_Id
-- Subprogram_Id to each subprograms. The receiving stubs processing -- to each subprograms. The receiving stubs processing do use the same
-- do use the same mechanism and will thus assign the same Id and -- mechanism and will thus assign the same Id and do the correct
-- do the correct dispatching. -- dispatching.
Overload_Counter_Table.Reset; Overload_Counter_Table.Reset;
PolyORB_Support.Reserve_NamingContext_Methods; PolyORB_Support.Reserve_NamingContext_Methods;
...@@ -994,8 +995,7 @@ package body Exp_Dist is ...@@ -994,8 +995,7 @@ package body Exp_Dist is
if Nkind (Parameter) = N_Defining_Identifier then if Nkind (Parameter) = N_Defining_Identifier then
Get_Name_String (Chars (Parameter)); Get_Name_String (Chars (Parameter));
else else
Get_Name_String (Chars (Defining_Identifier Get_Name_String (Chars (Defining_Identifier (Parameter)));
(Parameter)));
end if; end if;
Parameter_Name_String := String_From_Name_Buffer; Parameter_Name_String := String_From_Name_Buffer;
...@@ -1010,8 +1010,8 @@ package body Exp_Dist is ...@@ -1010,8 +1010,8 @@ package body Exp_Dist is
Parameter_Mode := New_Occurrence_Of (RTE (RE_Mode_In), Loc); Parameter_Mode := New_Occurrence_Of (RTE (RE_Mode_In), Loc);
else else
Parameter_Mode := Parameter_Passing_Mode (Loc, Parameter_Mode :=
Parameter, Constrained); Parameter_Passing_Mode (Loc, Parameter, Constrained);
end if; end if;
return return
...@@ -1166,6 +1166,7 @@ package body Exp_Dist is ...@@ -1166,6 +1166,7 @@ package body Exp_Dist is
else else
-- Validate_RACW_Primitives will be called when the designated type -- Validate_RACW_Primitives will be called when the designated type
-- is frozen, see Exp_Ch3.Freeze_Type. -- is frozen, see Exp_Ch3.Freeze_Type.
-- ??? Shouldn't we have a pragma Assert (not Is_Frozen (Desig))? -- ??? Shouldn't we have a pragma Assert (not Is_Frozen (Desig))?
Add_Access_Type_To_Process (E => Desig, A => RACW_Type); Add_Access_Type_To_Process (E => Desig, A => RACW_Type);
...@@ -1218,15 +1219,11 @@ package body Exp_Dist is ...@@ -1218,15 +1219,11 @@ package body Exp_Dist is
Current_Primitive_Spec : Node_Id; Current_Primitive_Spec : Node_Id;
Current_Primitive_Decl : Node_Id; Current_Primitive_Decl : Node_Id;
Current_Primitive_Number : Int := 0; Current_Primitive_Number : Int := 0;
Current_Primitive_Alias : Node_Id;
Current_Primitive_Alias : Node_Id; Current_Receiver : Entity_Id;
Current_Receiver_Body : Node_Id;
Current_Receiver : Entity_Id; RPC_Receiver_Decl : Node_Id;
Current_Receiver_Body : Node_Id; Possibly_Asynchronous : Boolean;
RPC_Receiver_Decl : Node_Id;
Possibly_Asynchronous : Boolean;
begin begin
if not Expander_Active then if not Expander_Active then
...@@ -1234,15 +1231,16 @@ package body Exp_Dist is ...@@ -1234,15 +1231,16 @@ package body Exp_Dist is
end if; end if;
if not Is_RAS then if not Is_RAS then
RPC_Receiver := Make_Defining_Identifier (Loc, RPC_Receiver :=
New_Internal_Name ('P')); Make_Defining_Identifier (Loc,
Specific_Build_RPC_Receiver_Body ( Chars => New_Internal_Name ('P'));
RPC_Receiver => RPC_Receiver, Specific_Build_RPC_Receiver_Body
Request => RPC_Receiver_Request, (RPC_Receiver => RPC_Receiver,
Subp_Id => RPC_Receiver_Subp_Id, Request => RPC_Receiver_Request,
Subp_Index => RPC_Receiver_Subp_Index, Subp_Id => RPC_Receiver_Subp_Id,
Stmts => RPC_Receiver_Statements, Subp_Index => RPC_Receiver_Subp_Index,
Decl => RPC_Receiver_Decl); Stmts => RPC_Receiver_Statements,
Decl => RPC_Receiver_Decl);
if Get_PCS_Name = Name_PolyORB_DSA then if Get_PCS_Name = Name_PolyORB_DSA then
...@@ -1336,10 +1334,10 @@ package body Exp_Dist is ...@@ -1336,10 +1334,10 @@ package body Exp_Dist is
RACW_Type => Stub_Elements.RACW_Type); RACW_Type => Stub_Elements.RACW_Type);
Append_To (Body_Decls, Current_Primitive_Body); Append_To (Body_Decls, Current_Primitive_Body);
-- Analyzing the body here would cause the Stub type to be -- Analyzing the body here would cause the Stub type to
-- frozen, thus preventing subsequent primitive -- be frozen, thus preventing subsequent primitive
-- declarations. For this reason, it will be analyzed later -- declarations. For this reason, it will be analyzed
-- in the regular flow (and in the context of the -- later in the regular flow (and in the context of the
-- appropriate unit body, see Append_RACW_Bodies). -- appropriate unit body, see Append_RACW_Bodies).
end if; end if;
...@@ -1447,8 +1445,7 @@ package body Exp_Dist is ...@@ -1447,8 +1445,7 @@ package body Exp_Dist is
procedure Add_RAS_Dereference_TSS (N : Node_Id) is procedure Add_RAS_Dereference_TSS (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
Type_Def : constant Node_Id := Type_Definition (N); Type_Def : constant Node_Id := Type_Definition (N);
RAS_Type : constant Entity_Id := Defining_Identifier (N); RAS_Type : constant Entity_Id := Defining_Identifier (N);
Fat_Type : constant Entity_Id := Equivalent_Type (RAS_Type); Fat_Type : constant Entity_Id := Equivalent_Type (RAS_Type);
RACW_Type : constant Entity_Id := Underlying_RACW_Type (RAS_Type); RACW_Type : constant Entity_Id := Underlying_RACW_Type (RAS_Type);
...@@ -1540,9 +1537,9 @@ package body Exp_Dist is ...@@ -1540,9 +1537,9 @@ package body Exp_Dist is
-- Generate a dummy body. This code will never actually be executed, -- Generate a dummy body. This code will never actually be executed,
-- because null is the only legal value for a degenerate RAS type. -- because null is the only legal value for a degenerate RAS type.
-- For legality's sake (in order to avoid generating a function -- For legality's sake (in order to avoid generating a function that
-- that does not contain a return statement), we include a dummy -- does not contain a return statement), we include a dummy recursive
-- recursive call on the TSS itself. -- call on the TSS itself.
Append_To (Stmts, Append_To (Stmts,
Make_Raise_Program_Error (Loc, Reason => PE_Explicit_Raise)); Make_Raise_Program_Error (Loc, Reason => PE_Explicit_Raise));
...@@ -1565,7 +1562,7 @@ package body Exp_Dist is ...@@ -1565,7 +1562,7 @@ package body Exp_Dist is
if Is_Function then if Is_Function then
Append_To (Stmts, Append_To (Stmts,
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => Expression =>
Make_Function_Call (Loc, Make_Function_Call (Loc,
Name => RACW_Primitive_Name, Name => RACW_Primitive_Name,
...@@ -1736,7 +1733,7 @@ package body Exp_Dist is ...@@ -1736,7 +1733,7 @@ package body Exp_Dist is
Actuals); Actuals);
else else
Perform_Call := Perform_Call :=
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => Expression =>
Make_Function_Call (Loc, Make_Function_Call (Loc,
Name => Name =>
...@@ -1853,18 +1850,18 @@ package body Exp_Dist is ...@@ -1853,18 +1850,18 @@ package body Exp_Dist is
return; return;
end if; end if;
Existing := False; Existing := False;
Stub_Type := Stub_Type :=
Make_Defining_Identifier (Loc, New_Internal_Name ('S')); Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('S'));
Stub_Type_Access := Stub_Type_Access :=
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
New_External_Name ( Chars => New_External_Name
Related_Id => Chars (Stub_Type), (Related_Id => Chars (Stub_Type), Suffix => 'A'));
Suffix => 'A'));
Specific_Build_Stub_Type ( Specific_Build_Stub_Type
RACW_Type, Stub_Type, (RACW_Type, Stub_Type,
Stub_Type_Decl, RPC_Receiver_Decl); Stub_Type_Decl, RPC_Receiver_Decl);
Stub_Type_Access_Decl := Stub_Type_Access_Decl :=
Make_Full_Type_Declaration (Loc, Make_Full_Type_Declaration (Loc,
...@@ -1908,7 +1905,6 @@ package body Exp_Dist is ...@@ -1908,7 +1905,6 @@ package body Exp_Dist is
procedure Append_RACW_Bodies (Decls : List_Id; Spec_Id : Entity_Id) is procedure Append_RACW_Bodies (Decls : List_Id; Spec_Id : Entity_Id) is
E : Entity_Id; E : Entity_Id;
begin begin
E := First_Entity (Spec_Id); E := First_Entity (Spec_Id);
while Present (E) loop while Present (E) loop
...@@ -2766,9 +2762,10 @@ package body Exp_Dist is ...@@ -2766,9 +2762,10 @@ package body Exp_Dist is
----------------------------------- -----------------------------------
procedure Expand_Receiving_Stubs_Bodies (Unit_Node : Node_Id) is procedure Expand_Receiving_Stubs_Bodies (Unit_Node : Node_Id) is
Spec : Node_Id; Spec : Node_Id;
Decls : List_Id; Decls : List_Id;
Temp : List_Id; Stubs_Decls : List_Id;
Stubs_Stmts : List_Id;
begin begin
if Nkind (Unit_Node) = N_Package_Declaration then if Nkind (Unit_Node) = N_Package_Declaration then
...@@ -2780,18 +2777,32 @@ package body Exp_Dist is ...@@ -2780,18 +2777,32 @@ package body Exp_Dist is
end if; end if;
Push_Scope (Scope_Of_Spec (Spec)); Push_Scope (Scope_Of_Spec (Spec));
Specific_Add_Receiving_Stubs_To_Declarations Specific_Add_Receiving_Stubs_To_Declarations (Spec, Decls, Decls);
(Spec, Decls, Decls);
else else
Spec := Spec :=
Package_Specification_Of_Scope (Corresponding_Spec (Unit_Node)); Package_Specification_Of_Scope (Corresponding_Spec (Unit_Node));
Decls := Declarations (Unit_Node); Decls := Declarations (Unit_Node);
Push_Scope (Scope_Of_Spec (Unit_Node)); Push_Scope (Scope_Of_Spec (Unit_Node));
Temp := New_List; Stubs_Decls := New_List;
Stubs_Stmts := New_List;
Specific_Add_Receiving_Stubs_To_Declarations Specific_Add_Receiving_Stubs_To_Declarations
(Spec, Temp, Statements (Handled_Statement_Sequence (Unit_Node))); (Spec, Stubs_Decls, Stubs_Stmts);
Insert_List_Before (First (Decls), Temp);
Insert_List_Before (First (Decls), Stubs_Decls);
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);
else
Insert_List_Before (First_HSS_Stmt, Stubs_Stmts);
end if;
end;
end if; end if;
Pop_Scope; Pop_Scope;
...@@ -3034,7 +3045,7 @@ package body Exp_Dist is ...@@ -3034,7 +3045,7 @@ package body Exp_Dist is
Make_Assignment_Statement (Loc, Make_Assignment_Statement (Loc,
Name => Result, Name => Result,
Expression => Make_Null (Loc)), Expression => Make_Null (Loc)),
Make_Return_Statement (Loc)))); Make_Simple_Return_Statement (Loc))));
-- If the RACW denotes an object created on the current partition, -- If the RACW denotes an object created on the current partition,
-- Local_Statements will be executed. The real object will be used. -- Local_Statements will be executed. The real object will be used.
...@@ -3464,7 +3475,7 @@ package body Exp_Dist is ...@@ -3464,7 +3475,7 @@ package body Exp_Dist is
Make_Op_Not (Loc, Make_Op_Not (Loc,
New_Occurrence_Of (All_Calls_Remote, Loc))), New_Occurrence_Of (All_Calls_Remote, Loc))),
Then_Statements => New_List ( Then_Statements => New_List (
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Unchecked_Convert_To (Fat_Type, Unchecked_Convert_To (Fat_Type,
OK_Convert_To (RTE (RE_Address), OK_Convert_To (RTE (RE_Address),
New_Occurrence_Of (Proxy_Addr, Loc)))))), New_Occurrence_Of (Proxy_Addr, Loc)))))),
...@@ -3501,7 +3512,7 @@ package body Exp_Dist is ...@@ -3501,7 +3512,7 @@ package body Exp_Dist is
-- Return the newly created value -- Return the newly created value
Append_To (Proc_Statements, Append_To (Proc_Statements,
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => Expression =>
Unchecked_Convert_To (Fat_Type, Unchecked_Convert_To (Fat_Type,
New_Occurrence_Of (Stub_Ptr, Loc)))); New_Occurrence_Of (Stub_Ptr, Loc))));
...@@ -3924,7 +3935,7 @@ package body Exp_Dist is ...@@ -3924,7 +3935,7 @@ package body Exp_Dist is
Handled_Statement_Sequence => Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc, Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List ( Statements => New_List (
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => Expression =>
OK_Convert_To (RTE (RE_Unsigned_64), OK_Convert_To (RTE (RE_Unsigned_64),
Subp_Info_Addr)))))); Subp_Info_Addr))))));
...@@ -4333,7 +4344,7 @@ package body Exp_Dist is ...@@ -4333,7 +4344,7 @@ package body Exp_Dist is
Append_To (Non_Asynchronous_Statements, Append_To (Non_Asynchronous_Statements,
Make_Tag_Check (Loc, Make_Tag_Check (Loc,
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => Expression =>
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => Prefix =>
...@@ -5218,7 +5229,7 @@ package body Exp_Dist is ...@@ -5218,7 +5229,7 @@ package body Exp_Dist is
Handled_Statement_Sequence => Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc, New_List ( Make_Handled_Sequence_Of_Statements (Loc, New_List (
Make_Tag_Check (Loc, Make_Tag_Check (Loc,
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Var_Type, Loc), Prefix => New_Occurrence_Of (Var_Type, Loc),
Attribute_Name => Name_Input, Attribute_Name => Name_Input,
...@@ -5680,7 +5691,7 @@ package body Exp_Dist is ...@@ -5680,7 +5691,7 @@ package body Exp_Dist is
Parameter_Associations => New_List ( Parameter_Associations => New_List (
New_Occurrence_Of (Reference, Loc))), New_Occurrence_Of (Reference, Loc))),
Then_Statements => New_List ( Then_Statements => New_List (
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => Expression =>
Make_Null (Loc))))); Make_Null (Loc)))));
...@@ -5760,7 +5771,7 @@ package body Exp_Dist is ...@@ -5760,7 +5771,7 @@ package body Exp_Dist is
end if; end if;
Local_Statements := New_List ( Local_Statements := New_List (
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => Expression =>
Unchecked_Convert_To (RACW_Type, Unchecked_Convert_To (RACW_Type,
New_Occurrence_Of (Addr, Loc)))); New_Occurrence_Of (Addr, Loc))));
...@@ -5773,7 +5784,7 @@ package body Exp_Dist is ...@@ -5773,7 +5784,7 @@ package body Exp_Dist is
Else_Statements => Stub_Statements)); Else_Statements => Stub_Statements));
Append_To (Statements, Append_To (Statements,
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => Unchecked_Convert_To (RACW_Type, Expression => Unchecked_Convert_To (RACW_Type,
New_Occurrence_Of (Stubbed_Result, Loc)))); New_Occurrence_Of (Stubbed_Result, Loc))));
...@@ -6084,7 +6095,7 @@ package body Exp_Dist is ...@@ -6084,7 +6095,7 @@ package body Exp_Dist is
Defining_Identifier ( Defining_Identifier (
Stub_Elements.RPC_Receiver_Decl), Stub_Elements.RPC_Receiver_Decl),
Selector_Name => Name_Obj_TypeCode))), Selector_Name => Name_Obj_TypeCode))),
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => Expression =>
New_Occurrence_Of (Any, Loc))); New_Occurrence_Of (Any, Loc)));
...@@ -6171,7 +6182,7 @@ package body Exp_Dist is ...@@ -6171,7 +6182,7 @@ package body Exp_Dist is
Handled_Statement_Sequence => Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc, Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List ( Statements => New_List (
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => Expression =>
Make_Selected_Component (Loc, Make_Selected_Component (Loc,
Prefix => Prefix =>
...@@ -6532,7 +6543,7 @@ package body Exp_Dist is ...@@ -6532,7 +6543,7 @@ package body Exp_Dist is
New_Occurrence_Of (All_Calls_Remote, Loc)), New_Occurrence_Of (All_Calls_Remote, Loc)),
Then_Statements => New_List ( Then_Statements => New_List (
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Unchecked_Convert_To (Fat_Type, Unchecked_Convert_To (Fat_Type,
New_Occurrence_Of (Local_Addr, Loc)))))))); New_Occurrence_Of (Local_Addr, Loc))))))));
...@@ -6575,7 +6586,7 @@ package body Exp_Dist is ...@@ -6575,7 +6586,7 @@ package body Exp_Dist is
Stub_Ptr, Stub_Elements.Stub_Type)); Stub_Ptr, Stub_Elements.Stub_Type));
Append_To (Proc_Statements, Append_To (Proc_Statements,
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => Expression =>
Unchecked_Convert_To (Fat_Type, Unchecked_Convert_To (Fat_Type,
New_Occurrence_Of (Stub_Ptr, Loc)))); New_Occurrence_Of (Stub_Ptr, Loc))));
...@@ -6643,7 +6654,7 @@ package body Exp_Dist is ...@@ -6643,7 +6654,7 @@ package body Exp_Dist is
begin begin
Statements := New_List ( Statements := New_List (
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => Expression =>
Make_Aggregate (Loc, Make_Aggregate (Loc,
Component_Associations => New_List ( Component_Associations => New_List (
...@@ -6726,7 +6737,7 @@ package body Exp_Dist is ...@@ -6726,7 +6737,7 @@ package body Exp_Dist is
New_Occurrence_Of (Any, Loc), New_Occurrence_Of (Any, Loc),
PolyORB_Support.Helpers.Build_TypeCode_Call (Loc, PolyORB_Support.Helpers.Build_TypeCode_Call (Loc,
RAS_Type, Decls))), RAS_Type, Decls))),
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => Expression =>
New_Occurrence_Of (Any, Loc))); New_Occurrence_Of (Any, Loc)));
...@@ -6784,7 +6795,7 @@ package body Exp_Dist is ...@@ -6784,7 +6795,7 @@ package body Exp_Dist is
Handled_Statement_Sequence => Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc, Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List ( Statements => New_List (
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => Expression =>
Make_Function_Call (Loc, Make_Function_Call (Loc,
Name => Name =>
...@@ -6907,7 +6918,7 @@ package body Exp_Dist is ...@@ -6907,7 +6918,7 @@ package body Exp_Dist is
or else not or else not
Is_Asynchronous (Defining_Entity (Specification (Declaration))) Is_Asynchronous (Defining_Entity (Specification (Declaration)))
then then
Append_To (Case_Stmts, Make_Return_Statement (Loc)); Append_To (Case_Stmts, Make_Simple_Return_Statement (Loc));
end if; end if;
Append_To (RPC_Receiver_Cases, Append_To (RPC_Receiver_Cases,
...@@ -7685,7 +7696,7 @@ package body Exp_Dist is ...@@ -7685,7 +7696,7 @@ package body Exp_Dist is
Append_To (Non_Asynchronous_Statements, Append_To (Non_Asynchronous_Statements,
Make_Tag_Check (Loc, Make_Tag_Check (Loc,
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
PolyORB_Support.Helpers.Build_From_Any_Call ( PolyORB_Support.Helpers.Build_From_Any_Call (
Etype (Result_Definition (Spec)), Etype (Result_Definition (Spec)),
Make_Selected_Component (Loc, Make_Selected_Component (Loc,
...@@ -8703,7 +8714,7 @@ package body Exp_Dist is ...@@ -8703,7 +8714,7 @@ package body Exp_Dist is
and then not Is_Tagged_Type (Typ) and then not Is_Tagged_Type (Typ)
then then
Append_To (Stms, Append_To (Stms,
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => Expression =>
OK_Convert_To ( OK_Convert_To (
Typ, Typ,
...@@ -8718,7 +8729,7 @@ package body Exp_Dist is ...@@ -8718,7 +8729,7 @@ package body Exp_Dist is
then then
if Nkind (Declaration_Node (Typ)) = N_Subtype_Declaration then if Nkind (Declaration_Node (Typ)) = N_Subtype_Declaration then
Append_To (Stms, Append_To (Stms,
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => Expression =>
OK_Convert_To ( OK_Convert_To (
Typ, Typ,
...@@ -8955,7 +8966,7 @@ package body Exp_Dist is ...@@ -8955,7 +8966,7 @@ package body Exp_Dist is
Counter => Component_Counter); Counter => Component_Counter);
Append_To (Stms, Append_To (Stms,
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => New_Occurrence_Of (Res, Loc))); Expression => New_Occurrence_Of (Res, Loc)));
end; end;
end if; end if;
...@@ -9202,13 +9213,13 @@ package body Exp_Dist is ...@@ -9202,13 +9213,13 @@ package body Exp_Dist is
Any_Parameter, Counter); Any_Parameter, Counter);
Append_To (Stms, Append_To (Stms,
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => New_Occurrence_Of (Res, Loc))); Expression => New_Occurrence_Of (Res, Loc)));
end; end;
elsif Is_Integer_Type (Typ) or else Is_Unsigned_Type (Typ) then elsif Is_Integer_Type (Typ) or else Is_Unsigned_Type (Typ) then
Append_To (Stms, Append_To (Stms,
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => Expression =>
Unchecked_Convert_To ( Unchecked_Convert_To (
Typ, Typ,
...@@ -9291,7 +9302,7 @@ package body Exp_Dist is ...@@ -9291,7 +9302,7 @@ package body Exp_Dist is
Parameter_Associations => Parameter_Associations =>
New_List ( New_List (
New_Occurrence_Of (Strm, Loc))), New_Occurrence_Of (Strm, Loc))),
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => New_Occurrence_Of (Res, Loc)))))); Expression => New_Occurrence_Of (Res, Loc))))));
end; end;
...@@ -10081,7 +10092,7 @@ package body Exp_Dist is ...@@ -10081,7 +10092,7 @@ package body Exp_Dist is
end if; end if;
Append_To (Stms, Append_To (Stms,
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => New_Occurrence_Of (Any, Loc))); Expression => New_Occurrence_Of (Any, Loc)));
Decl := Decl :=
...@@ -10384,7 +10395,7 @@ package body Exp_Dist is ...@@ -10384,7 +10395,7 @@ package body Exp_Dist is
procedure Return_Constructed_TypeCode (Kind : Entity_Id) is procedure Return_Constructed_TypeCode (Kind : Entity_Id) is
begin begin
Append_To (Stms, Append_To (Stms,
Make_Return_Statement (Loc, Make_Simple_Return_Statement (Loc,
Expression => Expression =>
Make_Constructed_TypeCode (Kind, Parameters))); Make_Constructed_TypeCode (Kind, Parameters)));
end Return_Constructed_TypeCode; end Return_Constructed_TypeCode;
...@@ -10549,13 +10560,7 @@ package body Exp_Dist is ...@@ -10549,13 +10560,7 @@ package body Exp_Dist is
Make_Integer_Literal (Loc, J); Make_Integer_Literal (Loc, J);
end if; end if;
Append_To (Union_TC_Params, Append_To (Union_TC_Params,
Make_Function_Call (Loc, Build_To_Any_Call (Expr, Decls));
Name => New_Occurrence_Of
(RTE (RE_TA_A), Loc),
Parameter_Associations =>
New_List (
Build_To_Any_Call
(Expr, Decls))));
Add_Params_For_Variant_Components; Add_Params_For_Variant_Components;
J := J + Uint_1; J := J + Uint_1;
...@@ -10593,8 +10598,7 @@ package body Exp_Dist is ...@@ -10593,8 +10598,7 @@ package body Exp_Dist is
-- Add a placeholder member label -- Add a placeholder member label
-- for the default case. -- for the default case.
-- It must be of the discriminant -- It must be of the discriminant type.
-- type.
declare declare
Exp : constant Node_Id := Exp : constant Node_Id :=
...@@ -10605,30 +10609,21 @@ package body Exp_Dist is ...@@ -10605,30 +10609,21 @@ package body Exp_Dist is
begin begin
Set_Etype (Exp, Discriminant_Type); Set_Etype (Exp, Discriminant_Type);
Append_To (Union_TC_Params, Append_To (Union_TC_Params,
Make_Function_Call (Loc, Build_To_Any_Call (Exp, Decls));
Name => New_Occurrence_Of
(RTE (RE_TA_A), Loc),
Parameter_Associations =>
New_List (
Build_To_Any_Call
(Exp, Decls))));
end; end;
Add_Params_For_Variant_Components; Add_Params_For_Variant_Components;
when others => when others =>
-- Case of an explicit choice
declare declare
Exp : constant Node_Id := Exp : constant Node_Id :=
New_Copy_Tree (Choice); New_Copy_Tree (Choice);
begin begin
Append_To (Union_TC_Params, Append_To (Union_TC_Params,
Make_Function_Call (Loc, Build_To_Any_Call (Exp, Decls));
Name => New_Occurrence_Of
(RTE (RE_TA_A), Loc),
Parameter_Associations =>
New_List (
Build_To_Any_Call
(Exp, Decls))));
end; end;
Add_Params_For_Variant_Components; Add_Params_For_Variant_Components;
......
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