* 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

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@130831 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index c1b88be..30e08fd 100644 (file)
--- 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 (file)
--- 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))) >