Commit 303b4d58 by Arnaud Charlet

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
parent 4ce9a2d8
...@@ -83,7 +83,7 @@ package body Exp_Ch4 is ...@@ -83,7 +83,7 @@ package body Exp_Ch4 is
(N : Node_Id; (N : Node_Id;
Op1 : Node_Id; Op1 : Node_Id;
Op2 : 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. -- corresponding library procedure.
procedure Displace_Allocator_Pointer (N : Node_Id); procedure Displace_Allocator_Pointer (N : Node_Id);
...@@ -382,6 +382,13 @@ package body Exp_Ch4 is ...@@ -382,6 +382,13 @@ package body Exp_Ch4 is
PtrT : Entity_Id; PtrT : Entity_Id;
begin 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 pragma Assert (Nkind (N) = N_Identifier
and then Nkind (Orig_Node) = N_Allocator); and then Nkind (Orig_Node) = N_Allocator);
...@@ -624,6 +631,7 @@ package body Exp_Ch4 is ...@@ -624,6 +631,7 @@ package body Exp_Ch4 is
if Is_Class_Wide_Type (Etype (Exp)) if Is_Class_Wide_Type (Etype (Exp))
and then Is_Interface (Etype (Exp)) and then Is_Interface (Etype (Exp))
and then VM_Target = No_VM
then then
Set_Expression Set_Expression
(Expression (N), (Expression (N),
...@@ -2816,8 +2824,8 @@ package body Exp_Ch4 is ...@@ -2816,8 +2824,8 @@ package body Exp_Ch4 is
begin begin
P := Parent (N); P := Parent (N);
while Present (P) loop while Present (P) loop
if Nkind (P) = N_Extended_Return_Statement if Nkind_In
or else Nkind (P) = N_Simple_Return_Statement (P, N_Extended_Return_Statement, N_Simple_Return_Statement)
then then
return True; return True;
...@@ -3282,8 +3290,8 @@ package body Exp_Ch4 is ...@@ -3282,8 +3290,8 @@ package body Exp_Ch4 is
New_Occurrence_Of New_Occurrence_Of
(Entity (Nam), Sloc (Nam)), T); (Entity (Nam), Sloc (Nam)), T);
elsif (Nkind (Nam) = N_Indexed_Component elsif Nkind_In
or else Nkind (Nam) = N_Selected_Component) (Nam, N_Indexed_Component, N_Selected_Component)
and then Is_Entity_Name (Prefix (Nam)) and then Is_Entity_Name (Prefix (Nam))
then then
Decls := Decls :=
...@@ -4165,8 +4173,8 @@ package body Exp_Ch4 is ...@@ -4165,8 +4173,8 @@ package body Exp_Ch4 is
if Nkind (Parnt) = N_Unchecked_Expression then if Nkind (Parnt) = N_Unchecked_Expression then
null; null;
elsif Nkind (Parnt) = N_Object_Renaming_Declaration elsif Nkind_In (Parnt, N_Object_Renaming_Declaration,
or else Nkind (Parnt) = N_Procedure_Call_Statement N_Procedure_Call_Statement)
or else (Nkind (Parnt) = N_Parameter_Association or else (Nkind (Parnt) = N_Parameter_Association
and then and then
Nkind (Parent (Parnt)) = N_Procedure_Call_Statement) Nkind (Parent (Parnt)) = N_Procedure_Call_Statement)
...@@ -4206,8 +4214,7 @@ package body Exp_Ch4 is ...@@ -4206,8 +4214,7 @@ package body Exp_Ch4 is
then then
return; return;
elsif (Nkind (Parnt) = N_Indexed_Component elsif Nkind_In (Parnt, N_Indexed_Component, N_Selected_Component)
or else Nkind (Parnt) = N_Selected_Component)
and then Prefix (Parnt) = Child and then Prefix (Parnt) = Child
then then
null; null;
...@@ -6247,11 +6254,9 @@ package body Exp_Ch4 is ...@@ -6247,11 +6254,9 @@ package body Exp_Ch4 is
-- Special case the negation of a binary operation -- Special case the negation of a binary operation
elsif (Nkind (Opnd) = N_Op_And elsif Nkind_In (Opnd, N_Op_And, N_Op_Or, N_Op_Xor)
or else Nkind (Opnd) = N_Op_Or
or else Nkind (Opnd) = N_Op_Xor)
and then Safe_In_Place_Array_Op 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 then
Build_Boolean_Array_Proc_Call (Parent (N), Opnd, Empty); Build_Boolean_Array_Proc_Call (Parent (N), Opnd, Empty);
return; return;
...@@ -6974,9 +6979,9 @@ package body Exp_Ch4 is ...@@ -6974,9 +6979,9 @@ package body Exp_Ch4 is
-- expression, since these are additional cases that do can -- expression, since these are additional cases that do can
-- appear on procedure actuals. -- appear on procedure actuals.
elsif Nkind (Par) = N_Type_Conversion elsif Nkind_In (Par, N_Type_Conversion,
or else Nkind (Par) = N_Parameter_Association N_Parameter_Association,
or else Nkind (Par) = N_Qualified_Expression N_Qualified_Expression)
then then
Par := Parent (Par); Par := Parent (Par);
...@@ -8278,10 +8283,7 @@ package body Exp_Ch4 is ...@@ -8278,10 +8283,7 @@ package body Exp_Ch4 is
-- For identifiers and indexed components, it is sufficent to have a -- For identifiers and indexed components, it is sufficent to have a
-- constrained Unchecked_Union nominal subtype. -- constrained Unchecked_Union nominal subtype.
if Nkind (N) = N_Identifier if Nkind_In (N, N_Identifier, N_Indexed_Component) then
or else
Nkind (N) = N_Indexed_Component
then
return Is_Unchecked_Union (Base_Type (Etype (N))) return Is_Unchecked_Union (Base_Type (Etype (N)))
and then and then
Is_Constrained (Etype (N)); Is_Constrained (Etype (N));
...@@ -8944,9 +8946,7 @@ package body Exp_Ch4 is ...@@ -8944,9 +8946,7 @@ package body Exp_Ch4 is
elsif Is_Entity_Name (Op) then elsif Is_Entity_Name (Op) then
return Is_Unaliased (Op); return Is_Unaliased (Op);
elsif Nkind (Op) = N_Indexed_Component elsif Nkind_In (Op, N_Indexed_Component, N_Selected_Component) then
or else Nkind (Op) = N_Selected_Component
then
return Is_Unaliased (Prefix (Op)); return Is_Unaliased (Prefix (Op));
elsif Nkind (Op) = N_Slice then elsif Nkind (Op) = N_Slice then
......
...@@ -1523,9 +1523,7 @@ package body Exp_Ch5 is ...@@ -1523,9 +1523,7 @@ package body Exp_Ch5 is
-- Since P is going to be evaluated more than once, any subscripts -- Since P is going to be evaluated more than once, any subscripts
-- in P must have their evaluation forced. -- in P must have their evaluation forced.
if (Nkind (Lhs) = N_Indexed_Component if Nkind_In (Lhs, N_Indexed_Component, N_Selected_Component)
or else
Nkind (Lhs) = N_Selected_Component)
and then Is_Ref_To_Bit_Packed_Array (Prefix (Lhs)) and then Is_Ref_To_Bit_Packed_Array (Prefix (Lhs))
then then
declare declare
...@@ -1562,9 +1560,8 @@ package body Exp_Ch5 is ...@@ -1562,9 +1560,8 @@ package body Exp_Ch5 is
loop loop
Set_Analyzed (Exp, False); Set_Analyzed (Exp, False);
if Nkind (Exp) = N_Selected_Component if Nkind_In
or else (Exp, N_Selected_Component, N_Indexed_Component)
Nkind (Exp) = N_Indexed_Component
then then
Exp := Prefix (Exp); Exp := Prefix (Exp);
else else
...@@ -1958,9 +1955,8 @@ package body Exp_Ch5 is ...@@ -1958,9 +1955,8 @@ package body Exp_Ch5 is
Actual_Rhs : Node_Id := Rhs; Actual_Rhs : Node_Id := Rhs;
begin begin
while Nkind (Actual_Rhs) = N_Type_Conversion while Nkind_In (Actual_Rhs, N_Type_Conversion,
or else N_Qualified_Expression)
Nkind (Actual_Rhs) = N_Qualified_Expression
loop loop
Actual_Rhs := Expression (Actual_Rhs); Actual_Rhs := Expression (Actual_Rhs);
end loop; end loop;
...@@ -2017,9 +2013,7 @@ package body Exp_Ch5 is ...@@ -2017,9 +2013,7 @@ package body Exp_Ch5 is
-- Skip this if left hand side is an array or record component -- Skip this if left hand side is an array or record component
-- and elementary component validity checks are suppressed. -- and elementary component validity checks are suppressed.
if (Nkind (Lhs) = N_Selected_Component if Nkind_In (Lhs, N_Selected_Component, N_Indexed_Component)
or else
Nkind (Lhs) = N_Indexed_Component)
and then not Validity_Check_Components and then not Validity_Check_Components
then then
null; null;
...@@ -2798,24 +2792,29 @@ package body Exp_Ch5 is ...@@ -2798,24 +2792,29 @@ package body Exp_Ch5 is
SS_Allocator := New_Copy_Tree (Heap_Allocator); SS_Allocator := New_Copy_Tree (Heap_Allocator);
end if; end if;
Set_Storage_Pool -- The allocator is returned on the secondary stack. We
(SS_Allocator, RTE (RE_SS_Pool)); -- don't do this on VM targets, since the SS is not used.
Set_Procedure_To_Call
(SS_Allocator, RTE (RE_SS_Allocate)); if VM_Target = No_VM then
Set_Storage_Pool (SS_Allocator, RTE (RE_SS_Pool));
-- The allocator is returned on the secondary stack, Set_Procedure_To_Call
-- so indicate that the function return, as well as (SS_Allocator, RTE (RE_SS_Allocate));
-- the block that encloses the allocator, must not
-- release it. The flags must be set now because the -- The allocator is returned on the secondary stack,
-- decision to use the secondary stack is done very -- so indicate that the function return, as well as
-- late in the course of expanding the return statement, -- the block that encloses the allocator, must not
-- past the point where these flags are normally set. -- release it. The flags must be set now because the
-- decision to use the secondary stack is done very
Set_Sec_Stack_Needed_For_Return (Parent_Function); -- late in the course of expanding the return
Set_Sec_Stack_Needed_For_Return -- statement, past the point where these flags are
(Return_Statement_Entity (N)); -- normally set.
Set_Uses_Sec_Stack (Parent_Function);
Set_Uses_Sec_Stack (Return_Statement_Entity (N)); 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 -- Create an if statement to test the BIP_Alloc_Form
-- formal and initialize the access object to either the -- formal and initialize the access object to either the
...@@ -3842,8 +3841,8 @@ package body Exp_Ch5 is ...@@ -3842,8 +3841,8 @@ package body Exp_Ch5 is
if Is_Tagged_Type (Utyp) if Is_Tagged_Type (Utyp)
and then not Is_Class_Wide_Type (Utyp) and then not Is_Class_Wide_Type (Utyp)
and then (Nkind (Exp) = N_Type_Conversion and then (Nkind_In (Exp, N_Type_Conversion,
or else Nkind (Exp) = N_Unchecked_Type_Conversion N_Unchecked_Type_Conversion)
or else (Is_Entity_Name (Exp) or else (Is_Entity_Name (Exp)
and then Ekind (Entity (Exp)) in Formal_Kind)) and then Ekind (Entity (Exp)) in Formal_Kind))
then then
...@@ -3918,8 +3917,8 @@ package body Exp_Ch5 is ...@@ -3918,8 +3917,8 @@ package body Exp_Ch5 is
and then not Scope_Suppress (Accessibility_Check) and then not Scope_Suppress (Accessibility_Check)
and then and then
(Is_Class_Wide_Type (Etype (Exp)) (Is_Class_Wide_Type (Etype (Exp))
or else Nkind (Exp) = N_Type_Conversion or else Nkind_In (Exp, N_Type_Conversion,
or else Nkind (Exp) = N_Unchecked_Type_Conversion N_Unchecked_Type_Conversion)
or else (Is_Entity_Name (Exp) or else (Is_Entity_Name (Exp)
and then Ekind (Entity (Exp)) in Formal_Kind) and then Ekind (Entity (Exp)) in Formal_Kind)
or else Scope_Depth (Enclosing_Dynamic_Scope (Etype (Exp))) > or else Scope_Depth (Enclosing_Dynamic_Scope (Etype (Exp))) >
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment