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