with Sem_Eval; use Sem_Eval;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
-with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
with Tbuild; use Tbuild;
-- tag fixup (Get_Unique_Remote_Pointer may have changed Pointer'Tag to
-- RACW_Stub_Type'Tag, while the desired tag is that of Stub_Type).
+ function Build_Stub_Tag
+ (Loc : Source_Ptr;
+ RACW_Type : Entity_Id) return Node_Id;
+ -- Return an expression denoting the tag of the stub type associated with
+ -- RACW_Type.
+
function Build_Subprogram_Calling_Stubs
(Vis_Decl : Node_Id;
Subp_Id : Node_Id;
Equal => "=");
-- Mapping between a RCI subprogram and the corresponding calling stubs
+ function Get_Stub_Elements (RACW_Type : Entity_Id) return Stub_Structure;
+ -- Return the stub information associated with the given RACW type
+
procedure Add_Stub_Type
(Designated_Type : Entity_Id;
RACW_Type : Entity_Id;
RPC_Receiver :=
Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('P'));
+
Specific_Build_RPC_Receiver_Body
(RPC_Receiver => RPC_Receiver,
Request => RPC_Receiver_Request,
Parameter_Associations => New_List (
New_Occurrence_Of (RPC_Receiver_Subp_Id, Loc),
Make_String_Literal (Loc, Subp_Str))),
+
Then_Statements => New_List (
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (
RPC_Receiver_Subp_Index, Loc),
Expression =>
Make_Integer_Literal (Loc,
- Current_Primitive_Number)))));
+ Intval => Current_Primitive_Number)))));
end if;
Append_To (RPC_Receiver_Case_Alternatives,
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);
- Desig : constant Entity_Id := Etype (Designated_Type (RACW_Type));
-
- Stub_Elements : constant Stub_Structure := Stubs_Table.Get (Desig);
- pragma Assert (Stub_Elements /= Empty_Stub_Structure);
RACW_Primitive_Name : Node_Id;
Subp_Name : constant Entity_Id :=
Defining_Unit_Name (Specification (Vis_Decl));
- Pkg_Name : constant Entity_Id :=
- Make_Defining_Identifier (Loc,
- Chars =>
- New_External_Name (Chars (Subp_Name), 'P', -1));
+ Pkg_Name : constant Entity_Id :=
+ Make_Defining_Identifier (Loc,
+ Chars => New_External_Name (Chars (Subp_Name), 'P', -1));
Proxy_Type : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars =>
- New_External_Name (
- Related_Id => Chars (Subp_Name),
- Suffix => 'P'));
+ New_External_Name
+ (Related_Id => Chars (Subp_Name),
+ Suffix => 'P'));
Proxy_Type_Full_View : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Append_To (Vis_Decls,
Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Proxy_Object_Addr,
- Constant_Present =>
- True,
- Object_Definition =>
- New_Occurrence_Of (RTE (RE_Address), Loc)));
+ Defining_Identifier => Proxy_Object_Addr,
+ Constant_Present => True,
+ Object_Definition => New_Occurrence_Of (RTE (RE_Address), Loc)));
-- private
Append_To (Pvt_Decls,
Make_Full_Type_Declaration (Loc,
- Defining_Identifier =>
- Proxy_Type_Full_View,
+ Defining_Identifier => Proxy_Type_Full_View,
Type_Definition =>
Build_Remote_Subprogram_Proxy_Type (Loc,
New_Occurrence_Of (All_Calls_Remote_E, Loc))));
if Nkind (Subp_Decl_Spec) = N_Procedure_Specification then
Perform_Call :=
Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (Subp_Name, Loc),
- Parameter_Associations =>
- Actuals);
+ Name => New_Occurrence_Of (Subp_Name, Loc),
+ Parameter_Associations => Actuals);
else
Perform_Call :=
Make_Simple_Return_Statement (Loc,
Expression =>
- Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (Subp_Name, Loc),
- Parameter_Associations =>
- Actuals));
+ Make_Function_Call (Loc,
+ Name => New_Occurrence_Of (Subp_Name, Loc),
+ Parameter_Associations => Actuals));
end if;
Formal := First (Parameter_Specifications (Subp_Decl_Spec));
Append_To (Pvt_Decls,
Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Make_Defining_Identifier (Loc,
- Name_uO),
- Aliased_Present =>
- True,
- Object_Definition =>
- New_Occurrence_Of (Proxy_Type, Loc)));
+ Defining_Identifier => Make_Defining_Identifier (Loc, Name_uO),
+ Aliased_Present => True,
+ Object_Definition => New_Occurrence_Of (Proxy_Type, Loc)));
-- A : constant System.Address := O'Address;
Append_To (Pvt_Decls,
Make_Object_Declaration (Loc,
Defining_Identifier =>
- Make_Defining_Identifier (Loc,
- Chars (Proxy_Object_Addr)),
- Constant_Present =>
- True,
- Object_Definition =>
- New_Occurrence_Of (RTE (RE_Address), Loc),
+ Make_Defining_Identifier (Loc, Chars (Proxy_Object_Addr)),
+ Constant_Present => True,
+ Object_Definition => New_Occurrence_Of (RTE (RE_Address), Loc),
Expression =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (
Defining_Identifier (Last (Pvt_Decls)), Loc),
- Attribute_Name =>
- Name_Address)));
+ Attribute_Name => Name_Address)));
Append_To (Decls,
Make_Package_Declaration (Loc,
Append_To (Decls,
Make_Package_Body (Loc,
Defining_Unit_Name =>
- Make_Defining_Identifier (Loc,
- Chars (Pkg_Name)),
+ Make_Defining_Identifier (Loc, Chars (Pkg_Name)),
Declarations => New_List (
Make_Subprogram_Body (Loc,
- Specification =>
- Subp_Body_Spec,
+ Specification => Subp_Body_Spec,
Declarations => New_List,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Chars => Name_Address,
Expression =>
Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (Constant_Object, Loc),
- Attribute_Name =>
- Name_Address)));
+ Prefix => New_Occurrence_Of (Constant_Object, Loc),
+ Attribute_Name => Name_Address)));
end;
end if;
Make_Object_Declaration (Loc,
Defining_Identifier => Object,
Constant_Present => Present (Expr) and then not Variable,
- Object_Definition =>
- New_Occurrence_Of (Etyp, Loc),
+ Object_Definition => New_Occurrence_Of (Etyp, Loc),
Expression => Expr));
if Constant_Present (Last (Decls)) then
Make_Assignment_Statement (Loc,
Name =>
Make_Selected_Component (Loc,
- Prefix =>
- New_Occurrence_Of (Pointer, Loc),
+ Prefix => New_Occurrence_Of (Pointer, Loc),
Selector_Name =>
New_Occurrence_Of (First_Tag_Component
(Designated_Type (Etype (Pointer))), Loc)),
Expression =>
Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (Stub_Type, Loc),
- Attribute_Name =>
- Name_Tag)));
+ Prefix => New_Occurrence_Of (Stub_Type, Loc),
+ Attribute_Name => Name_Tag)));
-- Note: The assignment to Pointer._Tag is safe here because
-- we carefully ensured that Stub_Type has exactly the same layout
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Defining_Entity (Pkg_Spec), Loc),
- Attribute_Name =>
- Name_Version)));
+ Attribute_Name => Name_Version)));
Append_To (L, Reg);
Analyze (Reg);
end Build_Passive_Partition_Stub;
New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc))))));
end Build_Remote_Subprogram_Proxy_Type;
+ --------------------
+ -- Build_Stub_Tag --
+ --------------------
+
+ function Build_Stub_Tag
+ (Loc : Source_Ptr;
+ RACW_Type : Entity_Id) return Node_Id
+ is
+ Stub_Type : constant Entity_Id := Corresponding_Stub_Type (RACW_Type);
+ begin
+ return
+ Make_Attribute_Reference (Loc,
+ Prefix => New_Occurrence_Of (Stub_Type, Loc),
+ Attribute_Name => Name_Tag);
+ end Build_Stub_Tag;
+
------------------------------------
-- Build_Subprogram_Calling_Stubs --
------------------------------------
Append_To (Stmts,
Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_NVList_Create), Loc),
+ Name => New_Occurrence_Of (RTE (RE_NVList_Create), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (NVList, Loc))));
end Declare_Create_NVList;
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);
(Loc : Source_Ptr;
Decls : List_Id;
RPC_Receiver : Entity_Id;
- Stub_Elements : Stub_Structure) is
+ Stub_Elements : Stub_Structure)
+ is
begin
-- The RPC receiver body should not be the completion of the
-- declaration recorded in the stub structure, because then the
Attribute_Name => Name_Address);
end if;
- Add_RACW_Write_Attribute (
- RACW_Type,
- Stub_Type,
- Stub_Type_Access,
- RPC_Receiver,
- Body_Decls);
-
- Add_RACW_Read_Attribute (
- RACW_Type,
- Stub_Type,
- Stub_Type_Access,
- Body_Decls);
+ Add_RACW_Write_Attribute
+ (RACW_Type,
+ Stub_Type,
+ Stub_Type_Access,
+ RPC_Receiver,
+ Body_Decls);
+
+ Add_RACW_Read_Attribute
+ (RACW_Type,
+ Stub_Type,
+ Stub_Type_Access,
+ Body_Decls);
end Add_RACW_Features;
-----------------------------
Insert_After (Proc_Decl, Attr_Decl);
if No (Body_Decls) then
+
-- Case of processing an RACW type from another unit than the
-- main one: do not generate a body.
-- a remote object.
Remote_Statements := New_List (
-
Pack_Node_Into_Stream_Access (Loc,
- Stream => Stream_Parameter,
- Object =>
+ Stream => Stream_Parameter,
+ Object =>
Make_Selected_Component (Loc,
- Prefix => Unchecked_Convert_To (Stub_Type_Access,
- Object),
- Selector_Name =>
- Make_Identifier (Loc, Name_Origin)),
- Etyp => RTE (RE_Partition_ID)),
+ Prefix =>
+ Unchecked_Convert_To (Stub_Type_Access, Object),
+ Selector_Name => Make_Identifier (Loc, Name_Origin)),
+ Etyp => RTE (RE_Partition_ID)),
Pack_Node_Into_Stream_Access (Loc,
Stream => Stream_Parameter,
Object =>
Make_Selected_Component (Loc,
- Prefix => Unchecked_Convert_To (Stub_Type_Access,
- Object),
- Selector_Name =>
- Make_Identifier (Loc, Name_Receiver)),
+ Prefix =>
+ Unchecked_Convert_To (Stub_Type_Access, Object),
+ Selector_Name => Make_Identifier (Loc, Name_Receiver)),
Etyp => RTE (RE_Unsigned_64)),
Pack_Node_Into_Stream_Access (Loc,
Stream => Stream_Parameter,
Object =>
Make_Selected_Component (Loc,
- Prefix => Unchecked_Convert_To (Stub_Type_Access,
- Object),
- Selector_Name =>
- Make_Identifier (Loc, Name_Addr)),
+ Prefix =>
+ Unchecked_Convert_To (Stub_Type_Access, Object),
+ Selector_Name => Make_Identifier (Loc, Name_Addr)),
Etyp => RTE (RE_Unsigned_64)));
-- Build code fragment corresponding to marshalling of a null object
Make_Op_Eq (Loc,
Left_Opnd => Object,
Right_Opnd => Make_Null (Loc)),
+
Then_Statements => Null_Statements,
+
Elsif_Parts => New_List (
Make_Elsif_Part (Loc,
Condition =>
Make_Attribute_Reference (Loc,
Prefix => Object,
Attribute_Name => Name_Tag),
+
Right_Opnd =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Stub_Type, Loc),
begin
Proc_Decls := New_List (
- -- Common declarations
+ -- Common declarations
Make_Object_Declaration (Loc,
Defining_Identifier => Origin,
Parameter_Associations => New_List (
New_Occurrence_Of (Package_Name, Loc)))),
- -- Declaration use only in the local case: proxy address
+ -- Declaration use only in the local case: proxy address
Make_Object_Declaration (Loc,
Defining_Identifier => Proxy_Addr,
Object_Definition =>
New_Occurrence_Of (RTE (RE_Unsigned_64), Loc)),
- -- Declarations used only in the remote case: stub object and
- -- stub pointer.
+ -- Declarations used only in the remote case: stub object and
+ -- stub pointer.
Make_Object_Declaration (Loc,
Defining_Identifier => Local_Stub,
Attribute_Name => Name_Unchecked_Access)));
Set_Etype (Stub_Ptr, Stub_Elements.Stub_Type_Access);
- -- Build_Get_Unique_RP_Call needs this information
+
+ -- Build_Get_Unique_RP_Call needs above information
-- Note: Here we assume that the Fat_Type is a record
-- containing just a pointer to a proxy or stub object.
-- end if;
Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Get_RAS_Info), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Get_RAS_Info), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Package_Name, Loc),
New_Occurrence_Of (Subp_Id, Loc),
Make_Function_Call (Loc,
New_Occurrence_Of (
RTE (RE_Get_Local_Partition_Id), Loc))),
+
Right_Opnd =>
Make_Op_Not (Loc,
New_Occurrence_Of (All_Calls_Remote, Loc))),
+
Then_Statements => New_List (
Make_Simple_Return_Statement (Loc,
Unchecked_Convert_To (Fat_Type,
Set_Field (Name_Addr, New_Occurrence_Of (Proxy_Addr, Loc)),
- -- E.4.1(9) A remote call is asynchronous if it is a call to
- -- a procedure, or a call through a value of an access-to-procedure
- -- type, to which a pragma Asynchronous applies.
+ -- E.4.1(9) A remote call is asynchronous if it is a call to
+ -- a procedure or a call through a value of an access-to-procedure
+ -- type to which a pragma Asynchronous applies.
- -- Parameter Asynch_P is true when the procedure is asynchronous;
- -- Expression Asynch_T is true when the type is asynchronous.
+ -- Asynch_P is true when the procedure is asynchronous;
+ -- Asynch_T is true when the type is asynchronous.
Set_Field (Name_Asynchronous,
Make_Or_Else (Loc,
New_List (
Make_Procedure_Call_Statement (Loc,
Name =>
- New_Occurrence_Of (
- Defining_Entity (Stubs), Loc),
+ New_Occurrence_Of (Defining_Entity (Stubs), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Request_Parameter, Loc))))));
end Append_Stubs_To;
Make_Op_Eq (Loc,
New_Occurrence_Of (Subp_Id, Loc),
Make_Integer_Literal (Loc, 0)),
+
Then_Statements => New_List (
Make_Assignment_Statement (Loc,
Name =>
New_Occurrence_Of (Subp_Id, Loc),
+
Expression =>
Make_Selected_Component (Loc,
Prefix =>
Make_Selected_Component (Loc,
Prefix => Request_Parameter,
Selector_Name => Name_Params))))),
+
Selector_Name =>
Make_Identifier (Loc, Name_Subp_Id))))));
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);
Choices => New_List (
Make_Integer_Literal (Loc,
Current_Subprogram_Number)),
+
Expression =>
Make_Aggregate (Loc,
Component_Associations => New_List (
Proxy_Object_Addr, Loc))))));
Append_Stubs_To (Pkg_RPC_Receiver_Cases,
- Stubs =>
- Current_Stubs,
- Subprogram_Number =>
- Current_Subprogram_Number);
+ Stubs => Current_Stubs,
+ Subprogram_Number => Current_Subprogram_Number);
end;
Current_Subprogram_Number := Current_Subprogram_Number + 1;
Append_To (Pkg_RPC_Receiver_Cases,
Make_Case_Statement_Alternative (Loc,
- Discrete_Choices =>
- New_List (Make_Others_Choice (Loc)),
- Statements =>
- New_List (Make_Null_Statement (Loc))));
+ Discrete_Choices => New_List (Make_Others_Choice (Loc)),
+ Statements => New_List (Make_Null_Statement (Loc))));
Append_To (Pkg_RPC_Receiver_Statements,
Make_Case_Statement (Loc,
- Expression =>
- New_Occurrence_Of (Subp_Id, Loc),
+ Expression => New_Occurrence_Of (Subp_Id, Loc),
Alternatives => Pkg_RPC_Receiver_Cases));
Append_To (Decls,
First_RCI_Subprogram_Id),
High_Bound =>
Make_Integer_Literal (Loc,
- First_RCI_Subprogram_Id
- + List_Length (Subp_Info_List) - 1)))))));
+ Intval =>
+ First_RCI_Subprogram_Id
+ + List_Length (Subp_Info_List) - 1)))))));
-- For a degenerate RCI with no visible subprograms, Subp_Info_List
-- has zero length, and the declaration is for an empty array, in
Make_Selected_Component (Loc,
Prefix =>
Make_Indexed_Component (Loc,
- Prefix =>
- New_Occurrence_Of (Subp_Info_Array, Loc),
+ Prefix => New_Occurrence_Of (Subp_Info_Array, Loc),
Expressions => New_List (
Convert_To (Standard_Integer,
Make_Identifier (Loc, Name_Subp_Id)))),
- Selector_Name =>
- Make_Identifier (Loc, Name_Addr));
+ Selector_Name => Make_Identifier (Loc, Name_Addr));
-- Case of no visible subprogram: just raise Constraint_Error, we
-- know for sure we got junk from a remote partition.
Make_Subprogram_Body (Loc,
Specification =>
Copy_Specification (Loc, Parent (Lookup_RAS_Info)),
- Declarations =>
- No_List,
+ Declarations => No_List,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (
Make_Simple_Return_Statement (Loc,
Expression =>
- OK_Convert_To (RTE (RE_Unsigned_64),
- Subp_Info_Addr))))));
+ OK_Convert_To
+ (RTE (RE_Unsigned_64), Subp_Info_Addr))))));
end;
Analyze (Last (Decls));
Append_To (Register_Pkg_Actuals,
Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (Pkg_RPC_Receiver, Loc),
- Attribute_Name =>
- Name_Unrestricted_Access));
+ Prefix => New_Occurrence_Of (Pkg_RPC_Receiver, Loc),
+ Attribute_Name => Name_Unrestricted_Access));
-- Version
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Defining_Entity (Pkg_Spec), Loc),
- Attribute_Name =>
- Name_Version));
+ Attribute_Name => Name_Version));
-- Subp_Info
Append_To (Register_Pkg_Actuals,
Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (Subp_Info_Array, Loc),
- Attribute_Name =>
- Name_Address));
+ Prefix => New_Occurrence_Of (Subp_Info_Array, Loc),
+ Attribute_Name => Name_Address));
-- Subp_Info_Len
Append_To (Register_Pkg_Actuals,
Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (Subp_Info_Array, Loc),
- Attribute_Name =>
- Name_Length));
+ Prefix => New_Occurrence_Of (Subp_Info_Array, Loc),
+ Attribute_Name => Name_Length));
-- Generate the call
Attribute_Name => Name_Write,
Expressions => New_List (
Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (Stream_Parameter, Loc),
- Attribute_Name =>
- Name_Access),
+ Prefix => New_Occurrence_Of (Stream_Parameter, Loc),
+ Attribute_Name => Name_Access),
Target_RPC_Receiver)));
-- Then put the Subprogram_Id of the subprogram we want to call in
Append_To (Statements,
Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc),
- Attribute_Name =>
- Name_Write,
+ Prefix => New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc),
+ Attribute_Name => Name_Write,
Expressions => New_List (
Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (Stream_Parameter, Loc),
+ Prefix => New_Occurrence_Of (Stream_Parameter, Loc),
Attribute_Name => Name_Access),
Subprogram_Id)));
begin
if Is_RACW_Controlling_Formal
- (Current_Parameter, Stub_Type)
+ (Current_Parameter, Stub_Type)
then
-- In the case of a controlling formal argument, we marshall
-- its addr field rather than the local stub.
Etyp => RTE (RE_Unsigned_64)));
else
- Value := New_Occurrence_Of
- (Defining_Identifier (Current_Parameter), Loc);
+ Value :=
+ New_Occurrence_Of
+ (Defining_Identifier (Current_Parameter), Loc);
-- Access type parameters are transmitted as in out
-- parameters. However, a dereference is needed so that
then
Append_To (Statements,
Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (Etyp, Loc),
+ Prefix => New_Occurrence_Of (Etyp, Loc),
Attribute_Name =>
Output_From_Constrained (Constrained),
Expressions => New_List (
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Standard_Boolean, Loc),
- Attribute_Name =>
- Name_Write,
+ Attribute_Name => Name_Write,
Expressions => New_List (
Make_Attribute_Reference (Loc,
Prefix =>
- New_Occurrence_Of (Stream_Parameter, Loc),
- Attribute_Name =>
+ New_Occurrence_Of
+ (Stream_Parameter, Loc), Attribute_Name =>
Name_Access),
New_Occurrence_Of (Extra_Parameter, Loc))));
end if;
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Stream_Parameter, Loc),
- Attribute_Name =>
- Name_Access))));
+ Attribute_Name => Name_Access))));
else
Asynchronous_Statements := No_List;
end if;
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Stream_Parameter, Loc),
- Attribute_Name =>
- Name_Access),
+ Attribute_Name => Name_Access),
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Result_Parameter, Loc),
- Attribute_Name =>
- Name_Access))));
+ Attribute_Name => Name_Access))));
-- Read the exception occurrence from the result stream and
-- reraise it. It does no harm if this is a Null_Occurrence since
Prefix =>
New_Occurrence_Of (RTE (RE_Exception_Occurrence), Loc),
- Attribute_Name =>
- Name_Read,
+ Attribute_Name => Name_Read,
Expressions => New_List (
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Result_Parameter, Loc),
- Attribute_Name =>
- Name_Access),
+ Attribute_Name => Name_Access),
New_Occurrence_Of (Exception_Return_Parameter, Loc))));
Append_To (Non_Asynchronous_Statements,
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Result_Parameter, Loc),
- Attribute_Name =>
- Name_Access),
+ Attribute_Name => Name_Access),
Value)));
end if;
end;
New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc),
Attribute_Name => Name_Input,
Expressions => New_List (
- Make_Selected_Component (Loc,
- Prefix => Request,
- Selector_Name => Name_Params)))));
+ Make_Selected_Component (Loc,
+ Prefix => Request,
+ Selector_Name => Name_Params)))));
Stmts := New_List;
New_Occurrence_Of (RTE (RE_Exception_Occurrence), Loc),
Attribute_Name => Name_Write,
Expressions => New_List (
- Make_Selected_Component (Loc,
- Prefix => Request_Parameter,
- Selector_Name => Name_Result),
+ Make_Selected_Component (Loc,
+ Prefix => Request_Parameter,
+ Selector_Name => Name_Result),
New_Occurrence_Of (RTE (RE_Null_Occurrence), Loc)));
if Dynamically_Asynchronous then
Append_To (Decls,
Input_With_Tag_Check (Loc,
Var_Type => Etyp,
- Stream => Make_Selected_Component (Loc,
- Prefix => Request_Parameter,
- Selector_Name => Name_Params)));
+ Stream =>
+ Make_Selected_Component (Loc,
+ Prefix => Request_Parameter,
+ Selector_Name => Name_Params)));
-- Prepare function call expression
- Expr := Make_Function_Call (Loc,
- New_Occurrence_Of (Defining_Unit_Name
- (Specification (Last (Decls))), Loc));
+ Expr :=
+ Make_Function_Call (Loc,
+ Name =>
+ New_Occurrence_Of
+ (Defining_Unit_Name
+ (Specification (Last (Decls))), Loc));
end if;
end if;
return Body_Decls;
end Get_And_Reset_RACW_Bodies;
+ -----------------------
+ -- Get_Stub_Elements --
+ -----------------------
+
+ function Get_Stub_Elements (RACW_Type : Entity_Id) return Stub_Structure is
+ Desig : constant Entity_Id :=
+ Etype (Designated_Type (RACW_Type));
+ Stub_Elements : constant Stub_Structure := Stubs_Table.Get (Desig);
+ begin
+ pragma Assert (Stub_Elements /= Empty_Stub_Structure);
+ return Stub_Elements;
+ end Get_Stub_Elements;
+
-----------------------
-- Get_Subprogram_Id --
-----------------------
procedure Add_RACW_From_Any
(RACW_Type : Entity_Id;
- Stub_Type : Entity_Id;
- Stub_Type_Access : Entity_Id;
Body_Decls : List_Id);
-- Add the From_Any TSS for this RACW type
procedure Add_RACW_To_Any
- (Designated_Type : Entity_Id;
- RACW_Type : Entity_Id;
- Stub_Type : Entity_Id;
- Stub_Type_Access : Entity_Id;
+ (RACW_Type : Entity_Id;
Body_Decls : List_Id);
-- Add the To_Any TSS for this RACW type
begin
Add_RACW_From_Any
(RACW_Type => RACW_Type,
- Stub_Type => Stub_Type,
- Stub_Type_Access => Stub_Type_Access,
Body_Decls => Body_Decls);
Add_RACW_To_Any
- (Designated_Type => Desig,
- RACW_Type => RACW_Type,
- Stub_Type => Stub_Type,
- Stub_Type_Access => Stub_Type_Access,
+ (RACW_Type => RACW_Type,
Body_Decls => Body_Decls);
- -- In the PolyORB case, the RACW 'Read and 'Write attributes are
- -- implemented in terms of the From_Any and To_Any TSSs, so these
- -- TSSs must be expanded before 'Read and 'Write.
-
Add_RACW_Write_Attribute
(RACW_Type => RACW_Type,
Stub_Type => Stub_Type,
procedure Add_RACW_From_Any
(RACW_Type : Entity_Id;
- Stub_Type : Entity_Id;
- Stub_Type_Access : Entity_Id;
Body_Decls : List_Id)
is
Loc : constant Source_Ptr := Sloc (RACW_Type);
Func_Decl : Node_Id;
Func_Body : Node_Id;
- Decls : List_Id;
Statements : List_Id;
- Stub_Statements : List_Id;
- Local_Statements : List_Id;
-- Various parts of the subprogram
Any_Parameter : constant Entity_Id :=
Make_Defining_Identifier (Loc, Name_A);
- Reference : Entity_Id;
- Is_Local : Entity_Id;
- Addr : Entity_Id;
- Local_Stub : Entity_Id;
- Stubbed_Result : Entity_Id;
-
- Stub_Condition : Node_Id;
- -- An expression that determines whether we create a stub for the
- -- newly-unpacked RACW. Normally we create a stub only for remote
- -- objects, but in the case of an RACW used to implement a RAS, we
- -- also create a stub for local subprograms if a pragma
- -- All_Calls_Remote applies.
-
Asynchronous_Flag : constant Entity_Id :=
Asynchronous_Flags_Table.Get (RACW_Type);
-- The flag object declared in Add_RACW_Asynchronous_Flag
return;
end if;
- -- Object declarations
-
- Reference :=
- Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
- Is_Local :=
- Make_Defining_Identifier (Loc, New_Internal_Name ('L'));
- Addr :=
- Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
- Local_Stub :=
- Make_Defining_Identifier (Loc, New_Internal_Name ('L'));
- Stubbed_Result :=
- Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
-
- Decls := New_List (
- Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Reference,
- Object_Definition =>
- New_Occurrence_Of (RTE (RE_Object_Ref), Loc),
- Expression =>
- Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_FA_ObjRef), Loc),
- Parameter_Associations => New_List (
- New_Occurrence_Of (Any_Parameter, Loc)))),
-
- Make_Object_Declaration (Loc,
- Defining_Identifier => Local_Stub,
- Aliased_Present => True,
- Object_Definition => New_Occurrence_Of (Stub_Type, Loc)),
-
- Make_Object_Declaration (Loc,
- Defining_Identifier => Stubbed_Result,
- Object_Definition =>
- New_Occurrence_Of (Stub_Type_Access, Loc),
- Expression =>
- Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (Local_Stub, Loc),
- Attribute_Name =>
- Name_Unchecked_Access)),
-
- Make_Object_Declaration (Loc,
- Defining_Identifier => Is_Local,
- Object_Definition =>
- New_Occurrence_Of (Standard_Boolean, Loc)),
-
- Make_Object_Declaration (Loc,
- Defining_Identifier => Addr,
- Object_Definition =>
- New_Occurrence_Of (RTE (RE_Address), Loc)));
-
- -- Build_Get_Unique_RP_Call needs the type of Stubbed_Result
-
- Set_Etype (Stubbed_Result, Stub_Type_Access);
-
- -- If the ref Is_Nil, return a null pointer
-
- Statements := New_List (
- Make_Implicit_If_Statement (RACW_Type,
- Condition =>
- Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Is_Nil), Loc),
- Parameter_Associations => New_List (
- New_Occurrence_Of (Reference, Loc))),
- Then_Statements => New_List (
- Make_Simple_Return_Statement (Loc,
- Expression =>
- Make_Null (Loc)))));
-
- Append_To (Statements,
- Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Get_Local_Address), Loc),
- Parameter_Associations => New_List (
- New_Occurrence_Of (Reference, Loc),
- New_Occurrence_Of (Is_Local, Loc),
- New_Occurrence_Of (Addr, Loc))));
-
- -- If the object is located on another partition, then a stub object
- -- will be created with all the information needed to rebuild the
- -- real object at the other end. This stanza is always used in the
- -- case of RAS types, for which a stub is required even for local
- -- subprograms.
-
- Stub_Statements := New_List (
- Make_Assignment_Statement (Loc,
- Name => Make_Selected_Component (Loc,
- Prefix => Stubbed_Result,
- Selector_Name => Name_Target),
- Expression =>
- Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Entity_Of), Loc),
- Parameter_Associations => New_List (
- New_Occurrence_Of (Reference, Loc)))),
-
- Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Inc_Usage), Loc),
- Parameter_Associations => New_List (
- Make_Selected_Component (Loc,
- Prefix => Stubbed_Result,
- Selector_Name => Name_Target))),
-
- Make_Assignment_Statement (Loc,
- Name => Make_Selected_Component (Loc,
- Prefix => Stubbed_Result,
- Selector_Name => Name_Asynchronous),
- Expression =>
- New_Occurrence_Of (Asynchronous_Flag, Loc)));
-
-- ??? Issue with asynchronous calls here: the Asynchronous flag is
-- set on the stub type if, and only if, the RACW type has a pragma
-- Asynchronous. This is incorrect for RACWs that implement RAS
-- the Asynchronous component in the stub type in the RAS's _From_Any
-- TSS.
- Append_List_To (Stub_Statements,
- Build_Get_Unique_RP_Call (Loc, Stubbed_Result, Stub_Type));
-
- -- Distinguish between the local and remote cases, and execute the
- -- appropriate piece of code.
-
- Stub_Condition := New_Occurrence_Of (Is_Local, Loc);
-
- if Is_RAS then
- Stub_Condition := Make_And_Then (Loc,
- Left_Opnd =>
- Stub_Condition,
- Right_Opnd =>
- Make_Selected_Component (Loc,
- Prefix =>
- Unchecked_Convert_To (
- RTE (RE_RAS_Proxy_Type_Access),
- New_Occurrence_Of (Addr, Loc)),
- Selector_Name =>
- Make_Identifier (Loc,
- Name_All_Calls_Remote)));
- end if;
-
- Local_Statements := New_List (
- Make_Simple_Return_Statement (Loc,
- Expression =>
- Unchecked_Convert_To (RACW_Type,
- New_Occurrence_Of (Addr, Loc))));
-
- Append_To (Statements,
- Make_Implicit_If_Statement (RACW_Type,
- Condition =>
- Stub_Condition,
- Then_Statements => Local_Statements,
- Else_Statements => Stub_Statements));
-
- Append_To (Statements,
+ Statements := New_List (
Make_Simple_Return_Statement (Loc,
Expression => Unchecked_Convert_To (RACW_Type,
- New_Occurrence_Of (Stubbed_Result, Loc))));
+ Make_Function_Call (Loc,
+ Name => New_Occurrence_Of (RTE (RE_Get_RACW), Loc),
+ Parameter_Associations => New_List (
+ Make_Function_Call (Loc,
+ Name => New_Occurrence_Of (RTE (RE_FA_ObjRef), Loc),
+ Parameter_Associations => New_List (
+ New_Occurrence_Of (Any_Parameter, Loc))),
+ Build_Stub_Tag (Loc, RACW_Type),
+ New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc),
+ New_Occurrence_Of (Asynchronous_Flag, Loc))))));
Func_Body :=
Make_Subprogram_Body (Loc,
- Specification =>
- Copy_Specification (Loc, Func_Spec),
- Declarations => Decls,
+ Specification => Copy_Specification (Loc, Func_Spec),
+ Declarations => No_List,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Statements));
Body_Node : Node_Id;
- Decls : List_Id;
- Statements : constant List_Id := New_List;
+ Decls : constant List_Id := New_List;
+ Statements : constant List_Id := New_List;
+ Reference : constant Entity_Id :=
+ Make_Defining_Identifier (Loc, Name_R);
-- Various parts of the procedure
- Pnam : constant Entity_Id :=
- Make_Defining_Identifier (Loc,
- New_Internal_Name ('R'));
+ Pnam : constant Entity_Id := Make_Defining_Identifier (Loc,
+ New_Internal_Name ('R'));
+
+ Is_RAS : constant Boolean := not Comes_From_Source (RACW_Type);
- Source_Ref : Entity_Id;
Asynchronous_Flag : constant Entity_Id :=
Asynchronous_Flags_Table.Get (RACW_Type);
pragma Assert (Present (Asynchronous_Flag));
function Stream_Parameter return Node_Id;
function Result return Node_Id;
+
-- Functions to create occurrences of the formal parameter names
------------
return;
end if;
- Source_Ref := Make_Defining_Identifier
- (Loc, New_Internal_Name ('R'));
-
- -- Generate object declarations
-
- Decls := New_List (
+ Append_To (Decls,
Make_Object_Declaration (Loc,
- Defining_Identifier => Source_Ref,
- Object_Definition =>
+ Defining_Identifier =>
+ Reference,
+ Object_Definition =>
New_Occurrence_Of (RTE (RE_Object_Ref), Loc)));
Append_List_To (Statements, New_List (
Attribute_Name => Name_Read,
Expressions => New_List (
Stream_Parameter,
- New_Occurrence_Of (Source_Ref, Loc))),
+ New_Occurrence_Of (Reference, Loc))),
+
Make_Assignment_Statement (Loc,
- Name =>
+ Name =>
Result,
Expression =>
- PolyORB_Support.Helpers.Build_From_Any_Call (
- RACW_Type,
+ Unchecked_Convert_To (RACW_Type,
Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_TA_ObjRef), Loc),
+ Name =>
+ New_Occurrence_Of (RTE (RE_Get_RACW), Loc),
Parameter_Associations => New_List (
- New_Occurrence_Of (Source_Ref, Loc))),
- Decls))));
+ New_Occurrence_Of (Reference, Loc),
+ Build_Stub_Tag (Loc, RACW_Type),
+ New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc),
+ New_Occurrence_Of (Asynchronous_Flag, Loc)))))));
Set_Declarations (Body_Node, Decls);
Append_To (Body_Decls, Body_Node);
---------------------
procedure Add_RACW_To_Any
- (Designated_Type : Entity_Id;
- RACW_Type : Entity_Id;
- Stub_Type : Entity_Id;
- Stub_Type_Access : Entity_Id;
+ (RACW_Type : Entity_Id;
Body_Decls : List_Id)
is
Loc : constant Source_Ptr := Sloc (RACW_Type);
- Is_RAS : constant Boolean := not Comes_From_Source (RACW_Type);
-
Fnam : constant Entity_Id :=
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (RACW_Type), 'T'));
+ Is_RAS : constant Boolean := not Comes_From_Source (RACW_Type);
+
Stub_Elements : constant Stub_Structure :=
- Stubs_Table.Get (Designated_Type);
- pragma Assert (Stub_Elements /= Empty_Stub_Structure);
+ Get_Stub_Elements (RACW_Type);
Func_Spec : Node_Id;
Func_Decl : Node_Id;
Decls : List_Id;
Statements : List_Id;
- Null_Statements : List_Id;
- Local_Statements : List_Id := No_List;
- Stub_Statements : List_Id;
- If_Node : Node_Id;
-- Various parts of the subprogram
RACW_Parameter : constant Entity_Id :=
return;
end if;
- -- Object declarations
+ -- Generate:
+
+ -- R : constant Object_Ref :=
+ -- Get_Reference
+ -- (Address!(RACW),
+ -- "typ",
+ -- Stub_Type'Tag,
+ -- Is_RAS,
+ -- RPC_Receiver'Access);
+ -- A : Any;
Decls := New_List (
Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Reference,
- Object_Definition =>
- New_Occurrence_Of (RTE (RE_Object_Ref), Loc)),
- Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Any,
- Object_Definition =>
- New_Occurrence_Of (RTE (RE_Any), Loc)));
-
- -- If the object is null, nothing to do (Reference is already
- -- a Nil ref.)
-
- Null_Statements := New_List (Make_Null_Statement (Loc));
-
- if Is_RAS then
-
- -- If the object is a RAS designating a local subprogram, we
- -- already have a target reference.
-
- Local_Statements := New_List (
- Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Set_Ref), Loc),
- Parameter_Associations => New_List (
- New_Occurrence_Of (Reference, Loc),
- Make_Selected_Component (Loc,
- Prefix =>
- Unchecked_Convert_To (RTE (RE_RAS_Proxy_Type_Access),
- New_Occurrence_Of (RACW_Parameter, Loc)),
- Selector_Name => Make_Identifier (Loc, Name_Target)))));
-
- else
- -- If the object is a local RACW object, use Get_Reference now to
- -- obtain a reference.
-
- Local_Statements := New_List (
- Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Get_Reference), Loc),
- Parameter_Associations => New_List (
- Unchecked_Convert_To (
- RTE (RE_Address),
- New_Occurrence_Of (RACW_Parameter, Loc)),
- Make_String_Literal (Loc,
- Full_Qualified_Name (Designated_Type)),
- Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (
- Defining_Identifier (
- Stub_Elements.RPC_Receiver_Decl), Loc),
- Attribute_Name =>
- Name_Access),
- New_Occurrence_Of (Reference, Loc))));
- end if;
-
- -- If the object is located on another partition, use the target from
- -- the stub.
+ Defining_Identifier => Reference,
+ Constant_Present => True,
+ Object_Definition =>
+ New_Occurrence_Of (RTE (RE_Object_Ref), Loc),
+ Expression =>
+ Make_Function_Call (Loc,
+ Name => New_Occurrence_Of (RTE (RE_Get_Reference), Loc),
+ Parameter_Associations => New_List (
+ Unchecked_Convert_To (RTE (RE_Address),
+ New_Occurrence_Of (RACW_Parameter, Loc)),
+ Make_String_Literal (Loc,
+ Strval => Full_Qualified_Name
+ (Etype (Designated_Type (RACW_Type)))),
+ Build_Stub_Tag (Loc, RACW_Type),
+ New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc),
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ New_Occurrence_Of
+ (Defining_Identifier
+ (Stub_Elements.RPC_Receiver_Decl), Loc),
+ Attribute_Name => Name_Access)))),
- Stub_Statements := New_List (
- Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Set_Ref), Loc),
- Parameter_Associations => New_List (
- New_Occurrence_Of (Reference, Loc),
- Make_Selected_Component (Loc,
- Prefix => Unchecked_Convert_To (Stub_Type_Access,
- New_Occurrence_Of (RACW_Parameter, Loc)),
- Selector_Name =>
- Make_Identifier (Loc, Name_Target)))));
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Any,
+ Object_Definition => New_Occurrence_Of (RTE (RE_Any), Loc)));
- -- Distinguish between the null, local and remote cases, and execute
- -- the appropriate piece of code.
+ -- Generate:
- If_Node :=
- Make_Implicit_If_Statement (RACW_Type,
- Condition =>
- Make_Op_Eq (Loc,
- Left_Opnd => New_Occurrence_Of (RACW_Parameter, Loc),
- Right_Opnd => Make_Null (Loc)),
- Then_Statements => Null_Statements,
- Elsif_Parts => New_List (
- Make_Elsif_Part (Loc,
- Condition =>
- Make_Op_Ne (Loc,
- Left_Opnd =>
- Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (RACW_Parameter, Loc),
- Attribute_Name => Name_Tag),
- Right_Opnd =>
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Stub_Type, Loc),
- Attribute_Name => Name_Tag)),
- Then_Statements => Local_Statements)),
- Else_Statements => Stub_Statements);
+ -- Any := TA_ObjRef (Reference);
+ -- Set_TC (Any, RPC_Receiver.Obj_TypeCode);
+ -- return Any;
Statements := New_List (
- If_Node,
Make_Assignment_Statement (Loc,
- Name =>
- New_Occurrence_Of (Any, Loc),
+ Name => New_Occurrence_Of (Any, Loc),
Expression =>
Make_Function_Call (Loc,
Name => New_Occurrence_Of (RTE (RE_TA_ObjRef), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Reference, Loc)))),
+
Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Set_TC), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Set_TC), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Any, Loc),
Make_Selected_Component (Loc,
Defining_Identifier (
Stub_Elements.RPC_Receiver_Decl),
Selector_Name => Name_Obj_TypeCode))),
+
Make_Simple_Return_Statement (Loc,
- Expression =>
- New_Occurrence_Of (Any, Loc)));
+ Expression => New_Occurrence_Of (Any, Loc)));
Func_Body :=
Make_Subprogram_Body (Loc,
- Specification =>
- Copy_Specification (Loc, Func_Spec),
+ Specification => Copy_Specification (Loc, Func_Spec),
Declarations => Decls,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Func_Spec :=
Make_Function_Specification (Loc,
- Defining_Unit_Name =>
- Fnam,
- Result_Definition => New_Occurrence_Of (RTE (RE_TypeCode), Loc));
+ Defining_Unit_Name => Fnam,
+ Result_Definition => New_Occurrence_Of (RTE (RE_TypeCode), Loc));
-- NOTE: The usage occurrences of RACW_Parameter must refer to the
-- entity in the declaration spec, not those of the body spec.
Func_Body :=
Make_Subprogram_Body (Loc,
- Specification =>
- Copy_Specification (Loc, Func_Spec),
+ Specification => Copy_Specification (Loc, Func_Spec),
Declarations => Empty_List,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Expression =>
Make_Selected_Component (Loc,
Prefix =>
- Defining_Identifier (
- Stub_Elements.RPC_Receiver_Decl),
+ Defining_Identifier
+ (Stub_Elements.RPC_Receiver_Decl),
Selector_Name => Name_Obj_TypeCode)))));
Append_To (Body_Decls, Func_Body);
Loc : constant Source_Ptr := Sloc (RACW_Type);
+ Is_RAS : constant Boolean := not Comes_From_Source (RACW_Type);
+
+ Stub_Elements : constant Stub_Structure :=
+ Get_Stub_Elements (RACW_Type);
+
Body_Node : Node_Id;
Proc_Decl : Node_Id;
Attr_Decl : Node_Id;
- Statements : constant List_Id := New_List;
+ Statements : constant List_Id := New_List;
Pnam : constant Entity_Id :=
Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
------------
function Object return Node_Id is
- Object_Ref : constant Node_Id :=
- Make_Identifier (Loc, Name_V);
-
begin
- -- Etype must be set for Build_To_Any_Call
-
- Set_Etype (Object_Ref, RACW_Type);
-
- return Object_Ref;
+ return Make_Identifier (Loc, Name_V);
end Object;
----------------------
Stream => Stream_Parameter,
Object =>
Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_FA_ObjRef), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Get_Reference), Loc),
Parameter_Associations => New_List (
- PolyORB_Support.Helpers.Build_To_Any_Call
- (Object, Body_Decls))),
+ Unchecked_Convert_To (RTE (RE_Address), Object),
+ Make_String_Literal (Loc,
+ Strval => Full_Qualified_Name
+ (Etype (Designated_Type (RACW_Type)))),
+ Build_Stub_Tag (Loc, RACW_Type),
+ New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc),
+ Make_Attribute_Reference (Loc,
+ Prefix =>
+ New_Occurrence_Of
+ (Defining_Identifier
+ (Stub_Elements.RPC_Receiver_Decl), Loc),
+ Attribute_Name => Name_Access))),
+
Etyp => RTE (RE_Object_Ref)));
Append_To (Body_Decls, Body_Node);
-- corresponding record type.
RACW_Type : constant Entity_Id :=
- Underlying_RACW_Type (Ras_Type);
- Desig : constant Entity_Id :=
- Etype (Designated_Type (RACW_Type));
+ Underlying_RACW_Type (Ras_Type);
Stub_Elements : constant Stub_Structure :=
- Stubs_Table.Get (Desig);
- pragma Assert (Stub_Elements /= Empty_Stub_Structure);
+ Get_Stub_Elements (RACW_Type);
Proc : constant Entity_Id :=
Make_Defining_Identifier (Loc,
New_Occurrence_Of (Stub_Elements.Stub_Type, Loc)),
Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Stub_Ptr,
+ Defining_Identifier => Stub_Ptr,
Object_Definition =>
New_Occurrence_Of (Stub_Elements.Stub_Type_Access, Loc),
Expression =>
Proc_Statements := New_List (
Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Get_RAS_Info), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Get_RAS_Info), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Package_Name, Loc),
New_Occurrence_Of (Subp_Id, Loc),
-- obtain the local address of its proxy (A).
Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Get_Local_Address), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Get_Local_Address), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Subp_Ref, Loc),
New_Occurrence_Of (Is_Local, Loc),
-- if L then
Make_Implicit_If_Statement (N,
- Condition =>
- New_Occurrence_Of (Is_Local, Loc),
+ Condition => New_Occurrence_Of (Is_Local, Loc),
Then_Statements => New_List (
Condition =>
Make_Op_Eq (Loc,
Make_Selected_Component (Loc,
- Prefix =>
- Unchecked_Convert_To (
- RTE (RE_RAS_Proxy_Type_Access),
- New_Occurrence_Of (Local_Addr, Loc)),
- Selector_Name =>
- Make_Identifier (Loc, Name_Target)),
+ Prefix =>
+ Unchecked_Convert_To
+ (RTE (RE_RAS_Proxy_Type_Access),
+ New_Occurrence_Of (Local_Addr, Loc)),
+ Selector_Name => Make_Identifier (Loc, Name_Target)),
Make_Null (Loc)),
Then_Statements => New_List (
Make_Assignment_Statement (Loc,
Name =>
Make_Selected_Component (Loc,
- Prefix =>
- Unchecked_Convert_To (
- RTE (RE_RAS_Proxy_Type_Access),
- New_Occurrence_Of (Local_Addr, Loc)),
- Selector_Name =>
- Make_Identifier (Loc, Name_Target)),
+ Prefix =>
+ Unchecked_Convert_To
+ (RTE (RE_RAS_Proxy_Type_Access),
+ New_Occurrence_Of (Local_Addr, Loc)),
+ Selector_Name => Make_Identifier (Loc, Name_Target)),
Expression =>
Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Entity_Of), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Entity_Of), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Subp_Ref, Loc)))),
-- Inc_Usage (A.Target);
Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Inc_Usage), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Inc_Usage), Loc),
Parameter_Associations => New_List (
Make_Selected_Component (Loc,
Prefix =>
- Unchecked_Convert_To (
- RTE (RE_RAS_Proxy_Type_Access),
- New_Occurrence_Of (Local_Addr, Loc)),
- Selector_Name => Make_Identifier (Loc,
- Name_Target)))))),
+ Unchecked_Convert_To
+ (RTE (RE_RAS_Proxy_Type_Access),
+ New_Occurrence_Of (Local_Addr, Loc)),
+ Selector_Name =>
+ Make_Identifier (Loc, Name_Target)))))),
-- end if;
-- if not All_Calls_Remote then
Make_Implicit_If_Statement (N,
Condition =>
Make_Op_Not (Loc,
- New_Occurrence_Of (All_Calls_Remote, Loc)),
+ Right_Opnd =>
+ New_Occurrence_Of (All_Calls_Remote, Loc)),
Then_Statements => New_List (
Make_Simple_Return_Statement (Loc,
- Unchecked_Convert_To (Fat_Type,
- New_Occurrence_Of (Local_Addr, Loc))))))));
+ Expression =>
+ Unchecked_Convert_To
+ (Fat_Type, New_Occurrence_Of (Local_Addr, Loc))))))));
Append_List_To (Proc_Statements, New_List (
Set_Field (Name_Target,
Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Entity_Of), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Entity_Of), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Subp_Ref, Loc)))),
-- Inc_Usage (Stub.Target);
Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Inc_Usage), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Inc_Usage), Loc),
Parameter_Associations => New_List (
Make_Selected_Component (Loc,
Prefix => Stub_Ptr,
Set_Field (Name_Asynchronous,
Make_Or_Else (Loc,
- New_Occurrence_Of (Asynch_P, Loc),
- New_Occurrence_Of (Boolean_Literals (
- Is_Asynchronous (Ras_Type)), Loc)))));
+ Left_Opnd => New_Occurrence_Of (Asynch_P, Loc),
+ Right_Opnd =>
+ New_Occurrence_Of
+ (Boolean_Literals (Is_Asynchronous (Ras_Type)), Loc)))));
Append_List_To (Proc_Statements,
- Build_Get_Unique_RP_Call (Loc,
- Stub_Ptr, Stub_Elements.Stub_Type));
+ Build_Get_Unique_RP_Call (Loc, Stub_Ptr, Stub_Elements.Stub_Type));
Append_To (Proc_Statements,
Make_Simple_Return_Statement (Loc,
Func_Spec :=
Make_Function_Specification (Loc,
- Defining_Unit_Name =>
- Fnam,
+ Defining_Unit_Name => Fnam,
Parameter_Specifications => New_List (
Make_Parameter_Specification (Loc,
- Defining_Identifier =>
- Any_Parameter,
- Parameter_Type =>
- New_Occurrence_Of (RTE (RE_Any), Loc))),
+ Defining_Identifier => Any_Parameter,
+ Parameter_Type => New_Occurrence_Of (RTE (RE_Any), Loc))),
Result_Definition => New_Occurrence_Of (RAS_Type, Loc));
Discard_Node (
Set_Etype (RACW_Parameter, Underlying_RACW_Type (RAS_Type));
Decls := New_List (
Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Any,
- Object_Definition =>
- New_Occurrence_Of (RTE (RE_Any), Loc),
- Expression =>
+ Defining_Identifier => Any,
+ Object_Definition => New_Occurrence_Of (RTE (RE_Any), Loc),
+ Expression =>
PolyORB_Support.Helpers.Build_To_Any_Call
(RACW_Parameter, No_List)));
Statements := New_List (
Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Set_TC), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Set_TC), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Any, Loc),
PolyORB_Support.Helpers.Build_TypeCode_Call (Loc,
RAS_Type, Decls))),
+
Make_Simple_Return_Statement (Loc,
- Expression =>
- New_Occurrence_Of (Any, Loc)));
+ Expression => New_Occurrence_Of (Any, Loc)));
Func_Spec :=
Make_Function_Specification (Loc,
- Defining_Unit_Name =>
- Fnam,
+ Defining_Unit_Name => Fnam,
Parameter_Specifications => New_List (
Make_Parameter_Specification (Loc,
- Defining_Identifier =>
- RAS_Parameter,
- Parameter_Type =>
- New_Occurrence_Of (RAS_Type, Loc))),
+ Defining_Identifier => RAS_Parameter,
+ Parameter_Type => New_Occurrence_Of (RAS_Type, Loc))),
Result_Definition => New_Occurrence_Of (RTE (RE_Any), Loc));
Discard_Node (
Fnam : constant Entity_Id := Make_Defining_Identifier (Loc,
Make_TSS_Name (RAS_Type, TSS_TypeCode));
- Func_Spec : Node_Id;
-
- Decls : constant List_Id := New_List;
- Name_String, Repo_Id_String : String_Id;
+ Func_Spec : Node_Id;
+ Decls : constant List_Id := New_List;
+ Name_String : String_Id;
+ Repo_Id_String : String_Id;
begin
Func_Spec :=
Make_Function_Specification (Loc,
- Defining_Unit_Name =>
- Fnam,
- Result_Definition => New_Occurrence_Of (RTE (RE_TypeCode), Loc));
+ Defining_Unit_Name => Fnam,
+ Result_Definition => New_Occurrence_Of (RTE (RE_TypeCode), Loc));
PolyORB_Support.Helpers.Build_Name_And_Repository_Id
(RAS_Type, Name_Str => Name_String, Repo_Id_Str => Repo_Id_String);
Make_Simple_Return_Statement (Loc,
Expression =>
Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_TC_Build), Loc),
+ Name => New_Occurrence_Of (RTE (RE_TC_Build), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (RTE (RE_TC_Object), Loc),
Make_Aggregate (Loc,
Expressions =>
New_List (
Make_Function_Call (Loc,
- Name => New_Occurrence_Of (
- RTE (RE_TA_String), Loc),
+ Name =>
+ New_Occurrence_Of
+ (RTE (RE_TA_String), Loc),
Parameter_Associations => New_List (
Make_String_Literal (Loc, Name_String))),
Make_Function_Call (Loc,
- Name => New_Occurrence_Of (
- RTE (RE_TA_String), Loc),
+ Name =>
+ New_Occurrence_Of
+ (RTE (RE_TA_String), Loc),
Parameter_Associations => New_List (
Make_String_Literal (Loc,
- Repo_Id_String))))))))))));
+ Strval => Repo_Id_String))))))))))));
Set_TSS (RAS_Type, Fnam);
end Add_RAS_TypeCode;
Make_Defining_Identifier (Loc,
New_Internal_Name ('H'));
Pkg_RPC_Receiver_Object : Node_Id;
-
Pkg_RPC_Receiver_Body : Node_Id;
Pkg_RPC_Receiver_Decls : List_Id;
Pkg_RPC_Receiver_Statements : List_Id;
- Pkg_RPC_Receiver_Cases : constant List_Id := New_List;
+
+ Pkg_RPC_Receiver_Cases : constant List_Id := New_List;
-- A Pkg_RPC_Receiver is built to decode the request
- Request : Node_Id;
+ Request : Node_Id;
-- Request object received from neutral layer
Subp_Id : Entity_Id;
-- distribution core.
Subp_Index : Entity_Id;
- -- Internal index as determined by matching either the
- -- method name from the request structure, or the local
- -- subprogram address (in case of a RAS).
+ -- Internal index as determined by matching either the method name
+ -- from the request structure, or the local subprogram address (in
+ -- case of a RAS).
Is_Local : constant Entity_Id :=
- Make_Defining_Identifier (Loc, New_Internal_Name ('L'));
+ Make_Defining_Identifier (Loc,
+ Chars => New_Internal_Name ('L'));
+
Local_Address : constant Entity_Id :=
- Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
- -- Address of a local subprogram designated by a
- -- reference corresponding to a RAS.
+ Make_Defining_Identifier (Loc,
+ Chars => New_Internal_Name ('A'));
+ -- Address of a local subprogram designated by a reference
+ -- corresponding to a RAS.
Dispatch_On_Address : constant List_Id := New_List;
Dispatch_On_Name : constant List_Id := New_List;
Defining_Entity (Stubs), Loc),
Parameter_Associations =>
New_List (New_Occurrence_Of (Request, Loc))));
- if Nkind (Specification (Declaration))
- = N_Function_Specification
+
+ if Nkind (Specification (Declaration)) = N_Function_Specification
or else not
Is_Asynchronous (Defining_Entity (Specification (Declaration)))
then
Make_Case_Statement_Alternative (Loc,
Discrete_Choices =>
New_List (Make_Integer_Literal (Loc, Subp_Number)),
- Statements =>
- Case_Stmts));
+ Statements => Case_Stmts));
Append_To (Dispatch_On_Name,
Make_Elsif_Part (Loc,
Parameter_Associations => New_List (
New_Occurrence_Of (Subp_Id, Loc),
New_Occurrence_Of (Subp_Dist_Name, Loc))),
+
Then_Statements => New_List (
Make_Assignment_Statement (Loc,
New_Occurrence_Of (Subp_Index, Loc),
- Make_Integer_Literal (Loc,
- Subp_Number)))));
+ Make_Integer_Literal (Loc, Subp_Number)))));
Append_To (Dispatch_On_Address,
Make_Elsif_Part (Loc,
Condition =>
Make_Op_Eq (Loc,
- Left_Opnd =>
- New_Occurrence_Of (Local_Address, Loc),
- Right_Opnd =>
- New_Occurrence_Of (Subp_Proxy_Addr, Loc)),
+ Left_Opnd => New_Occurrence_Of (Local_Address, Loc),
+ Right_Opnd => New_Occurrence_Of (Subp_Proxy_Addr, Loc)),
+
Then_Statements => New_List (
Make_Assignment_Statement (Loc,
New_Occurrence_Of (Subp_Index, Loc),
- Make_Integer_Literal (Loc,
- Subp_Number)))));
+ Make_Integer_Literal (Loc, Subp_Number)))));
end Append_Stubs_To;
-- Start of processing for Add_Receiving_Stubs_To_Declarations
Append_To (Pkg_RPC_Receiver_Decls,
Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Is_Local,
+ Defining_Identifier => Is_Local,
Object_Definition =>
New_Occurrence_Of (Standard_Boolean, Loc)));
+
Append_To (Pkg_RPC_Receiver_Decls,
Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Local_Address,
+ Defining_Identifier => Local_Address,
Object_Definition =>
New_Occurrence_Of (RTE (RE_Address), Loc)));
+
Append_To (Pkg_RPC_Receiver_Statements,
Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Get_Local_Address), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Get_Local_Address), Loc),
Parameter_Associations => New_List (
Make_Selected_Component (Loc,
Prefix => Request,
Subp_Val : String_Id;
Subp_Dist_Name : constant Entity_Id :=
- Make_Defining_Identifier (Loc,
- New_External_Name (
- Related_Id => Chars (Subp_Def),
- Suffix => 'D',
- Suffix_Index => -1));
+ Make_Defining_Identifier (Loc,
+ Chars =>
+ New_External_Name
+ (Related_Id => Chars (Subp_Def),
+ Suffix => 'D',
+ Suffix_Index => -1));
Proxy_Object_Addr : Entity_Id;
-- 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);
+ 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);
+ Assign_Subprogram_Identifier
+ (Subp_Def,
+ Current_Subprogram_Number,
+ Subp_Val);
- pragma Assert (Current_Subprogram_Number =
- Get_Subprogram_Id (Subp_Def));
+ 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),
+ Object_Definition =>
+ New_Occurrence_Of (Standard_String, Loc),
Expression =>
Make_String_Literal (Loc, Subp_Val)));
Analyze (Last (Decls));
Append_To (Subp_Info_List,
Make_Component_Association (Loc,
Choices => New_List (
- Make_Integer_Literal (Loc,
- Current_Subprogram_Number)),
+ 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),
+ New_Occurrence_Of (Subp_Dist_Name, Loc),
Attribute_Name => Name_Address),
+
Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (
- Subp_Dist_Name, 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,
Make_Index_Or_Discriminant_Constraint (Loc,
New_List (
Make_Range (Loc,
- Low_Bound => Make_Integer_Literal (Loc,
- First_RCI_Subprogram_Id),
+ Low_Bound =>
+ Make_Integer_Literal (Loc,
+ Intval => First_RCI_Subprogram_Id),
High_Bound =>
Make_Integer_Literal (Loc,
- First_RCI_Subprogram_Id
- + List_Length (Subp_Info_List) - 1)))))));
+ Intval =>
+ First_RCI_Subprogram_Id
+ + List_Length (Subp_Info_List) - 1)))))));
if Present (First (Subp_Info_List)) then
Set_Expression (Last (Decls),
Make_Implicit_If_Statement (Pkg_Spec,
Condition =>
Make_Op_Ne (Loc,
- Left_Opnd => New_Occurrence_Of
- (Local_Address, Loc),
+ Left_Opnd => New_Occurrence_Of (Local_Address, Loc),
Right_Opnd => New_Occurrence_Of
(RTE (RE_Null_Address), Loc)),
+
Then_Statements => New_List (
Make_Implicit_If_Statement (Pkg_Spec,
- Condition =>
- New_Occurrence_Of (Standard_False, Loc),
+ Condition => New_Occurrence_Of (Standard_False, Loc),
Then_Statements => New_List (
Make_Null_Statement (Loc)),
- Elsif_Parts =>
- Dispatch_On_Address)),
+ Elsif_Parts => Dispatch_On_Address)),
Else_Statements => New_List (
Make_Implicit_If_Statement (Pkg_Spec,
- Condition =>
- New_Occurrence_Of (Standard_False, Loc),
- Then_Statements => New_List (
- Make_Null_Statement (Loc)),
- Elsif_Parts =>
- Dispatch_On_Name))));
+ Condition => New_Occurrence_Of (Standard_False, Loc),
+ Then_Statements => New_List (Make_Null_Statement (Loc)),
+ Elsif_Parts => Dispatch_On_Name))));
else
-- For a degenerate RCI with no visible subprograms,
Append_To (Pkg_RPC_Receiver_Cases,
Make_Case_Statement_Alternative (Loc,
- Discrete_Choices =>
- New_List (Make_Others_Choice (Loc)),
- Statements =>
- New_List (Make_Null_Statement (Loc))));
+ Discrete_Choices => New_List (Make_Others_Choice (Loc)),
+ Statements => New_List (Make_Null_Statement (Loc))));
Append_To (Pkg_RPC_Receiver_Statements,
Make_Case_Statement (Loc,
- Expression =>
- New_Occurrence_Of (Subp_Index, Loc),
+ Expression => New_Occurrence_Of (Subp_Index, Loc),
Alternatives => Pkg_RPC_Receiver_Cases));
-- Pkg_RPC_Receiver body is now complete: insert it into the tree and
Defining_Identifier =>
Make_Defining_Identifier (Loc, New_Internal_Name ('R')),
Aliased_Present => True,
- Object_Definition =>
- New_Occurrence_Of (RTE (RE_Servant), Loc));
+ Object_Definition => New_Occurrence_Of (RTE (RE_Servant), Loc));
Append_To (Decls, Pkg_RPC_Receiver_Object);
Analyze (Last (Decls));
Get_Library_Unit_Name_String (Pkg_Spec);
+
+ -- Name
+
Append_To (Register_Pkg_Actuals,
- -- Name
Make_String_Literal (Loc,
Strval => String_From_Name_Buffer));
+ -- Version
+
Append_To (Register_Pkg_Actuals,
- -- Version
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of
(Defining_Entity (Pkg_Spec), Loc),
- Attribute_Name =>
- Name_Version));
+ Attribute_Name => Name_Version));
+
+ -- Handler
Append_To (Register_Pkg_Actuals,
- -- Handler
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Pkg_RPC_Receiver, Loc),
Attribute_Name => Name_Access));
+ -- Receiver
+
Append_To (Register_Pkg_Actuals,
- -- Receiver
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (
- Defining_Identifier (
- Pkg_RPC_Receiver_Object), Loc),
- Attribute_Name =>
- Name_Access));
+ Defining_Identifier (Pkg_RPC_Receiver_Object), Loc),
+ Attribute_Name => Name_Access));
+
+ -- Subp_Info
Append_To (Register_Pkg_Actuals,
- -- Subp_Info
Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (Subp_Info_Array, Loc),
- Attribute_Name =>
- Name_Address));
+ Prefix => New_Occurrence_Of (Subp_Info_Array, Loc),
+ Attribute_Name => Name_Address));
+
+ -- Subp_Info_Len
Append_To (Register_Pkg_Actuals,
- -- Subp_Info_Len
Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (Subp_Info_Array, Loc),
- Attribute_Name =>
- Name_Length));
+ Prefix => New_Occurrence_Of (Subp_Info_Array, Loc),
+ Attribute_Name => Name_Length));
+
+ -- Is_All_Calls_Remote
Append_To (Register_Pkg_Actuals,
- -- Is_All_Calls_Remote
New_Occurrence_Of (All_Calls_Remote_E, Loc));
+ -- ???
+
Append_To (Stmts,
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Register_Pkg_Receiving_Stub), Loc),
Parameter_Associations => Register_Pkg_Actuals));
Analyze (Last (Stmts));
-
end Add_Receiving_Stubs_To_Declarations;
---------------------------------
begin
-- ??? document general form of stub subprograms for the PolyORB case
- Request :=
- Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
+ Request := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
Append_To (Decls,
Make_Object_Declaration (Loc,
New_Occurrence_Of (RTE (RE_Request_Access), Loc)));
Result :=
- Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
+ Make_Defining_Identifier (Loc,
+ Chars => New_Internal_Name ('R'));
if Is_Function then
- Result_TC := PolyORB_Support.Helpers.Build_TypeCode_Call (Loc,
- Etype (Result_Definition (Spec)), Decls);
+ Result_TC :=
+ PolyORB_Support.Helpers.Build_TypeCode_Call
+ (Loc, Etype (Result_Definition (Spec)), Decls);
else
Result_TC := New_Occurrence_Of (RTE (RE_TC_Void), Loc);
end if;
Make_Aggregate (Loc,
Component_Associations => New_List (
Make_Component_Association (Loc,
- Choices => New_List (
- Make_Identifier (Loc, Name_Name)),
+ Choices => New_List (Make_Identifier (Loc, Name_Name)),
Expression =>
New_Occurrence_Of (RTE (RE_Result_Name), Loc)),
Make_Component_Association (Loc,
Make_Identifier (Loc, Name_Argument)),
Expression =>
Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Create_Any), Loc),
- Parameter_Associations => New_List (
- Result_TC))),
+ Name => New_Occurrence_Of (RTE (RE_Create_Any), Loc),
+ Parameter_Associations => New_List (Result_TC))),
Make_Component_Association (Loc,
- Choices => New_List (
+ Choices => New_List (
Make_Identifier (Loc, Name_Arg_Modes)),
- Expression =>
- Make_Integer_Literal (Loc, 0))))));
+ Expression => Make_Integer_Literal (Loc, 0))))));
if not Is_Known_Asynchronous then
Exception_Return_Parameter :=
Is_First_Controlling_Formal :=
not First_Controlling_Formal_Seen;
First_Controlling_Formal_Seen := True;
+
else
Is_Controlling_Formal := False;
Is_First_Controlling_Formal := False;
if Is_Controlling_Formal then
- -- In the case of a controlling formal argument, we send its
- -- reference.
+ -- For a controlling formal argument, we send its reference
Etyp := RACW_Type;
Etyp := Etype (Parameter_Type (Current_Parameter));
end if;
- -- The first controlling formal parameter is treated specially: it
- -- is used to set the target object of the call.
+ -- The first controlling formal parameter is treated specially:
+ -- it is used to set the target object of the call.
if not Is_First_Controlling_Formal then
-
declare
Constrained : constant Boolean :=
Is_Constrained (Etyp)
else
Actual_Parameter := OK_Convert_To (Etyp,
Make_Attribute_Reference (Loc,
- Prefix =>
- Actual_Parameter,
- Attribute_Name =>
- Name_Unrestricted_Access));
+ Prefix => Actual_Parameter,
+ Attribute_Name => Name_Unrestricted_Access));
end if;
end if;
-- parameter (always passed as a reference) other than
-- the first one.
- Expr := PolyORB_Support.Helpers.Build_To_Any_Call (
- Actual_Parameter, Decls);
+ Expr := PolyORB_Support.Helpers.Build_To_Any_Call
+ (Actual_Parameter, Decls);
+
else
Expr := Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Create_Any), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Create_Any), Loc),
Parameter_Associations => New_List (
- PolyORB_Support.Helpers.Build_TypeCode_Call (Loc,
- Etyp, Decls)));
+ PolyORB_Support.Helpers.Build_TypeCode_Call
+ (Loc, Etyp, Decls)));
end if;
Append_To (Decls,
Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Any,
+ Defining_Identifier => Any,
Aliased_Present => False,
Object_Definition =>
New_Occurrence_Of (RTE (RE_Any), Loc),
- Expression =>
- Expr));
+ Expression => Expr));
Append_To (Statements,
Add_Parameter_To_NVList (Loc,
New_Occurrence_Of (
Defining_Identifier (Current_Parameter), Loc),
Expression =>
- PolyORB_Support.Helpers.Build_From_Any_Call (
- Etype (Parameter_Type (Current_Parameter)),
- New_Occurrence_Of (Any, Loc),
- Decls)));
+ PolyORB_Support.Helpers.Build_From_Any_Call
+ (Etype (Parameter_Type (Current_Parameter)),
+ New_Occurrence_Of (Any, Loc),
+ Decls)));
end if;
end;
-- this status is transmitted as well.
-- This should be done for accessibility as well ???
- if Nkind (Parameter_Type (Current_Parameter))
- /= N_Access_Definition
+ if Nkind (Parameter_Type (Current_Parameter)) /=
+ N_Access_Definition
and then Need_Extra_Constrained (Current_Parameter)
then
-- In this block, we do not use the extra formal that has been
declare
Extra_Any_Parameter : constant Entity_Id :=
- Make_Defining_Identifier
- (Loc, New_Internal_Name ('P'));
+ Make_Defining_Identifier
+ (Loc, New_Internal_Name ('P'));
Parameter_Exp : constant Node_Id :=
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (
Defining_Identifier (Current_Parameter), Loc),
Attribute_Name => Name_Constrained);
+
begin
Set_Etype (Parameter_Exp, Etype (Standard_Boolean));
Append_To (Decls,
Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Extra_Any_Parameter,
+ Defining_Identifier => Extra_Any_Parameter,
Aliased_Present => False,
Object_Definition =>
New_Occurrence_Of (RTE (RE_Any), Loc),
Expression =>
- PolyORB_Support.Helpers.Build_To_Any_Call (
- Parameter_Exp,
- Decls)));
+ PolyORB_Support.Helpers.Build_To_Any_Call
+ (Parameter_Exp, Decls)));
Append_To (Extra_Formal_Statements,
Add_Parameter_To_NVList (Loc,
Make_Procedure_Call_Statement (Loc,
Name =>
New_Occurrence_Of (RTE (RE_Request_Create), Loc),
+
Parameter_Associations => New_List (
Target_Object,
Subprogram_Id,
Append_To (Parameter_Associations (Last (Statements)),
New_Occurrence_Of (Request, Loc));
- pragma Assert (
- not (Is_Known_Non_Asynchronous and Is_Known_Asynchronous));
+ pragma Assert
+ (not (Is_Known_Non_Asynchronous and Is_Known_Asynchronous));
+
if Is_Known_Non_Asynchronous or Is_Known_Asynchronous then
- Asynchronous_P := New_Occurrence_Of (
- Boolean_Literals (Is_Known_Asynchronous), Loc);
+ Asynchronous_P :=
+ New_Occurrence_Of
+ (Boolean_Literals (Is_Known_Asynchronous), Loc);
+
else
pragma Assert (Present (Asynchronous));
Asynchronous_P := New_Copy_Tree (Asynchronous);
+
-- The expression node Asynchronous will be used to build an 'if'
-- statement at the end of Build_General_Calling_Stubs: we need to
-- make a copy here.
Append_To (Non_Asynchronous_Statements,
Make_Tag_Check (Loc,
Make_Simple_Return_Statement (Loc,
- PolyORB_Support.Helpers.Build_From_Any_Call (
- Etype (Result_Definition (Spec)),
- Make_Selected_Component (Loc,
- Prefix => Result,
- Selector_Name => Name_Argument),
- Decls))));
+ PolyORB_Support.Helpers.Build_From_Any_Call
+ (Etype (Result_Definition (Spec)),
+ Make_Selected_Component (Loc,
+ Prefix => Result,
+ Selector_Name => Name_Argument),
+ Decls))));
end if;
end if;
- Append_List_To (Non_Asynchronous_Statements,
- After_Statements);
+ Append_List_To (Non_Asynchronous_Statements, After_Statements);
if Is_Known_Asynchronous then
Append_List_To (Statements, Asynchronous_Statements);
Append_To (Decls,
Make_Object_Declaration (Loc,
Defining_Identifier => Target_Reference,
+
Object_Definition =>
New_Occurrence_Of (RTE (RE_Object_Ref), Loc),
+
Expression =>
Make_Function_Call (Loc,
Name =>
Make_Selected_Component (Loc,
Prefix => Controlling_Parameter,
Selector_Name => Name_Target)))));
- -- Controlling_Parameter has the same components as
+
+ -- Note: Controlling_Parameter has the same components as
-- System.Partition_Interface.RACW_Stub_Type.
Target_Info.Object := New_Occurrence_Of (Target_Reference, Loc);
else
Target_Info.Object :=
Make_Selected_Component (Loc,
- Prefix =>
- Make_Identifier (Loc, Chars (RCI_Locator)),
+ Prefix => Make_Identifier (Loc, Chars (RCI_Locator)),
Selector_Name =>
Make_Identifier (Loc, Name_Get_RCI_Package_Ref));
end if;
+
return Target_Info;
end Build_Stub_Target;
Make_Defining_Identifier (Loc, Name_Target),
Component_Definition =>
Make_Component_Definition (Loc,
- Aliased_Present =>
- False,
+ Aliased_Present => False,
Subtype_Indication =>
New_Occurrence_Of (RTE (RE_Entity_Ptr), Loc))),
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_Asynchronous),
+
Component_Definition =>
Make_Component_Definition (Loc,
Aliased_Present => False,
Subtype_Indication =>
- New_Occurrence_Of (
- Standard_Boolean, Loc)))))));
+ New_Occurrence_Of (Standard_Boolean, Loc)))))));
RPC_Receiver_Decl :=
Make_Object_Declaration (Loc,
New_Occurrence_Of (Parent_Primitive, Loc);
else
Called_Subprogram :=
- New_Occurrence_Of (
- Defining_Unit_Name (Specification (Vis_Decl)), Loc);
+ New_Occurrence_Of
+ (Defining_Unit_Name (Specification (Vis_Decl)), Loc);
end if;
Declare_Create_NVList (Loc, Arguments, Outer_Decls, Outer_Statements);
Any : Entity_Id := Empty;
Object : constant Entity_Id :=
Make_Defining_Identifier (Loc,
- New_Internal_Name ('P'));
+ Chars => New_Internal_Name ('P'));
Expr : Node_Id := Empty;
- Is_Controlling_Formal : constant Boolean
- := Is_RACW_Controlling_Formal (Current_Parameter, Stub_Type);
+ Is_Controlling_Formal : constant Boolean :=
+ Is_RACW_Controlling_Formal
+ (Current_Parameter, Stub_Type);
Is_First_Controlling_Formal : Boolean := False;
Is_First_Controlling_Formal :=
not First_Controlling_Formal_Seen;
First_Controlling_Formal_Seen := True;
+
else
Etyp := Etype (Parameter_Type (Current_Parameter));
end if;
Constrained :=
- Is_Constrained (Etyp)
- or else Is_Elementary_Type (Etyp);
+ Is_Constrained (Etyp) or else Is_Elementary_Type (Etyp);
if not Is_First_Controlling_Formal then
- Any := Make_Defining_Identifier (Loc,
- New_Internal_Name ('A'));
+ Any :=
+ Make_Defining_Identifier (Loc,
+ Chars => New_Internal_Name ('A'));
+
Append_To (Outer_Decls,
Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Any,
+ Defining_Identifier => Any,
Object_Definition =>
New_Occurrence_Of (RTE (RE_Any), Loc),
Expression =>
Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Create_Any), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Create_Any), Loc),
Parameter_Associations => New_List (
- PolyORB_Support.Helpers.Build_TypeCode_Call (Loc,
- Etyp, Outer_Decls)))));
+ PolyORB_Support.Helpers.Build_TypeCode_Call
+ (Loc, Etyp, Outer_Decls)))));
Append_To (Outer_Statements,
Add_Parameter_To_NVList (Loc,
if Is_First_Controlling_Formal then
declare
Addr : constant Entity_Id :=
- Make_Defining_Identifier (Loc,
- New_Internal_Name ('A'));
+ Make_Defining_Identifier (Loc,
+ Chars => New_Internal_Name ('A'));
+
Is_Local : constant Entity_Id :=
- Make_Defining_Identifier (Loc,
- New_Internal_Name ('L'));
- begin
+ Make_Defining_Identifier (Loc,
+ Chars => New_Internal_Name ('L'));
+ begin
-- Special case: obtain the first controlling formal
-- from the target of the remote call, instead of the
-- argument list.
Append_To (Outer_Decls,
Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Addr,
+ Defining_Identifier => Addr,
Object_Definition =>
New_Occurrence_Of (RTE (RE_Address), Loc)));
+
Append_To (Outer_Decls,
Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Is_Local,
+ Defining_Identifier => Is_Local,
Object_Definition =>
New_Occurrence_Of (Standard_Boolean, Loc)));
+
Append_To (Outer_Statements,
Make_Procedure_Call_Statement (Loc,
Name =>
- New_Occurrence_Of (
- RTE (RE_Get_Local_Address), Loc),
+ New_Occurrence_Of (RTE (RE_Get_Local_Address), Loc),
Parameter_Associations => New_List (
Make_Selected_Component (Loc,
Prefix =>
if Constrained then
Append_To (Statements,
Make_Assignment_Statement (Loc,
- Name =>
- New_Occurrence_Of (Object, Loc),
- Expression =>
- Expr));
+ Name => New_Occurrence_Of (Object, Loc),
+ Expression => Expr));
Expr := Empty;
else
null;
+
-- Expr will be used to initialize (and constrain) the
-- parameter when it is declared.
end if;
then
Append_To (After_Statements,
Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Move_Any_Value), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Move_Any_Value), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Any, Loc),
- PolyORB_Support.Helpers.Build_To_Any_Call (
- New_Occurrence_Of (Object, Loc),
- Decls))));
+ PolyORB_Support.Helpers.Build_To_Any_Call
+ (New_Occurrence_Of (Object, Loc), Decls))));
end if;
-- For RACW controlling formals, the Etyp of Object is always
if Is_Controlling_Formal then
if Nkind (Parameter_Type (Current_Parameter)) /=
- N_Access_Definition
+ N_Access_Definition
then
Append_To (Parameter_List,
Make_Parameter_Association (Loc,
Selector_Name =>
- New_Occurrence_Of (
- Defining_Identifier (Current_Parameter), Loc),
+ New_Occurrence_Of
+ (Defining_Identifier (Current_Parameter), Loc),
Explicit_Actual_Parameter =>
Make_Explicit_Dereference (Loc,
- Unchecked_Convert_To (RACW_Type,
- OK_Convert_To (RTE (RE_Address),
- New_Occurrence_Of (Object, Loc))))));
+ Prefix =>
+ Unchecked_Convert_To (RACW_Type,
+ OK_Convert_To (RTE (RE_Address),
+ New_Occurrence_Of (Object, Loc))))));
else
Append_To (Parameter_List,
Make_Parameter_Association (Loc,
Selector_Name =>
- New_Occurrence_Of (
- Defining_Identifier (Current_Parameter), Loc),
+ New_Occurrence_Of
+ (Defining_Identifier (Current_Parameter), Loc),
+
Explicit_Actual_Parameter =>
Unchecked_Convert_To (RACW_Type,
OK_Convert_To (RTE (RE_Address),
Extra_Constrained
(Defining_Identifier
(Current_Parameter));
+
Extra_Any : constant Entity_Id :=
- Make_Defining_Identifier
- (Loc, New_Internal_Name ('A'));
+ Make_Defining_Identifier (Loc,
+ Chars => New_Internal_Name ('A'));
Formal_Entity : constant Entity_Id :=
- Make_Defining_Identifier
- (Loc, Chars (Extra_Parameter));
+ Make_Defining_Identifier (Loc,
+ Chars => Chars (Extra_Parameter));
Formal_Type : constant Entity_Id :=
Etype (Extra_Parameter);
+
begin
Append_To (Outer_Decls,
Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Extra_Any,
+ Defining_Identifier => Extra_Any,
Object_Definition =>
New_Occurrence_Of (RTE (RE_Any), Loc),
Expression =>
Append_To (Statements,
Make_Assignment_Statement (Loc,
- Name =>
- New_Occurrence_Of (Formal_Entity, Loc),
+ Name => New_Occurrence_Of (Formal_Entity, Loc),
Expression =>
- PolyORB_Support.Helpers.Build_From_Any_Call (
- Formal_Type,
- New_Occurrence_Of (Extra_Any, Loc),
- Decls)));
+ PolyORB_Support.Helpers.Build_From_Any_Call
+ (Formal_Type,
+ New_Occurrence_Of (Extra_Any, Loc),
+ Decls)));
Set_Extra_Constrained (Object, Formal_Entity);
end;
end if;
Append_To (Outer_Statements,
Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Request_Arguments), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Request_Arguments), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Request_Parameter, Loc),
New_Occurrence_Of (Arguments, Loc))));
if Nkind (Specification (Vis_Decl)) = N_Function_Specification then
- -- The remote subprogram is a function. We build an inner block to
- -- be able to hold a potentially unconstrained result in a
- -- variable.
+ -- The remote subprogram is a function: Build an inner block to be
+ -- able to hold a potentially unconstrained result in a variable.
declare
Etyp : constant Entity_Id :=
Etype (Result_Definition (Specification (Vis_Decl)));
Result : constant Node_Id :=
Make_Defining_Identifier (Loc,
- New_Internal_Name ('R'));
+ Chars => New_Internal_Name ('R'));
+
begin
Inner_Decls := New_List (
Make_Object_Declaration (Loc,
-- For a remote call to a function with a class-wide type,
-- check that the returned value satisfies the requirements
- -- of E.4(18).
+ -- of (RM E.4(18)).
Append_To (Inner_Decls,
Make_Transportable_Check (Loc,
Set_Etype (Result, Etyp);
Append_To (After_Statements,
Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Set_Result), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Set_Result), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Request_Parameter, Loc),
- PolyORB_Support.Helpers.Build_To_Any_Call (
- New_Occurrence_Of (Result, Loc),
- Decls))));
+ PolyORB_Support.Helpers.Build_To_Any_Call
+ (New_Occurrence_Of (Result, Loc), Decls))));
+
-- A DSA function does not have out or inout arguments
end;
Append_To (After_Statements,
Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Request_Set_Out), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Request_Set_Out), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Request_Parameter, Loc))));
Statements => New_List (Make_Null_Statement (Loc))));
else
-
-- In the other cases, if an exception is raised, then the
-- exception occurrence is propagated.
Append_To (Outer_Statements,
Make_Block_Statement (Loc,
- Declarations =>
- Decls,
+ Declarations => Decls,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Statements)));
Fnam : Entity_Id := Empty;
Lib_RE : RE_Id := RE_Null;
Result : Node_Id;
- begin
+ begin
-- First simple case where the From_Any function is present
-- in the type's TSS.
if Is_Itype (Typ) then
Build_From_Any_Function
(Loc => Loc,
- Typ => Etype (Typ),
- Decl => Decl,
- Fnam => Fnam);
+ Typ => Etype (Typ),
+ Decl => Decl,
+ Fnam => Fnam);
return;
end if;
- Fnam := Make_Stream_Procedure_Function_Name (Loc,
- Typ, Name_uFrom_Any);
+ Fnam :=
+ Make_Stream_Procedure_Function_Name (Loc, Typ, Name_uFrom_Any);
Spec :=
Make_Function_Specification (Loc,
Defining_Unit_Name => Fnam,
Parameter_Specifications => New_List (
Make_Parameter_Specification (Loc,
- Defining_Identifier =>
- Any_Parameter,
- Parameter_Type =>
- New_Occurrence_Of (RTE (RE_Any), Loc))),
+ Defining_Identifier => Any_Parameter,
+ Parameter_Type => New_Occurrence_Of (RTE (RE_Any), Loc))),
Result_Definition => New_Occurrence_Of (Typ, Loc));
-- The following is taken care of by Exp_Dist.Add_RACW_From_Any
if Has_Stream_Attribute_Definition
(Typ, TSS_Stream_Output, At_Any_Place => True)
- or else
+ or else
Has_Stream_Attribute_Definition
(Typ, TSS_Stream_Write, At_Any_Place => True)
then
Append_To (Stms,
Make_Simple_Return_Statement (Loc,
Expression =>
- OK_Convert_To (
- Typ,
- Build_From_Any_Call (
- Root_Type (Typ),
- New_Occurrence_Of (Any_Parameter, Loc),
- Decls))));
+ OK_Convert_To (Typ,
+ Build_From_Any_Call
+ (Root_Type (Typ),
+ New_Occurrence_Of (Any_Parameter, Loc),
+ Decls))));
elsif Is_Record_Type (Typ)
and then not Is_Derived_Type (Typ)
Append_To (Stms,
Make_Simple_Return_Statement (Loc,
Expression =>
- OK_Convert_To (
- Typ,
- Build_From_Any_Call (
- Etype (Typ),
- New_Occurrence_Of (Any_Parameter, Loc),
- Decls))));
+ OK_Convert_To (Typ,
+ Build_From_Any_Call
+ (Etype (Typ),
+ New_Occurrence_Of (Any_Parameter, Loc),
+ Decls))));
+
else
declare
- Disc : Entity_Id := Empty;
+ Disc : Entity_Id := Empty;
Discriminant_Associations : List_Id;
- Rdef : constant Node_Id :=
- Type_Definition (Declaration_Node (Typ));
- Component_Counter : Int := 0;
+ Rdef : constant Node_Id :=
+ Type_Definition
+ (Declaration_Node (Typ));
+ Component_Counter : Int := 0;
-- The returned object
procedure FA_Append_Record_Traversal is
new Append_Record_Traversal
- (Rec => Res,
- Add_Process_Element => FA_Rec_Add_Process_Element);
+ (Rec => Res,
+ Add_Process_Element => FA_Rec_Add_Process_Element);
--------------------------------
-- FA_Rec_Add_Process_Element --
-- A variant part
declare
- Variant : Node_Id;
+ Variant : Node_Id;
Struct_Counter : Int := 0;
Block_Decls : constant List_Id := New_List;
begin
Append_To (Decls,
Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Struct_Any,
- Constant_Present =>
- True,
- Object_Definition =>
+ Defining_Identifier => Struct_Any,
+ Constant_Present => True,
+ Object_Definition =>
New_Occurrence_Of (RTE (RE_Any), Loc),
- Expression =>
+ Expression =>
Make_Function_Call (Loc,
- Name => New_Occurrence_Of (
- RTE (RE_Extract_Union_Value), Loc),
+ Name =>
+ New_Occurrence_Of
+ (RTE (RE_Extract_Union_Value), Loc),
+
Parameter_Associations => New_List (
Build_Get_Aggregate_Element (Loc,
Any => Any,
Append_To (Stmts,
Make_Block_Statement (Loc,
- Declarations =>
- Block_Decls,
+ Declarations => Block_Decls,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Block_Stmts)));
Expression =>
Make_Selected_Component (Loc,
Prefix => Rec,
- Selector_Name =>
- Chars (Name (Field))),
- Alternatives =>
- Alt_List));
+ Selector_Name => Chars (Name (Field))),
+ Alternatives => Alt_List));
Variant := First_Non_Pragma (Variants (Field));
while Present (Variant) loop
- Choice_List := New_Copy_List_Tree
- (Discrete_Choices (Variant));
+ Choice_List :=
+ New_Copy_List_Tree
+ (Discrete_Choices (Variant));
VP_Stmts := New_List;
Append_To (Alt_List,
Make_Case_Statement_Alternative (Loc,
Discrete_Choices => Choice_List,
- Statements =>
- VP_Stmts));
+ Statements => VP_Stmts));
Next_Non_Pragma (Variant);
end loop;
end;
end if;
+
Counter := Counter + 1;
end FA_Rec_Add_Process_Element;
begin
Append_To (Decls,
Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Disc_Var_Name,
- Constant_Present => True,
- Object_Definition =>
+ Defining_Identifier => Disc_Var_Name,
+ Constant_Present => True,
+ Object_Definition =>
New_Occurrence_Of (Disc_Type, Loc),
+
Expression =>
Build_From_Any_Call (Disc_Type,
Build_Get_Aggregate_Element (Loc,
Idx => Make_Integer_Literal (Loc,
Intval => Component_Counter)),
Decls)));
+
Component_Counter := Component_Counter + 1;
Append_To (Discriminant_Associations,
Append_To (Decls,
Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Res,
- Object_Definition =>
- Res_Definition));
+ Defining_Identifier => Res,
+ Object_Definition => Res_Definition));
-- ... then all components
-- sufficient to determine the typecode of Datum
-- (which can be a TC_SEQUENCE or TC_ARRAY
-- depending on the value of Constrained).
+
-- Therefore we retrieve the typecode which has
-- been constructed in Append_Array_Traversal with
-- a call to Get_Any_Type.
New_Occurrence_Of (Counter, Loc),
Expression =>
Make_Op_Add (Loc,
- Left_Opnd =>
- New_Occurrence_Of (Counter, Loc),
- Right_Opnd =>
- Make_Integer_Literal (Loc, 1))));
+ Left_Opnd => New_Occurrence_Of (Counter, Loc),
+ Right_Opnd => Make_Integer_Literal (Loc, 1))));
if Nkind (Datum) /= N_Attribute_Reference then
if Etype (Datum) /= RTE (RE_Any) then
Set_Expression (Assignment,
- Build_From_Any_Call (
- Component_Type (Typ),
- Element_Any,
- Decls));
+ Build_From_Any_Call
+ (Component_Type (Typ), Element_Any, Decls));
else
Set_Expression (Assignment, Element_Any);
end if;
Make_Object_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Lnam),
- Constant_Present =>
- True,
+ Constant_Present => True,
Object_Definition =>
New_Occurrence_Of (Indt, Loc),
Expression =>
- Build_From_Any_Call (
- Indt,
- Build_Get_Aggregate_Element (Loc,
- Any => Any_Parameter,
- TC => Build_TypeCode_Call (Loc,
- Indt, Decls),
- Idx => Make_Integer_Literal (Loc, J - 1)),
+ Build_From_Any_Call
+ (Indt,
+ Build_Get_Aggregate_Element (Loc,
+ Any => Any_Parameter,
+ TC => Build_TypeCode_Call
+ (Loc, Indt, Decls),
+ Idx =>
+ Make_Integer_Literal (Loc, J - 1)),
Decls)));
Append_To (Decls,
Make_Object_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Hnam),
- Constant_Present =>
- True,
+
+ Constant_Present => True,
+
Object_Definition =>
New_Occurrence_Of (Indt, Loc),
+
Expression => Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Indt, Loc),
+
Attribute_Name => Name_Val,
+
Expressions => New_List (
Make_Op_Subtract (Loc,
Left_Opnd =>
OK_Convert_To (
Standard_Long_Integer,
Make_Identifier (Loc, Lnam)),
+
Right_Opnd =>
OK_Convert_To (
Standard_Long_Integer,
New_Occurrence_Of (
Any_Parameter, Loc),
Make_Integer_Literal (Loc,
- J))))),
+ Intval => J))))),
+
Right_Opnd =>
Make_Integer_Literal (Loc, 1))))));
Initial_Counter_Value := Ndim;
Res_Subtype_Indication := Make_Subtype_Indication (Loc,
- Subtype_Mark =>
- Res_Subtype_Indication,
+ Subtype_Mark => Res_Subtype_Indication,
Constraint =>
Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => Ranges));
Append_To (Decls,
Make_Object_Declaration (Loc,
Defining_Identifier => Component_TC,
- Constant_Present => True,
- Object_Definition =>
+ Constant_Present => True,
+ Object_Definition =>
New_Occurrence_Of (RTE (RE_TypeCode), Loc),
- Expression =>
+ Expression =>
Build_TypeCode_Call (Loc,
Component_Type (Typ), Decls)));
- Append_From_Any_Array_Iterator (Stms,
- Any_Parameter, Counter);
+ Append_From_Any_Array_Iterator
+ (Stms, Any_Parameter, Counter);
Append_To (Stms,
Make_Simple_Return_Statement (Loc,
Append_To (Stms,
Make_Simple_Return_Statement (Loc,
Expression =>
- Unchecked_Convert_To (
- Typ,
- Build_From_Any_Call (
- Find_Numeric_Representation (Typ),
- New_Occurrence_Of (Any_Parameter, Loc),
- Decls))));
+ Unchecked_Convert_To (Typ,
+ Build_From_Any_Call
+ (Find_Numeric_Representation (Typ),
+ New_Occurrence_Of (Any_Parameter, Loc),
+ Decls))));
else
Use_Opaque_Representation := True;
Append_To (Decls,
Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Strm,
- Aliased_Present =>
- True,
+ Defining_Identifier => Strm,
+ Aliased_Present => True,
Object_Definition =>
New_Occurrence_Of (RTE (RE_Buffer_Stream_Type), Loc)));
Append_To (Stms,
Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Any_To_BS), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Any_To_BS), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Any_Parameter, Loc),
New_Occurrence_Of (Strm, Loc))));
Make_Object_Declaration (Loc,
Defining_Identifier => Res,
Constant_Present => True,
- Object_Definition =>
- New_Occurrence_Of (Typ, Loc),
+ Object_Definition => New_Occurrence_Of (Typ, Loc),
Expression =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Typ, Loc),
Name =>
New_Occurrence_Of (RTE (RE_Release_Buffer), Loc),
Parameter_Associations =>
- New_List (
- New_Occurrence_Of (Strm, Loc))),
+ New_List (New_Occurrence_Of (Strm, Loc))),
Make_Simple_Return_Statement (Loc,
Expression => New_Occurrence_Of (Res, Loc))))));
begin
return Make_Function_Call (Loc,
Name =>
- New_Occurrence_Of (
- RTE (RE_Get_Aggregate_Element), Loc),
+ New_Occurrence_Of (RTE (RE_Get_Aggregate_Element), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Any, Loc),
TC,
Defining_Unit_Name => Fnam,
Parameter_Specifications => New_List (
Make_Parameter_Specification (Loc,
- Defining_Identifier =>
- Expr_Parameter,
- Parameter_Type =>
- New_Occurrence_Of (Typ, Loc))),
- Result_Definition => New_Occurrence_Of (RTE (RE_Any), Loc));
+ Defining_Identifier => Expr_Parameter,
+ Parameter_Type => New_Occurrence_Of (Typ, Loc))),
+ Result_Definition => New_Occurrence_Of (RTE (RE_Any), Loc));
Set_Etype (Expr_Parameter, Typ);
Any_Decl :=
Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Any,
- Object_Definition =>
- New_Occurrence_Of (RTE (RE_Any), Loc));
+ Defining_Identifier => Any,
+ Object_Definition => New_Occurrence_Of (RTE (RE_Any), Loc));
Use_Opaque_Representation := False;
New_Occurrence_Of (Expr_Parameter, Loc));
begin
- Set_Expression (Any_Decl,
- Build_To_Any_Call (Expr, Decls));
+ Set_Expression
+ (Any_Decl, Build_To_Any_Call (Expr, Decls));
end;
-- Comment needed here (and label on declare block ???)
Append_To (Block_Stmts,
Make_Case_Statement (Loc,
- Expression =>
- Make_Discriminant_Reference,
- Alternatives =>
- Alt_List));
+ Expression => Make_Discriminant_Reference,
+ Alternatives => Alt_List));
Variant := First_Non_Pragma (Variants (Field));
while Present (Variant) loop
RTE (RE_Add_Aggregate_Element), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Union_Any, Loc),
- Build_To_Any_Call (
- Make_Discriminant_Reference,
- Block_Decls))));
+ Build_To_Any_Call
+ (Make_Discriminant_Reference,
+ Block_Decls))));
-- Populate inner struct aggregate
Append_To (Alt_List,
Make_Case_Statement_Alternative (Loc,
Discrete_Choices => Choice_List,
- Statements => VP_Stmts));
+ Statements => VP_Stmts));
Next_Non_Pragma (Variant);
end loop;
Append_To (Stms,
Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_BS_To_Any), Loc),
+ Name => New_Occurrence_Of (RTE (RE_BS_To_Any), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Strm, Loc),
New_Occurrence_Of (Any, Loc))));
Append_To (Stms,
Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Release_Buffer), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Release_Buffer), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Strm, Loc))));
end;
Decl :=
Make_Subprogram_Body (Loc,
- Specification => Spec,
- Declarations => Decls,
+ Specification => Spec,
+ Declarations => Decls,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Stms));
begin
Append_To (Parameter_List,
Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_TA_String), Loc),
+ Name => New_Occurrence_Of (RTE (RE_TA_String), Loc),
Parameter_Associations => New_List (
Make_String_Literal (Loc, S))));
end Add_String_Parameter;
begin
Append_To (Parameter_List,
Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_TA_TC), Loc),
- Parameter_Associations => New_List (
- TC_Node)));
+ Name => New_Occurrence_Of (RTE (RE_TA_TC), Loc),
+ Parameter_Associations => New_List (TC_Node)));
end Add_TypeCode_Parameter;
------------------------
begin
Append_To (Parameter_List,
Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_TA_LI), Loc),
+ Name => New_Occurrence_Of (RTE (RE_TA_LI), Loc),
Parameter_Associations => New_List (Expr_Node)));
end Add_Long_Parameter;
Append_To (Stms,
Make_Simple_Return_Statement (Loc,
Expression =>
- Make_Constructed_TypeCode (Kind, Parameters)));
+ Make_Constructed_TypeCode (Kind, Parameters)));
end Return_Constructed_TypeCode;
------------------
-- A regular component
- Add_TypeCode_Parameter (
- Build_TypeCode_Call (Loc, Etype (Field), Decls), Params);
+ Add_TypeCode_Parameter
+ (Build_TypeCode_Call (Loc, Etype (Field), Decls), Params);
Get_Name_String (Chars (Field));
Add_String_Parameter (String_From_Name_Buffer, Params);
declare
Default_Node : constant Node_Id :=
- Pick (Union_TC_Params, 4);
+ Pick (Union_TC_Params, 4);
New_Default_Node : constant Node_Id :=
Make_Function_Call (Loc,
declare
Exp : constant Node_Id :=
- New_Copy_Tree (Choice);
+ New_Copy_Tree (Choice);
begin
Append_To (Union_TC_Params,
Build_To_Any_Call (Exp, Decls));
Add_Params_For_Variant_Components;
end case;
+
Next (Choice);
Choice_Index := Choice_Index + 1;
-
end loop;
Next_Non_Pragma (Variant);
end loop;
-
end;
end if;
end TC_Rec_Add_Process_Element;
Spec :=
Make_Function_Specification (Loc,
- Defining_Unit_Name => Fnam,
+ Defining_Unit_Name => Fnam,
Parameter_Specifications => Empty_List,
- Result_Definition =>
+ Result_Definition =>
New_Occurrence_Of (RTE (RE_TypeCode), Loc));
Build_Name_And_Repository_Id (Typ,
Name_Str => Type_Name_Str, Repo_Id_Str => Type_Repo_Id_Str);
+
Initialize_Parameter_List
(Type_Name_Str, Type_Repo_Id_Str, Parameters);
if Has_Stream_Attribute_Definition
(Typ, TSS_Stream_Output, At_Any_Place => True)
- or else
+ or else
Has_Stream_Attribute_Definition
(Typ, TSS_Stream_Write, At_Any_Place => True)
then
-- | [VP Name]
if Nkind (Declaration_Node (Typ)) = N_Subtype_Declaration then
- Return_Alias_TypeCode (
- Build_TypeCode_Call (Loc, Etype (Typ), Decls));
+ Return_Alias_TypeCode
+ (Build_TypeCode_Call (Loc, Etype (Typ), Decls));
+
else
declare
Disc : Entity_Id := Empty;
Rdef : constant Node_Id :=
- Type_Definition (Declaration_Node (Typ));
+ Type_Definition (Declaration_Node (Typ));
Dummy_Counter : Int := 0;
+
begin
-- Construct the discriminants typecodes
if Has_Discriminants (Typ) then
Disc := First_Discriminant (Typ);
end if;
+
while Present (Disc) loop
Add_TypeCode_Parameter (
Build_TypeCode_Call (Loc, Etype (Disc), Decls),
Indx : Node_Id := First_Index (Typ);
begin
- Inner_TypeCode := Build_TypeCode_Call (Loc,
- Component_Type (Typ),
- Decls);
+ Inner_TypeCode :=
+ Build_TypeCode_Call (Loc, Component_Type (Typ), Decls);
for J in 1 .. Ndim loop
if Constrained then
Build_To_Any_Call (
OK_Convert_To (RTE (RE_Long_Unsigned),
Make_Attribute_Reference (Loc,
- Prefix =>
- New_Occurrence_Of (Typ, Loc),
- Attribute_Name =>
- Name_Length,
+ Prefix => New_Occurrence_Of (Typ, Loc),
+ Attribute_Name => Name_Length,
Expressions => New_List (
Make_Integer_Literal (Loc,
- Ndim - J + 1)))),
+ Intval => Ndim - J + 1)))),
Decls),
Build_To_Any_Call (Inner_TypeCode, Decls)));
Decl :=
Make_Subprogram_Body (Loc,
- Specification => Spec,
- Declarations => Decls,
+ Specification => Spec,
+ Declarations => Decls,
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Stms));
Make_Indexed_Component (Loc,
New_Occurrence_Of (Arry, Loc),
Indices);
-
begin
Set_Etype (Element_Expr, Component_Type (Typ));
Add_Process_Element (Stmts,
declare
Loop_Any : Node_Id := Inner_Any;
- begin
+ begin
-- For the first dimension of a constrained array, we add
-- elements directly in the corresponding Any; there is no
-- intervening inner Any.
if Constrained then
Inner_Any_TypeCode_Expr :=
Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Get_TC), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Get_TC), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Any, Loc)));
else
else
Inner_Any_TypeCode_Expr :=
Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Content_Type), Loc),
+ Name => New_Occurrence_Of (RTE (RE_Content_Type), Loc),
Parameter_Associations => New_List (
Make_Identifier (Loc,
- New_External_Name ('T', Depth - 1))));
+ Chars => New_External_Name ('T', Depth - 1))));
end if;
Append_To (Decls,
if Is_Tagged_Type (Typ) then
return Make_Defining_Identifier (Loc, Nam);
else
- return Make_Defining_Identifier (Loc,
+ return
+ Make_Defining_Identifier (Loc,
Chars =>
New_External_Name (Nam, ' ', Increment_Serial_Number));
end if;
(Loc : Source_Ptr;
Decls : List_Id;
RPC_Receiver : Entity_Id;
- Stub_Elements : Stub_Structure) is
+ Stub_Elements : Stub_Structure)
+ is
begin
case Get_PCS_Name is
when Name_PolyORB_DSA =>
Stub_Type : Entity_Id;
Stub_Type_Access : Entity_Id;
RPC_Receiver_Decl : Node_Id;
- Body_Decls : List_Id) is
+ Body_Decls : List_Id)
+ is
begin
case Get_PCS_Name is
when Name_PolyORB_DSA =>
- PolyORB_Support.Add_RACW_Features (
- RACW_Type,
- Desig,
- Stub_Type,
- Stub_Type_Access,
- RPC_Receiver_Decl,
- Body_Decls);
+ PolyORB_Support.Add_RACW_Features
+ (RACW_Type,
+ Desig,
+ Stub_Type,
+ Stub_Type_Access,
+ RPC_Receiver_Decl,
+ Body_Decls);
when others =>
- GARLIC_Support.Add_RACW_Features (
- RACW_Type,
- Stub_Type,
- Stub_Type_Access,
- RPC_Receiver_Decl,
- Body_Decls);
+ GARLIC_Support.Add_RACW_Features
+ (RACW_Type,
+ Stub_Type,
+ Stub_Type_Access,
+ RPC_Receiver_Decl,
+ Body_Decls);
end case;
end Specific_Add_RACW_Features;
procedure Specific_Add_RAST_Features
(Vis_Decl : Node_Id;
- RAS_Type : Entity_Id) is
+ RAS_Type : Entity_Id)
+ is
begin
case Get_PCS_Name is
when Name_PolyORB_DSA =>
begin
case Get_PCS_Name is
when Name_PolyORB_DSA =>
- PolyORB_Support.Add_Receiving_Stubs_To_Declarations (
- Pkg_Spec, Decls, Stmts);
+ PolyORB_Support.Add_Receiving_Stubs_To_Declarations
+ (Pkg_Spec, Decls, Stmts);
when others =>
- GARLIC_Support.Add_Receiving_Stubs_To_Declarations (
- Pkg_Spec, Decls, Stmts);
+ GARLIC_Support.Add_Receiving_Stubs_To_Declarations
+ (Pkg_Spec, Decls, Stmts);
end case;
end Specific_Add_Receiving_Stubs_To_Declarations;
begin
case Get_PCS_Name is
when Name_PolyORB_DSA =>
- PolyORB_Support.Build_General_Calling_Stubs (
- Decls,
- Statements,
- Target.Object,
- Subprogram_Id,
- Asynchronous,
- Is_Known_Asynchronous,
- Is_Known_Non_Asynchronous,
- Is_Function,
- Spec,
- Stub_Type,
- RACW_Type,
- Nod);
+ PolyORB_Support.Build_General_Calling_Stubs
+ (Decls,
+ Statements,
+ Target.Object,
+ Subprogram_Id,
+ Asynchronous,
+ Is_Known_Asynchronous,
+ Is_Known_Non_Asynchronous,
+ Is_Function,
+ Spec,
+ Stub_Type,
+ RACW_Type,
+ Nod);
+
when others =>
- GARLIC_Support.Build_General_Calling_Stubs (
- Decls,
- Statements,
- Target.Partition,
- Target.RPC_Receiver,
- Subprogram_Id,
- Asynchronous,
- Is_Known_Asynchronous,
- Is_Known_Non_Asynchronous,
- Is_Function,
- Spec,
- Stub_Type,
- RACW_Type,
- Nod);
+ GARLIC_Support.Build_General_Calling_Stubs
+ (Decls,
+ Statements,
+ Target.Partition,
+ Target.RPC_Receiver,
+ Subprogram_Id,
+ Asynchronous,
+ Is_Known_Asynchronous,
+ Is_Known_Non_Asynchronous,
+ Is_Function,
+ Spec,
+ Stub_Type,
+ RACW_Type,
+ Nod);
end case;
end Specific_Build_General_Calling_Stubs;
Subp_Index,
Stmts,
Decl);
+
when others =>
GARLIC_Support.Build_RPC_Receiver_Body
(RPC_Receiver,
when Name_PolyORB_DSA =>
return PolyORB_Support.Build_Stub_Target (Loc,
Decls, RCI_Locator, Controlling_Parameter);
+
when others =>
return GARLIC_Support.Build_Stub_Target (Loc,
Decls, RCI_Locator, Controlling_Parameter);
PolyORB_Support.Build_Stub_Type (
RACW_Type, Stub_Type,
Stub_Type_Decl, RPC_Receiver_Decl);
+
when others =>
GARLIC_Support.Build_Stub_Type (
RACW_Type, Stub_Type,
begin
case Get_PCS_Name is
when Name_PolyORB_DSA =>
- return PolyORB_Support.Build_Subprogram_Receiving_Stubs (
- Vis_Decl,
- Asynchronous,
- Dynamically_Asynchronous,
- Stub_Type,
- RACW_Type,
- Parent_Primitive);
+ return PolyORB_Support.Build_Subprogram_Receiving_Stubs
+ (Vis_Decl,
+ Asynchronous,
+ Dynamically_Asynchronous,
+ Stub_Type,
+ RACW_Type,
+ Parent_Primitive);
+
when others =>
- return GARLIC_Support.Build_Subprogram_Receiving_Stubs (
- Vis_Decl,
- Asynchronous,
- Dynamically_Asynchronous,
- Stub_Type,
- RACW_Type,
- Parent_Primitive);
+ return GARLIC_Support.Build_Subprogram_Receiving_Stubs
+ (Vis_Decl,
+ Asynchronous,
+ Dynamically_Asynchronous,
+ Stub_Type,
+ RACW_Type,
+ Parent_Primitive);
end case;
end Specific_Build_Subprogram_Receiving_Stubs;
end if;
return
- Etype (Subtype_Indication (
- Component_Definition (
- First (Component_Items (Component_List (
- Type_Definition (Declaration_Node (Record_Type))))))));
+ Etype (Subtype_Indication
+ (Component_Definition
+ (First (Component_Items
+ (Component_List
+ (Type_Definition
+ (Declaration_Node (Record_Type))))))));
end Underlying_RACW_Type;
end Exp_Dist;