-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- the controlling formal of the equivalent RACW operation for a RAS
-- type is always left in first position.
+ function Transmit_As_Unconstrained (Typ : Entity_Id) return Boolean;
+ -- True when Typ is an unconstrained type, or a null-excluding access type.
+ -- In either case, this means stubs cannot contain a default-initialized
+ -- object declaration of such type.
+
procedure Add_Calling_Stubs_To_Declarations
(Pkg_Spec : Node_Id;
Decls : List_Id);
RPC_Receiver_Decl : Node_Id;
Body_Decls : List_Id);
-- Add declaration for TSSs for a given RACW type. The declarations are
- -- added just after the declaration of the RACW type itself, while the
- -- bodies are inserted at the end of Body_Decls. Runtime-specific ancillary
- -- subprogram for Add_RACW_Features.
+ -- added just after the declaration of the RACW type itself. If the RACW
+ -- appears in the main unit, Body_Decls is a list of declarations to which
+ -- the bodies are appended. Else Body_Decls is No_List.
+ -- PCS-specific ancillary subprogram for Add_RACW_Features.
procedure Specific_Add_RAST_Features
(Vis_Decl : Node_Id;
Body_Decls => Body_Decls,
Existing => Existing);
+ -- If this RACW is not in the main unit, do not generate primitive or
+ -- TSS bodies.
+
+ if not Entity_Is_In_Main_Unit (RACW_Type) then
+ Body_Decls := No_List;
+ end if;
+
Add_RACW_Asynchronous_Flag
(Declarations => Decls,
RACW_Type => RACW_Type);
Constrained_List : List_Id;
Unconstrained_List : List_Id;
Current_Parameter : Node_Id;
+ Ptyp : Node_Id;
First_Parameter : Node_Id;
For_RAS : Boolean := False;
For_RAS := True;
end if;
- -- Loop through the parameters and add them to the right list
+ -- Loop through the parameters and add them to the right list. Note that
+ -- we treat a parameter of a null-excluding access type as unconstrained
+ -- because we can't declare an object of such a type with default
+ -- initialization.
Current_Parameter := First_Parameter;
while Present (Current_Parameter) loop
- if (Nkind (Parameter_Type (Current_Parameter)) = N_Access_Definition
- or else
- Is_Constrained (Etype (Parameter_Type (Current_Parameter)))
- or else
- Is_Elementary_Type (Etype (Parameter_Type (Current_Parameter))))
+ Ptyp := Parameter_Type (Current_Parameter);
+
+ if (Nkind (Ptyp) = N_Access_Definition
+ or else not Transmit_As_Unconstrained (Etype (Ptyp)))
and then not (For_RAS and then Current_Parameter = First_Parameter)
then
Append_To (Constrained_List, New_Copy (Current_Parameter));
Body_Decls : List_Id);
-- Add Read attribute for the RACW type. The declaration and attribute
-- definition clauses are inserted right after the declaration of
- -- RACW_Type, while the subprogram body is appended to Body_Decls.
+ -- RACW_Type. If Body_Decls is not No_List, the subprogram body is
+ -- appended to it (case where the RACW declaration is in the main unit).
procedure Add_RACW_Write_Attribute
(RACW_Type : Entity_Id;
Body_Node : Node_Id;
+ Statements : constant List_Id := New_List;
Decls : List_Id;
- Statements : List_Id;
Local_Statements : List_Id;
Remote_Statements : List_Id;
-- Various parts of the procedure
- Procedure_Name : constant Name_Id :=
- New_Internal_Name ('R');
- Source_Partition : constant Entity_Id :=
- Make_Defining_Identifier
- (Loc, New_Internal_Name ('P'));
- Source_Receiver : constant Entity_Id :=
- Make_Defining_Identifier
- (Loc, New_Internal_Name ('S'));
- Source_Address : constant Entity_Id :=
- Make_Defining_Identifier
- (Loc, New_Internal_Name ('P'));
- Local_Stub : constant Entity_Id :=
+ Pnam : constant Entity_Id :=
Make_Defining_Identifier
- (Loc, New_Internal_Name ('L'));
- Stubbed_Result : constant Entity_Id :=
- Make_Defining_Identifier
- (Loc, New_Internal_Name ('S'));
+ (Loc, New_Internal_Name ('R'));
Asynchronous_Flag : constant Entity_Id :=
Asynchronous_Flags_Table.Get (RACW_Type);
pragma Assert (Present (Asynchronous_Flag));
+ -- Prepare local identifiers
+
+ Source_Partition : Entity_Id;
+ Source_Receiver : Entity_Id;
+ Source_Address : Entity_Id;
+ Local_Stub : Entity_Id;
+ Stubbed_Result : Entity_Id;
+
-- Start of processing for Add_RACW_Read_Attribute
begin
+ Build_Stream_Procedure (Loc,
+ RACW_Type, Body_Node, Pnam, Statements, Outp => True);
+ Proc_Decl := Make_Subprogram_Declaration (Loc,
+ Copy_Specification (Loc, Specification (Body_Node)));
+
+ Attr_Decl :=
+ Make_Attribute_Definition_Clause (Loc,
+ Name => New_Occurrence_Of (RACW_Type, Loc),
+ Chars => Name_Read,
+ Expression =>
+ New_Occurrence_Of (
+ Defining_Unit_Name (Specification (Proc_Decl)), Loc));
+
+ Insert_After (Declaration_Node (RACW_Type), Proc_Decl);
+ 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.
+
+ return;
+ end if;
+
+ -- Prepare local identifiers
+
+ Source_Partition :=
+ Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
+ Source_Receiver :=
+ Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
+ Source_Address :=
+ Make_Defining_Identifier (Loc, New_Internal_Name ('P'));
+ Local_Stub :=
+ Make_Defining_Identifier (Loc, New_Internal_Name ('L'));
+ Stubbed_Result :=
+ Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
+
-- Generate object declarations
Decls := New_List (
-- Read the source Partition_ID and RPC_Receiver from incoming stream
- Statements := New_List (
+ Append_List_To (Statements, New_List (
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (RTE (RE_Partition_ID), Loc),
Name_Read,
Expressions => New_List (
Stream_Parameter,
- New_Occurrence_Of (Source_Address, Loc))));
+ New_Occurrence_Of (Source_Address, Loc)))));
-- Build_Get_Unique_RP_Call needs the type of Stubbed_Result
Then_Statements => Local_Statements,
Else_Statements => Remote_Statements));
- Build_Stream_Procedure
- (Loc, RACW_Type, Body_Node,
- Make_Defining_Identifier (Loc, Procedure_Name),
- Statements, Outp => True);
Set_Declarations (Body_Node, Decls);
-
- Proc_Decl := Make_Subprogram_Declaration (Loc,
- Copy_Specification (Loc, Specification (Body_Node)));
-
- Attr_Decl :=
- Make_Attribute_Definition_Clause (Loc,
- Name => New_Occurrence_Of (RACW_Type, Loc),
- Chars => Name_Read,
- Expression =>
- New_Occurrence_Of (
- Defining_Unit_Name (Specification (Proc_Decl)), Loc));
-
- Insert_After (Declaration_Node (RACW_Type), Proc_Decl);
- Insert_After (Proc_Decl, Attr_Decl);
Append_To (Body_Decls, Body_Node);
end Add_RACW_Read_Attribute;
Proc_Decl : Node_Id;
Attr_Decl : Node_Id;
- Statements : List_Id;
+ Statements : constant List_Id := New_List;
Local_Statements : List_Id;
Remote_Statements : List_Id;
Null_Statements : List_Id;
- Procedure_Name : constant Name_Id := New_Internal_Name ('R');
+ Pnam : constant Entity_Id :=
+ Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
begin
+ Build_Stream_Procedure
+ (Loc, RACW_Type, Body_Node, Pnam, Statements, Outp => False);
+
+ Proc_Decl := Make_Subprogram_Declaration (Loc,
+ Copy_Specification (Loc, Specification (Body_Node)));
+
+ Attr_Decl :=
+ Make_Attribute_Definition_Clause (Loc,
+ Name => New_Occurrence_Of (RACW_Type, Loc),
+ Chars => Name_Write,
+ Expression =>
+ New_Occurrence_Of (
+ Defining_Unit_Name (Specification (Proc_Decl)), Loc));
+
+ Insert_After (Declaration_Node (RACW_Type), Proc_Decl);
+ Insert_After (Proc_Decl, Attr_Decl);
+
+ if No (Body_Decls) then
+ return;
+ end if;
+
-- Build the code fragment corresponding to the marshalling of a
-- local object.
Object => Make_Integer_Literal (Loc, Uint_0),
Etyp => RTE (RE_Unsigned_64)));
- Statements := New_List (
+ Append_To (Statements,
Make_Implicit_If_Statement (RACW_Type,
Condition =>
Make_Op_Eq (Loc,
Then_Statements => Remote_Statements)),
Else_Statements => Local_Statements));
- Build_Stream_Procedure
- (Loc, RACW_Type, Body_Node,
- Make_Defining_Identifier (Loc, Procedure_Name),
- Statements, Outp => False);
-
- Proc_Decl := Make_Subprogram_Declaration (Loc,
- Copy_Specification (Loc, Specification (Body_Node)));
-
- Attr_Decl :=
- Make_Attribute_Definition_Clause (Loc,
- Name => New_Occurrence_Of (RACW_Type, Loc),
- Chars => Name_Write,
- Expression =>
- New_Occurrence_Of (
- Defining_Unit_Name (Specification (Proc_Decl)), Loc));
-
- Insert_After (Declaration_Node (RACW_Type), Proc_Decl);
- Insert_After (Proc_Decl, Attr_Decl);
Append_To (Body_Decls, Body_Node);
end Add_RACW_Write_Attribute;
Etyp := Etype (Typ);
end if;
- Constrained :=
- Is_Constrained (Etyp) or else Is_Elementary_Type (Etyp);
+ Constrained := not Transmit_As_Unconstrained (Etyp);
-- Any parameter but unconstrained out parameters are
-- transmitted to the peer.
Etyp := Etype (Parameter_Type (Current_Parameter));
end if;
- Constrained :=
- Is_Constrained (Etyp) or else Is_Elementary_Type (Etyp);
+ Constrained := not Transmit_As_Unconstrained (Etyp);
if In_Present (Current_Parameter)
or else not Out_Present (Current_Parameter)
Body_Decls : List_Id);
-- Add Read attribute for the RACW type. The declaration and attribute
-- definition clauses are inserted right after the declaration of
- -- RACW_Type, while the subprogram body is appended to Body_Decls.
+ -- RACW_Type. If Body_Decls is not No_List, the subprogram body is
+ -- appended to it (case where the RACW declaration is in the main unit).
procedure Add_RACW_Write_Attribute
(RACW_Type : Entity_Id;
Is_RAS : constant Boolean := not Comes_From_Source (RACW_Type);
Fnam : constant Entity_Id :=
- Make_Defining_Identifier (Loc, New_Internal_Name ('F'));
+ Make_Defining_Identifier (Loc,
+ Chars => New_External_Name (Chars (RACW_Type), 'F'));
Func_Spec : Node_Id;
Func_Decl : Node_Id;
Any_Parameter : constant Entity_Id :=
Make_Defining_Identifier (Loc, Name_A);
- Reference : constant Entity_Id :=
- Make_Defining_Identifier
- (Loc, New_Internal_Name ('R'));
- Is_Local : constant Entity_Id :=
- Make_Defining_Identifier
- (Loc, New_Internal_Name ('L'));
- Addr : constant Entity_Id :=
- Make_Defining_Identifier
- (Loc, New_Internal_Name ('A'));
- Local_Stub : constant Entity_Id :=
- Make_Defining_Identifier
- (Loc, New_Internal_Name ('L'));
- Stubbed_Result : constant Entity_Id :=
- Make_Defining_Identifier
- (Loc, New_Internal_Name ('S'));
+
+ 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
-- The flag object declared in Add_RACW_Asynchronous_Flag
begin
+ Func_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))),
+ Result_Definition => New_Occurrence_Of (RACW_Type, Loc));
+
+ -- NOTE: The usage occurrences of RACW_Parameter must refer to the
+ -- entity in the declaration spec, not those of the body spec.
+
+ Func_Decl := Make_Subprogram_Declaration (Loc, Func_Spec);
+ Insert_After (Declaration_Node (RACW_Type), Func_Decl);
+ Set_Renaming_TSS (RACW_Type, Fnam, TSS_From_Any);
+
+ if No (Body_Decls) then
+ 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 =>
Expression => Unchecked_Convert_To (RACW_Type,
New_Occurrence_Of (Stubbed_Result, Loc))));
- Func_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))),
- Result_Definition => New_Occurrence_Of (RACW_Type, Loc));
-
- -- NOTE: The usage occurrences of RACW_Parameter must refer to the
- -- entity in the declaration spec, not those of the body spec.
-
- Func_Decl := Make_Subprogram_Declaration (Loc, Func_Spec);
-
Func_Body :=
Make_Subprogram_Body (Loc,
Specification =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Statements));
- Insert_After (Declaration_Node (RACW_Type), Func_Decl);
Append_To (Body_Decls, Func_Body);
-
- Set_Renaming_TSS (RACW_Type, Fnam, TSS_From_Any);
end Add_RACW_From_Any;
-----------------------------
Body_Node : Node_Id;
Decls : List_Id;
- Statements : List_Id;
+ Statements : constant List_Id := New_List;
-- Various parts of the procedure
- Procedure_Name : constant Name_Id :=
- New_Internal_Name ('R');
- Source_Ref : constant Entity_Id :=
- Make_Defining_Identifier
- (Loc, New_Internal_Name ('R'));
+ Pnam : constant Entity_Id :=
+ Make_Defining_Identifier (Loc,
+ New_Internal_Name ('R'));
+
+ Source_Ref : Entity_Id;
Asynchronous_Flag : constant Entity_Id :=
Asynchronous_Flags_Table.Get (RACW_Type);
pragma Assert (Present (Asynchronous_Flag));
-- Start of processing for Add_RACW_Read_Attribute
begin
+ Build_Stream_Procedure
+ (Loc, RACW_Type, Body_Node, Pnam, Statements, Outp => True);
+
+ Proc_Decl := Make_Subprogram_Declaration (Loc,
+ Copy_Specification (Loc, Specification (Body_Node)));
+
+ Attr_Decl :=
+ Make_Attribute_Definition_Clause (Loc,
+ Name => New_Occurrence_Of (RACW_Type, Loc),
+ Chars => Name_Read,
+ Expression =>
+ New_Occurrence_Of (
+ Defining_Unit_Name (Specification (Proc_Decl)), Loc));
+
+ Insert_After (Declaration_Node (RACW_Type), Proc_Decl);
+ Insert_After (Proc_Decl, Attr_Decl);
+
+ if No (Body_Decls) then
+ return;
+ end if;
+
+ Source_Ref := Make_Defining_Identifier
+ (Loc, New_Internal_Name ('R'));
+
-- Generate object declarations
Decls := New_List (
Object_Definition =>
New_Occurrence_Of (RTE (RE_Object_Ref), Loc)));
- Statements := New_List (
+ Append_List_To (Statements, New_List (
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (RTE (RE_Object_Ref), Loc),
New_Occurrence_Of (RTE (RE_TA_ObjRef), Loc),
Parameter_Associations => New_List (
New_Occurrence_Of (Source_Ref, Loc))),
- Decls)));
+ Decls))));
- Build_Stream_Procedure
- (Loc, RACW_Type, Body_Node,
- Make_Defining_Identifier (Loc, Procedure_Name),
- Statements, Outp => True);
Set_Declarations (Body_Node, Decls);
-
- Proc_Decl := Make_Subprogram_Declaration (Loc,
- Copy_Specification (Loc, Specification (Body_Node)));
-
- Attr_Decl :=
- Make_Attribute_Definition_Clause (Loc,
- Name => New_Occurrence_Of (RACW_Type, Loc),
- Chars => Name_Read,
- Expression =>
- New_Occurrence_Of (
- Defining_Unit_Name (Specification (Proc_Decl)), Loc));
-
- Insert_After (Declaration_Node (RACW_Type), Proc_Decl);
- Insert_After (Proc_Decl, Attr_Decl);
Append_To (Body_Decls, Body_Node);
end Add_RACW_Read_Attribute;
Is_RAS : constant Boolean := not Comes_From_Source (RACW_Type);
- Fnam : Entity_Id;
+ Fnam : constant Entity_Id :=
+ Make_Defining_Identifier (Loc,
+ Chars => New_External_Name (Chars (RACW_Type), 'T'));
Stub_Elements : constant Stub_Structure :=
Stubs_Table.Get (Designated_Type);
If_Node : Node_Id;
-- Various parts of the subprogram
- RACW_Parameter : constant Entity_Id
- := Make_Defining_Identifier (Loc, Name_R);
+ RACW_Parameter : constant Entity_Id :=
+ Make_Defining_Identifier (Loc, Name_R);
Reference : constant Entity_Id :=
Make_Defining_Identifier
(Loc, New_Internal_Name ('A'));
begin
+ Func_Spec :=
+ Make_Function_Specification (Loc,
+ Defining_Unit_Name =>
+ Fnam,
+ Parameter_Specifications => New_List (
+ Make_Parameter_Specification (Loc,
+ Defining_Identifier =>
+ RACW_Parameter,
+ Parameter_Type =>
+ New_Occurrence_Of (RACW_Type, Loc))),
+ Result_Definition => New_Occurrence_Of (RTE (RE_Any), Loc));
+
+ -- NOTE: The usage occurrences of RACW_Parameter must refer to the
+ -- entity in the declaration spec, not in the body spec.
+
+ Func_Decl := Make_Subprogram_Declaration (Loc, Func_Spec);
+
+ Insert_After (Declaration_Node (RACW_Type), Func_Decl);
+ Set_Renaming_TSS (RACW_Type, Fnam, TSS_To_Any);
+
+ if No (Body_Decls) then
+ return;
+ end if;
-- Object declarations
Expression =>
New_Occurrence_Of (Any, Loc)));
- Fnam := Make_Defining_Identifier (
- Loc, New_Internal_Name ('T'));
-
- Func_Spec :=
- Make_Function_Specification (Loc,
- Defining_Unit_Name =>
- Fnam,
- Parameter_Specifications => New_List (
- Make_Parameter_Specification (Loc,
- Defining_Identifier =>
- RACW_Parameter,
- Parameter_Type =>
- New_Occurrence_Of (RACW_Type, Loc))),
- Result_Definition => New_Occurrence_Of (RTE (RE_Any), Loc));
-
- -- NOTE: The usage occurrences of RACW_Parameter must refer to the
- -- entity in the declaration spec, not in the body spec.
-
- Func_Decl := Make_Subprogram_Declaration (Loc, Func_Spec);
-
Func_Body :=
Make_Subprogram_Body (Loc,
Specification =>
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Statements));
-
- Insert_After (Declaration_Node (RACW_Type), Func_Decl);
Append_To (Body_Decls, Func_Body);
-
- Set_Renaming_TSS (RACW_Type, Fnam, TSS_To_Any);
end Add_RACW_To_Any;
-----------------------
is
Loc : constant Source_Ptr := Sloc (RACW_Type);
- Fnam : Entity_Id;
+ Fnam : constant Entity_Id :=
+ Make_Defining_Identifier (Loc,
+ Chars => New_External_Name (Chars (RACW_Type), 'Y'));
Stub_Elements : constant Stub_Structure :=
Stubs_Table.Get (Designated_Type);
Func_Body : Node_Id;
begin
- Fnam :=
- Make_Defining_Identifier (Loc,
- Chars => New_Internal_Name ('T'));
-- The spec for this subprogram has a dummy 'access RACW' argument,
-- which serves only for overloading purposes.
-- entity in the declaration spec, not those of the body spec.
Func_Decl := Make_Subprogram_Declaration (Loc, Func_Spec);
+ Insert_After (Declaration_Node (RACW_Type), Func_Decl);
+ Set_Renaming_TSS (RACW_Type, Fnam, TSS_TypeCode);
+
+ if No (Body_Decls) then
+ return;
+ end if;
Func_Body :=
Make_Subprogram_Body (Loc,
Stub_Elements.RPC_Receiver_Decl),
Selector_Name => Name_Obj_TypeCode)))));
- Insert_After (Declaration_Node (RACW_Type), Func_Decl);
Append_To (Body_Decls, Func_Body);
-
- Set_Renaming_TSS (RACW_Type, Fnam, TSS_TypeCode);
end Add_RACW_TypeCode;
------------------------------
Proc_Decl : Node_Id;
Attr_Decl : Node_Id;
- Statements : List_Id;
- Procedure_Name : constant Name_Id := New_Internal_Name ('R');
+ Statements : constant List_Id := New_List;
+ Pnam : constant Entity_Id :=
+ Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
function Stream_Parameter return Node_Id;
function Object return Node_Id;
-- Start of processing for Add_RACW_Write_Attribute
begin
- Statements := New_List (
- Pack_Node_Into_Stream_Access (Loc,
- Stream => Stream_Parameter,
- Object =>
- Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_FA_ObjRef), Loc),
- Parameter_Associations => New_List (
- PolyORB_Support.Helpers.Build_To_Any_Call
- (Object, Body_Decls))),
- Etyp => RTE (RE_Object_Ref)));
-
Build_Stream_Procedure
- (Loc, RACW_Type, Body_Node,
- Make_Defining_Identifier (Loc, Procedure_Name),
- Statements, Outp => False);
+ (Loc, RACW_Type, Body_Node, Pnam, Statements, Outp => False);
Proc_Decl :=
Make_Subprogram_Declaration (Loc,
Insert_After (Declaration_Node (RACW_Type), Proc_Decl);
Insert_After (Proc_Decl, Attr_Decl);
+
+ if No (Body_Decls) then
+ return;
+ end if;
+
+ Append_To (Statements,
+ Pack_Node_Into_Stream_Access (Loc,
+ Stream => Stream_Parameter,
+ Object =>
+ Make_Function_Call (Loc,
+ Name =>
+ New_Occurrence_Of (RTE (RE_FA_ObjRef), Loc),
+ Parameter_Associations => New_List (
+ PolyORB_Support.Helpers.Build_To_Any_Call
+ (Object, Body_Decls))),
+ Etyp => RTE (RE_Object_Ref)));
+
Append_To (Body_Decls, Body_Node);
end Add_RACW_Write_Attribute;
Any : Entity_Id;
TC : Node_Id;
Idx : Node_Id) return Node_Id;
- -- Build a call to Get_Aggregate_Element on Any
- -- for typecode TC, returning the Idx'th element.
+ -- Build a call to Get_Aggregate_Element on Any for typecode TC,
+ -- returning the Idx'th element.
generic
Subprogram : Entity_Id;
Build_From_Any_Call (Etype (Field),
Build_Get_Aggregate_Element (Loc,
Any => Any,
- Tc => Build_TypeCode_Call (Loc,
+ TC => Build_TypeCode_Call (Loc,
Etype (Field), Decls),
Idx => Make_Integer_Literal (Loc,
Counter)),
Parameter_Associations => New_List (
Build_Get_Aggregate_Element (Loc,
Any => Any,
- Tc => Make_Function_Call (Loc,
- Name => New_Occurrence_Of (
- RTE (RE_Any_Member_Type), Loc),
- Parameter_Associations =>
- New_List (
- New_Occurrence_Of (Any, Loc),
- Make_Integer_Literal (Loc,
- Counter))),
- Idx => Make_Integer_Literal (Loc,
- Counter))))));
+ TC =>
+ Make_Function_Call (Loc,
+ Name => New_Occurrence_Of (
+ RTE (RE_Any_Member_Type), Loc),
+ Parameter_Associations =>
+ New_List (
+ New_Occurrence_Of (Any, Loc),
+ Make_Integer_Literal (Loc,
+ Intval => Counter))),
+ Idx =>
+ Make_Integer_Literal (Loc,
+ Intval => Counter))))));
Append_To (Stmts,
Make_Block_Statement (Loc,
Build_From_Any_Call (Disc_Type,
Build_Get_Aggregate_Element (Loc,
Any => Any_Parameter,
- Tc => Build_TypeCode_Call
+ TC => Build_TypeCode_Call
(Loc, Disc_Type, Decls),
- Idx => Make_Integer_Literal
- (Loc, Component_Counter)),
+ Idx => Make_Integer_Literal (Loc,
+ Intval => Component_Counter)),
Decls)));
Component_Counter := Component_Counter + 1;
Element_Any :=
Build_Get_Aggregate_Element (Loc,
Any => Any,
- Tc => Element_TC,
+ TC => Element_TC,
Idx => New_Occurrence_Of (Counter, Loc));
end;
Indt,
Build_Get_Aggregate_Element (Loc,
Any => Any_Parameter,
- Tc => Build_TypeCode_Call (Loc,
+ TC => Build_TypeCode_Call (Loc,
Indt, Decls),
Idx => Make_Integer_Literal (Loc, J - 1)),
Decls)));
OK_Convert_To (
Standard_Long_Integer,
Make_Function_Call (Loc,
- Name => New_Occurrence_Of (RTE (
+ Name =>
+ New_Occurrence_Of (RTE (
RE_Get_Nested_Sequence_Length
), Loc),
Parameter_Associations =>
end case;
end Specific_Build_Subprogram_Receiving_Stubs;
+ -------------------------------
+ -- Transmit_As_Unconstrained --
+ -------------------------------
+
+ function Transmit_As_Unconstrained (Typ : Entity_Id) return Boolean is
+ begin
+ return
+ not (Is_Elementary_Type (Typ) or else Is_Constrained (Typ))
+ or else (Is_Access_Type (Typ) and then Can_Never_Be_Null (Typ));
+ end Transmit_As_Unconstrained;
+
--------------------------
-- Underlying_RACW_Type --
--------------------------
projects / gcc.git / commitdiff