exp_ch4.adb (Expand_N_Attribute_Reference, [...]): Take into account VM_Target
* exp_ch4.adb (Expand_N_Attribute_Reference, Displace_Allocator_Pointer, Expand_Allocator_Expression): Take into account VM_Target * exp_ch5.adb (Expand_N_Extended_Return_Statement): Do not use secondary stack when VM_Target /= No_VM From-SVN: r130831
This commit is contained in:
parent
4ce9a2d8c3
commit
303b4d58d7
@ -83,7 +83,7 @@ package body Exp_Ch4 is
|
||||
(N : Node_Id;
|
||||
Op1 : Node_Id;
|
||||
Op2 : Node_Id);
|
||||
-- If an boolean array assignment can be done in place, build call to
|
||||
-- If a boolean array assignment can be done in place, build call to
|
||||
-- corresponding library procedure.
|
||||
|
||||
procedure Displace_Allocator_Pointer (N : Node_Id);
|
||||
@ -382,6 +382,13 @@ package body Exp_Ch4 is
|
||||
PtrT : Entity_Id;
|
||||
|
||||
begin
|
||||
-- Do nothing in case of VM targets: the virtual machine will handle
|
||||
-- interfaces directly.
|
||||
|
||||
if VM_Target /= No_VM then
|
||||
return;
|
||||
end if;
|
||||
|
||||
pragma Assert (Nkind (N) = N_Identifier
|
||||
and then Nkind (Orig_Node) = N_Allocator);
|
||||
|
||||
@ -624,6 +631,7 @@ package body Exp_Ch4 is
|
||||
|
||||
if Is_Class_Wide_Type (Etype (Exp))
|
||||
and then Is_Interface (Etype (Exp))
|
||||
and then VM_Target = No_VM
|
||||
then
|
||||
Set_Expression
|
||||
(Expression (N),
|
||||
@ -2816,8 +2824,8 @@ package body Exp_Ch4 is
|
||||
begin
|
||||
P := Parent (N);
|
||||
while Present (P) loop
|
||||
if Nkind (P) = N_Extended_Return_Statement
|
||||
or else Nkind (P) = N_Simple_Return_Statement
|
||||
if Nkind_In
|
||||
(P, N_Extended_Return_Statement, N_Simple_Return_Statement)
|
||||
then
|
||||
return True;
|
||||
|
||||
@ -3282,8 +3290,8 @@ package body Exp_Ch4 is
|
||||
New_Occurrence_Of
|
||||
(Entity (Nam), Sloc (Nam)), T);
|
||||
|
||||
elsif (Nkind (Nam) = N_Indexed_Component
|
||||
or else Nkind (Nam) = N_Selected_Component)
|
||||
elsif Nkind_In
|
||||
(Nam, N_Indexed_Component, N_Selected_Component)
|
||||
and then Is_Entity_Name (Prefix (Nam))
|
||||
then
|
||||
Decls :=
|
||||
@ -4165,8 +4173,8 @@ package body Exp_Ch4 is
|
||||
if Nkind (Parnt) = N_Unchecked_Expression then
|
||||
null;
|
||||
|
||||
elsif Nkind (Parnt) = N_Object_Renaming_Declaration
|
||||
or else Nkind (Parnt) = N_Procedure_Call_Statement
|
||||
elsif Nkind_In (Parnt, N_Object_Renaming_Declaration,
|
||||
N_Procedure_Call_Statement)
|
||||
or else (Nkind (Parnt) = N_Parameter_Association
|
||||
and then
|
||||
Nkind (Parent (Parnt)) = N_Procedure_Call_Statement)
|
||||
@ -4206,8 +4214,7 @@ package body Exp_Ch4 is
|
||||
then
|
||||
return;
|
||||
|
||||
elsif (Nkind (Parnt) = N_Indexed_Component
|
||||
or else Nkind (Parnt) = N_Selected_Component)
|
||||
elsif Nkind_In (Parnt, N_Indexed_Component, N_Selected_Component)
|
||||
and then Prefix (Parnt) = Child
|
||||
then
|
||||
null;
|
||||
@ -6247,11 +6254,9 @@ package body Exp_Ch4 is
|
||||
|
||||
-- Special case the negation of a binary operation
|
||||
|
||||
elsif (Nkind (Opnd) = N_Op_And
|
||||
or else Nkind (Opnd) = N_Op_Or
|
||||
or else Nkind (Opnd) = N_Op_Xor)
|
||||
elsif Nkind_In (Opnd, N_Op_And, N_Op_Or, N_Op_Xor)
|
||||
and then Safe_In_Place_Array_Op
|
||||
(Name (Parent (N)), Left_Opnd (Opnd), Right_Opnd (Opnd))
|
||||
(Name (Parent (N)), Left_Opnd (Opnd), Right_Opnd (Opnd))
|
||||
then
|
||||
Build_Boolean_Array_Proc_Call (Parent (N), Opnd, Empty);
|
||||
return;
|
||||
@ -6974,9 +6979,9 @@ package body Exp_Ch4 is
|
||||
-- expression, since these are additional cases that do can
|
||||
-- appear on procedure actuals.
|
||||
|
||||
elsif Nkind (Par) = N_Type_Conversion
|
||||
or else Nkind (Par) = N_Parameter_Association
|
||||
or else Nkind (Par) = N_Qualified_Expression
|
||||
elsif Nkind_In (Par, N_Type_Conversion,
|
||||
N_Parameter_Association,
|
||||
N_Qualified_Expression)
|
||||
then
|
||||
Par := Parent (Par);
|
||||
|
||||
@ -8278,10 +8283,7 @@ package body Exp_Ch4 is
|
||||
-- For identifiers and indexed components, it is sufficent to have a
|
||||
-- constrained Unchecked_Union nominal subtype.
|
||||
|
||||
if Nkind (N) = N_Identifier
|
||||
or else
|
||||
Nkind (N) = N_Indexed_Component
|
||||
then
|
||||
if Nkind_In (N, N_Identifier, N_Indexed_Component) then
|
||||
return Is_Unchecked_Union (Base_Type (Etype (N)))
|
||||
and then
|
||||
Is_Constrained (Etype (N));
|
||||
@ -8944,9 +8946,7 @@ package body Exp_Ch4 is
|
||||
elsif Is_Entity_Name (Op) then
|
||||
return Is_Unaliased (Op);
|
||||
|
||||
elsif Nkind (Op) = N_Indexed_Component
|
||||
or else Nkind (Op) = N_Selected_Component
|
||||
then
|
||||
elsif Nkind_In (Op, N_Indexed_Component, N_Selected_Component) then
|
||||
return Is_Unaliased (Prefix (Op));
|
||||
|
||||
elsif Nkind (Op) = N_Slice then
|
||||
|
@ -1523,9 +1523,7 @@ package body Exp_Ch5 is
|
||||
-- Since P is going to be evaluated more than once, any subscripts
|
||||
-- in P must have their evaluation forced.
|
||||
|
||||
if (Nkind (Lhs) = N_Indexed_Component
|
||||
or else
|
||||
Nkind (Lhs) = N_Selected_Component)
|
||||
if Nkind_In (Lhs, N_Indexed_Component, N_Selected_Component)
|
||||
and then Is_Ref_To_Bit_Packed_Array (Prefix (Lhs))
|
||||
then
|
||||
declare
|
||||
@ -1562,9 +1560,8 @@ package body Exp_Ch5 is
|
||||
loop
|
||||
Set_Analyzed (Exp, False);
|
||||
|
||||
if Nkind (Exp) = N_Selected_Component
|
||||
or else
|
||||
Nkind (Exp) = N_Indexed_Component
|
||||
if Nkind_In
|
||||
(Exp, N_Selected_Component, N_Indexed_Component)
|
||||
then
|
||||
Exp := Prefix (Exp);
|
||||
else
|
||||
@ -1958,9 +1955,8 @@ package body Exp_Ch5 is
|
||||
Actual_Rhs : Node_Id := Rhs;
|
||||
|
||||
begin
|
||||
while Nkind (Actual_Rhs) = N_Type_Conversion
|
||||
or else
|
||||
Nkind (Actual_Rhs) = N_Qualified_Expression
|
||||
while Nkind_In (Actual_Rhs, N_Type_Conversion,
|
||||
N_Qualified_Expression)
|
||||
loop
|
||||
Actual_Rhs := Expression (Actual_Rhs);
|
||||
end loop;
|
||||
@ -2017,9 +2013,7 @@ package body Exp_Ch5 is
|
||||
-- Skip this if left hand side is an array or record component
|
||||
-- and elementary component validity checks are suppressed.
|
||||
|
||||
if (Nkind (Lhs) = N_Selected_Component
|
||||
or else
|
||||
Nkind (Lhs) = N_Indexed_Component)
|
||||
if Nkind_In (Lhs, N_Selected_Component, N_Indexed_Component)
|
||||
and then not Validity_Check_Components
|
||||
then
|
||||
null;
|
||||
@ -2798,24 +2792,29 @@ package body Exp_Ch5 is
|
||||
SS_Allocator := New_Copy_Tree (Heap_Allocator);
|
||||
end if;
|
||||
|
||||
Set_Storage_Pool
|
||||
(SS_Allocator, RTE (RE_SS_Pool));
|
||||
Set_Procedure_To_Call
|
||||
(SS_Allocator, RTE (RE_SS_Allocate));
|
||||
-- The allocator is returned on the secondary stack. We
|
||||
-- don't do this on VM targets, since the SS is not used.
|
||||
|
||||
-- The allocator is returned on the secondary stack,
|
||||
-- so indicate that the function return, as well as
|
||||
-- the block that encloses the allocator, must not
|
||||
-- release it. The flags must be set now because the
|
||||
-- decision to use the secondary stack is done very
|
||||
-- late in the course of expanding the return statement,
|
||||
-- past the point where these flags are normally set.
|
||||
if VM_Target = No_VM then
|
||||
Set_Storage_Pool (SS_Allocator, RTE (RE_SS_Pool));
|
||||
Set_Procedure_To_Call
|
||||
(SS_Allocator, RTE (RE_SS_Allocate));
|
||||
|
||||
Set_Sec_Stack_Needed_For_Return (Parent_Function);
|
||||
Set_Sec_Stack_Needed_For_Return
|
||||
(Return_Statement_Entity (N));
|
||||
Set_Uses_Sec_Stack (Parent_Function);
|
||||
Set_Uses_Sec_Stack (Return_Statement_Entity (N));
|
||||
-- The allocator is returned on the secondary stack,
|
||||
-- so indicate that the function return, as well as
|
||||
-- the block that encloses the allocator, must not
|
||||
-- release it. The flags must be set now because the
|
||||
-- decision to use the secondary stack is done very
|
||||
-- late in the course of expanding the return
|
||||
-- statement, past the point where these flags are
|
||||
-- normally set.
|
||||
|
||||
Set_Sec_Stack_Needed_For_Return (Parent_Function);
|
||||
Set_Sec_Stack_Needed_For_Return
|
||||
(Return_Statement_Entity (N));
|
||||
Set_Uses_Sec_Stack (Parent_Function);
|
||||
Set_Uses_Sec_Stack (Return_Statement_Entity (N));
|
||||
end if;
|
||||
|
||||
-- Create an if statement to test the BIP_Alloc_Form
|
||||
-- formal and initialize the access object to either the
|
||||
@ -3842,8 +3841,8 @@ package body Exp_Ch5 is
|
||||
|
||||
if Is_Tagged_Type (Utyp)
|
||||
and then not Is_Class_Wide_Type (Utyp)
|
||||
and then (Nkind (Exp) = N_Type_Conversion
|
||||
or else Nkind (Exp) = N_Unchecked_Type_Conversion
|
||||
and then (Nkind_In (Exp, N_Type_Conversion,
|
||||
N_Unchecked_Type_Conversion)
|
||||
or else (Is_Entity_Name (Exp)
|
||||
and then Ekind (Entity (Exp)) in Formal_Kind))
|
||||
then
|
||||
@ -3918,8 +3917,8 @@ package body Exp_Ch5 is
|
||||
and then not Scope_Suppress (Accessibility_Check)
|
||||
and then
|
||||
(Is_Class_Wide_Type (Etype (Exp))
|
||||
or else Nkind (Exp) = N_Type_Conversion
|
||||
or else Nkind (Exp) = N_Unchecked_Type_Conversion
|
||||
or else Nkind_In (Exp, N_Type_Conversion,
|
||||
N_Unchecked_Type_Conversion)
|
||||
or else (Is_Entity_Name (Exp)
|
||||
and then Ekind (Entity (Exp)) in Formal_Kind)
|
||||
or else Scope_Depth (Enclosing_Dynamic_Scope (Etype (Exp))) >
|
||||
|
Loading…
Reference in New Issue
Block a user