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;
-- 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;
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);
-- 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;
-- 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;
-- 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);
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;
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;
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
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);
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
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
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;
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);
-- 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));
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,
Actuals);
else
Perform_Call :=
- Make_Return_Statement (Loc,
+ Make_Simple_Return_Statement (Loc,
Expression =>
Make_Function_Call (Loc,
Name =>
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,
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
-----------------------------------
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
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;
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.
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)))))),
-- 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))));
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))))));
Append_To (Non_Asynchronous_Statements,
Make_Tag_Check (Loc,
- Make_Return_Statement (Loc,
+ Make_Simple_Return_Statement (Loc,
Expression =>
Make_Attribute_Reference (Loc,
Prefix =>
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,
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)))));
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))));
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))));
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)));
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 =>
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))))))));
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))));
begin
Statements := New_List (
- Make_Return_Statement (Loc,
+ Make_Simple_Return_Statement (Loc,
Expression =>
Make_Aggregate (Loc,
Component_Associations => New_List (
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)));
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 =>
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,
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,
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,
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,
Counter => Component_Counter);
Append_To (Stms,
- Make_Return_Statement (Loc,
+ Make_Simple_Return_Statement (Loc,
Expression => New_Occurrence_Of (Res, Loc)));
end;
end if;
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,
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;
end if;
Append_To (Stms,
- Make_Return_Statement (Loc,
+ Make_Simple_Return_Statement (Loc,
Expression => New_Occurrence_Of (Any, Loc)));
Decl :=
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;
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;
-- 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 :=
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;
projects / platform / upstream / linaro-gcc.git / commitdiff