From 303b4d58d7c0c36982e852981ac245bce6030e2c Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 13 Dec 2007 11:25:14 +0100 Subject: [PATCH] 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 --- gcc/ada/exp_ch4.adb | 46 ++++++++++++++++++------------------ gcc/ada/exp_ch5.adb | 67 ++++++++++++++++++++++++++--------------------------- 2 files changed, 56 insertions(+), 57 deletions(-) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index c1b88be..30e08fd 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -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 diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 4de1074..d77ec23 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -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, - -- 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)); + -- The allocator is returned on the secondary stack. We + -- don't do this on VM targets, since the SS is not used. + + 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)); + + -- 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))) > -- 2.7.4