2007-12-06 Robert Dewar <dewar@adacore.com>

	* atree.adb (Flag231..Flag247): New functions
	(Set_Flag231..Set_Flag247): New procedures
	(Basic_Set_Convention): Rename Set_Convention to be
	Basic_Set_Convention
	(Nkind_In): New functions
	Remove Atree.Delete_Tree/Delete_Node and Nlist.Delete_List

	* exp_ch6.adb (Expand_Call): Use new flag Has_Pragma_Inline_Always
	instead
	 of obsolete function Is_Always_Inlined
	(Register_Predefined_DT_Entry): Initialize slots of the second
	secondary dispatch table.
	Remove Atree.Delete_Tree/Delete_Node and Nlist.Delete_List
	(Expand_N_Function_Call): Remove special provision for stack checking.

	* exp_util.ads, exp_util.adb (Is_Predefined_Dispatching_Operation):
	Include _Disp_Requeue in the list of predefined operations.
	(Find_Interface_ADT): Modified to fulfill the new specification.
	Remove Atree.Delete_Tree/Delete_Node and Nlist.Delete_List

	* par-ch4.adb, nlists.ads, nlists.adb: 
	Remove Atree.Delete_Tree/Delete_Node and Nlist.Delete_List

	* sinfo.ads, sinfo.adb: (Nkind_In): New functions
	Fix location of flag for unrecognized pragma message

	* sem_ch7.adb: Use Nkind_In



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

1 files changed, 57 insertions, 235 deletions

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 451fa0b7d38..e8f5c114ace 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -1391,8 +1391,8 @@ package body Exp_Ch6 is
       begin
          loop
             Set_Analyzed (Pfx, False);
-            exit when Nkind (Pfx) /= N_Selected_Component
-              and then Nkind (Pfx) /= N_Indexed_Component;
+            exit when
+              not Nkind_In (Pfx, N_Selected_Component, N_Indexed_Component);
             Pfx := Prefix (Pfx);
          end loop;
       end Reset_Packed_Prefix;
@@ -1633,8 +1633,8 @@ package body Exp_Ch6 is
                P : constant Node_Id := Parent (N);
 
             begin
-               pragma Assert (Nkind (P) = N_Triggering_Alternative
-                 or else Nkind (P) = N_Entry_Call_Alternative);
+               pragma Assert (Nkind_In (P, N_Triggering_Alternative,
+                                           N_Entry_Call_Alternative));
 
                if Is_Non_Empty_List (Statements (P)) then
                   Insert_List_Before_And_Analyze
@@ -2023,10 +2023,7 @@ package body Exp_Ch6 is
          --  form, and rewritten before analysis.
 
          if not Analyzed (Prev_Orig)
-           and then
-             (Nkind (Actual) = N_Function_Call
-                or else
-              Nkind (Actual) = N_Identifier)
+           and then Nkind_In (Actual, N_Function_Call, N_Identifier)
          then
             Prev_Orig := Prev;
          end if;
@@ -2087,8 +2084,8 @@ package body Exp_Ch6 is
                   --  as out parameter actuals on calls to stream procedures.
 
                   Act_Prev := Prev;
-                  while Nkind (Act_Prev) = N_Type_Conversion
-                    or else Nkind (Act_Prev) = N_Unchecked_Type_Conversion
+                  while Nkind_In (Act_Prev, N_Type_Conversion,
+                                            N_Unchecked_Type_Conversion)
                   loop
                      Act_Prev := Expression (Act_Prev);
                   end loop;
@@ -2318,9 +2315,7 @@ package body Exp_Ch6 is
             then
                null;
 
-            elsif Nkind (Prev) = N_Allocator
-              or else Nkind (Prev) = N_Attribute_Reference
-            then
+            elsif Nkind_In (Prev, N_Allocator, N_Attribute_Reference) then
                null;
 
             --  Suppress null checks when passing to access parameters of Java
@@ -2361,9 +2356,8 @@ package body Exp_Ch6 is
 
                begin
                   Nod := Actual;
-                  while Nkind (Nod) = N_Indexed_Component
-                          or else
-                        Nkind (Nod) = N_Selected_Component
+                  while Nkind_In (Nod, N_Indexed_Component,
+                                       N_Selected_Component)
                   loop
                      Set_Analyzed (Nod, False);
                      Nod := Prefix (Nod);
@@ -2419,11 +2413,14 @@ package body Exp_Ch6 is
                Sav : Node_Id;
 
             begin
-               --  For an OUT parameter that is an assignable entity, we do not
-               --  want to clobber the Last_Assignment field, since if it is
-               --  set, it was precisely because it is indeed an OUT parameter!
-
-               if Ekind (Formal) = E_Out_Parameter
+               --  For an OUT or IN OUT parameter that is an assignable entity,
+               --  we do not want to clobber the Last_Assignment field, since
+               --  if it is set, it was precisely because it is indeed an OUT
+               --  or IN OUT parameter!
+
+               if (Ekind (Formal) = E_Out_Parameter
+                     or else
+                   Ekind (Formal) = E_In_Out_Parameter)
                  and then Is_Assignable (Ent)
                then
                   Sav := Last_Assignment (Ent);
@@ -2534,8 +2531,7 @@ package body Exp_Ch6 is
       --  Ada 2005 (AI-251): If some formal is a class-wide interface, expand
       --  it to point to the correct secondary virtual table
 
-      if (Nkind (N) = N_Function_Call
-           or else Nkind (N) = N_Procedure_Call_Statement)
+      if Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement)
         and then CW_Interface_Formals_Present
       then
          Expand_Interface_Actuals (N);
@@ -2549,8 +2545,7 @@ package body Exp_Ch6 is
       --  the VM back-ends directly handle the generation of dispatching
       --  calls and would have to undo any expansion to an indirect call.
 
-      if (Nkind (N) = N_Function_Call
-           or else Nkind (N) =  N_Procedure_Call_Statement)
+      if Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement)
         and then Present (Controlling_Argument (N))
         and then VM_Target = No_VM
       then
@@ -2899,7 +2894,7 @@ package body Exp_Ch6 is
 
                   if (In_Extended_Main_Code_Unit (N)
                         or else In_Extended_Main_Code_Unit (Parent (N))
-                        or else Is_Always_Inlined (Subp))
+                        or else Has_Pragma_Inline_Always (Subp))
                     and then (not In_Same_Extended_Unit (Sloc (Bod), Loc)
                                or else
                                  Earlier_In_Extended_Unit (Sloc (Bod), Loc))
@@ -3036,10 +3031,6 @@ package body Exp_Ch6 is
             --  If no arguments, delete entire list, this is the easy case
 
             if No (Last_Keep_Arg) then
-               while Is_Non_Empty_List (Parameter_Associations (N)) loop
-                  Delete_Tree (Remove_Head (Parameter_Associations (N)));
-               end loop;
-
                Set_Parameter_Associations (N, No_List);
                Set_First_Named_Actual (N, Empty);
 
@@ -3050,7 +3041,7 @@ package body Exp_Ch6 is
 
             elsif Is_List_Member (Last_Keep_Arg) then
                while Present (Next (Last_Keep_Arg)) loop
-                  Delete_Tree (Remove_Next (Last_Keep_Arg));
+                  Discard_Node (Remove_Next (Last_Keep_Arg));
                end loop;
 
                Set_First_Named_Actual (N, Empty);
@@ -3114,7 +3105,6 @@ package body Exp_Ch6 is
                      exit when No (Temp);
                      Set_Next_Named_Actual
                        (Passoc, Next_Named_Actual (Parent (Temp)));
-                     Delete_Tree (Temp);
                   end loop;
                end;
             end if;
@@ -3359,9 +3349,7 @@ package body Exp_Ch6 is
                --  use a qualified expression, because an aggregate is not a
                --  legal argument of a conversion.
 
-               if Nkind (Expression (N)) = N_Aggregate
-                 or else Nkind (Expression (N)) = N_Null
-               then
+               if Nkind_In (Expression (N), N_Aggregate, N_Null) then
                   Ret :=
                     Make_Qualified_Expression (Sloc (N),
                        Subtype_Mark => New_Occurrence_Of (Ret_Type, Sloc (N)),
@@ -3724,10 +3712,10 @@ package body Exp_Ch6 is
              and then Formal_Is_Used_Once (F))
 
            or else
-             ((Nkind (A) = N_Real_Literal    or else
-               Nkind (A) = N_Integer_Literal or else
-               Nkind (A) = N_Character_Literal)
-              and then not Address_Taken (F))
+             (Nkind_In (A, N_Real_Literal,
+                            N_Integer_Literal,
+                            N_Character_Literal)
+                and then not Address_Taken (F))
          then
             if Etype (F) /= Etype (A) then
                Set_Renamed_Object
@@ -3944,190 +3932,8 @@ package body Exp_Ch6 is
    ----------------------------
 
    procedure Expand_N_Function_Call (N : Node_Id) is
-      Typ   : constant Entity_Id := Etype (N);
-
-      function Returned_By_Reference return Boolean;
-      --  If the return type is returned through the secondary stack; that is
-      --  by reference, we don't want to create a temp to force stack checking.
-      --  ???"sec stack" is not right -- Ada 95 return-by-reference object are
-      --  returned wherever they are.
-      --  Shouldn't this function be moved to exp_util???
-
-      function Rhs_Of_Assign_Or_Decl (N : Node_Id) return Boolean;
-      --  If the call is the right side of an assignment or the expression in
-      --  an object declaration, we don't need to create a temp as the left
-      --  side will already trigger stack checking if necessary.
-      --
-      --  If the call is a component in an extension aggregate, it will be
-      --  expanded into assignments as well, so no temporary is needed. This
-      --  also solves the problem of functions returning types with unknown
-      --  discriminants, where it is not possible to declare an object of the
-      --  type altogether.
-
-      ---------------------------
-      -- Returned_By_Reference --
-      ---------------------------
-
-      function Returned_By_Reference return Boolean is
-         S : Entity_Id;
-
-      begin
-         if Is_Inherently_Limited_Type (Typ) then
-            return True;
-
-         elsif Nkind (Parent (N)) /= N_Simple_Return_Statement then
-            return False;
-
-         elsif Requires_Transient_Scope (Typ) then
-
-            --  Verify that the return type of the enclosing function has the
-            --  same constrained status as that of the expression.
-
-            S := Current_Scope;
-            while Ekind (S) /= E_Function loop
-               S := Scope (S);
-            end loop;
-
-            return Is_Constrained (Typ) = Is_Constrained (Etype (S));
-         else
-            return False;
-         end if;
-      end Returned_By_Reference;
-
-      ---------------------------
-      -- Rhs_Of_Assign_Or_Decl --
-      ---------------------------
-
-      function Rhs_Of_Assign_Or_Decl (N : Node_Id) return Boolean is
-      begin
-         if (Nkind (Parent (N)) = N_Assignment_Statement
-               and then Expression (Parent (N)) = N)
-           or else
-             (Nkind (Parent (N)) = N_Qualified_Expression
-                and then Nkind (Parent (Parent (N))) = N_Assignment_Statement
-                  and then Expression (Parent (Parent (N))) = Parent (N))
-           or else
-             (Nkind (Parent (N)) = N_Object_Declaration
-                and then Expression (Parent (N)) = N)
-           or else
-             (Nkind (Parent (N)) = N_Component_Association
-                and then Expression (Parent (N)) = N
-                  and then Nkind (Parent (Parent (N))) = N_Aggregate
-                    and then Rhs_Of_Assign_Or_Decl (Parent (Parent (N))))
-           or else
-             (Nkind (Parent (N)) = N_Extension_Aggregate
-               and then Is_Private_Type (Etype (Typ)))
-         then
-            return True;
-         else
-            return False;
-         end if;
-      end Rhs_Of_Assign_Or_Decl;
-
-   --  Start of processing for Expand_N_Function_Call
-
    begin
-      --  A special check. If stack checking is enabled, and the return type
-      --  might generate a large temporary, and the call is not the right side
-      --  of an assignment, then generate an explicit temporary. We do this
-      --  because otherwise gigi may generate a large temporary on the fly and
-      --  this can cause trouble with stack checking.
-
-      --  This is unnecessary if the call is the expression in an object
-      --  declaration, or if it appears outside of any library unit. This can
-      --  only happen if it appears as an actual in a library-level instance,
-      --  in which case a temporary will be generated for it once the instance
-      --  itself is installed.
-
-      if May_Generate_Large_Temp (Typ)
-        and then not Rhs_Of_Assign_Or_Decl (N)
-        and then not Returned_By_Reference
-        and then Current_Scope /= Standard_Standard
-      then
-         if Stack_Checking_Enabled then
-
-            --  Note: it might be thought that it would be OK to use a call to
-            --  Force_Evaluation here, but that's not good enough, because
-            --  that can results in a 'Reference construct that may still need
-            --  a temporary.
-
-            declare
-               Loc      : constant Source_Ptr := Sloc (N);
-               Temp_Obj : constant Entity_Id :=
-                            Make_Defining_Identifier (Loc,
-                              Chars => New_Internal_Name ('F'));
-               Temp_Typ : Entity_Id := Typ;
-               Decl     : Node_Id;
-               A        : Node_Id;
-               F        : Entity_Id;
-               Proc     : Entity_Id;
-
-            begin
-               if Is_Tagged_Type (Typ)
-                 and then Present (Controlling_Argument (N))
-               then
-                  if Nkind (Parent (N)) /= N_Procedure_Call_Statement
-                    and then Nkind (Parent (N)) /= N_Function_Call
-                  then
-                     --  If this is a tag-indeterminate call, the object must
-                     --  be classwide.
-
-                     if Is_Tag_Indeterminate (N) then
-                        Temp_Typ := Class_Wide_Type (Typ);
-                     end if;
-
-                  else
-                     --  If this is a dispatching call that is itself the
-                     --  controlling argument of an enclosing call, the
-                     --  nominal subtype of the object that replaces it must
-                     --  be classwide, so that dispatching will take place
-                     --  properly. If it is not a controlling argument, the
-                     --  object is not classwide.
-
-                     Proc := Entity (Name (Parent (N)));
-
-                     F := First_Formal (Proc);
-                     A := First_Actual (Parent (N));
-                     while A /= N loop
-                        Next_Formal (F);
-                        Next_Actual (A);
-                     end loop;
-
-                     if Is_Controlling_Formal (F) then
-                        Temp_Typ := Class_Wide_Type (Typ);
-                     end if;
-                  end if;
-               end if;
-
-               Decl :=
-                 Make_Object_Declaration (Loc,
-                   Defining_Identifier => Temp_Obj,
-                   Object_Definition   => New_Occurrence_Of (Temp_Typ, Loc),
-                   Constant_Present    => True,
-                   Expression          => Relocate_Node (N));
-               Set_Assignment_OK (Decl);
-
-               Insert_Actions (N, New_List (Decl));
-               Rewrite (N, New_Occurrence_Of (Temp_Obj, Loc));
-            end;
-
-         else
-            --  If stack-checking is not enabled, increment serial number
-            --  for internal names, so that subsequent symbols are consistent
-            --  with and without stack-checking.
-
-            Synchronize_Serial_Number;
-
-            --  Now we can expand the call with consistent symbol names
-
-            Expand_Call (N);
-         end if;
-
-      --  Normal case, expand the call
-
-      else
-         Expand_Call (N);
-      end if;
+      Expand_Call (N);
    end Expand_N_Function_Call;
 
    ---------------------------------------
@@ -4881,8 +4687,8 @@ package body Exp_Ch6 is
       --  Step past qualification or unchecked conversion (the latter can occur
       --  in cases of calls to 'Input).
 
-      if Nkind (Exp_Node) = N_Qualified_Expression
-        or else Nkind (Exp_Node) = N_Unchecked_Type_Conversion
+      if Nkind_In
+           (Exp_Node, N_Qualified_Expression, N_Unchecked_Type_Conversion)
       then
          Exp_Node := Expression (N);
       end if;
@@ -4908,8 +4714,8 @@ package body Exp_Ch6 is
 
    function Is_Build_In_Place_Function_Return (N : Node_Id) return Boolean is
    begin
-      if Nkind (N) = N_Simple_Return_Statement
-        or else Nkind (N) = N_Extended_Return_Statement
+      if Nkind_In (N, N_Simple_Return_Statement,
+                      N_Extended_Return_Statement)
       then
          return Is_Build_In_Place_Function
                   (Return_Applies_To (Return_Statement_Entity (N)));
@@ -4962,10 +4768,11 @@ package body Exp_Ch6 is
          while Present (Iface_DT_Ptr)
             and then Ekind (Node (Iface_DT_Ptr)) = E_Constant
          loop
+            pragma Assert (Has_Thunks (Node (Iface_DT_Ptr)));
             Expand_Interface_Thunk (Prim, Thunk_Id, Thunk_Code);
 
             if Present (Thunk_Code) then
-               Insert_Actions (N, New_List (
+               Insert_Actions_After (N, New_List (
                  Thunk_Code,
 
                  Build_Set_Predefined_Prim_Op_Address (Loc,
@@ -4974,10 +4781,22 @@ package body Exp_Ch6 is
                    Address_Node =>
                      Make_Attribute_Reference (Loc,
                        Prefix         => New_Reference_To (Thunk_Id, Loc),
+                       Attribute_Name => Name_Address)),
+
+                 Build_Set_Predefined_Prim_Op_Address (Loc,
+                   Tag_Node => New_Reference_To
+                                 (Node (Next_Elmt (Iface_DT_Ptr)), Loc),
+                   Position => DT_Position (Prim),
+                   Address_Node =>
+                     Make_Attribute_Reference (Loc,
+                       Prefix         => New_Reference_To (Prim, Loc),
                        Attribute_Name => Name_Address))));
             end if;
 
             Next_Elmt (Iface_DT_Ptr);
+            pragma Assert (not Has_Thunks (Node (Iface_DT_Ptr)));
+
+            Next_Elmt (Iface_DT_Ptr);
          end loop;
       end Register_Predefined_DT_Entry;
 
@@ -4985,6 +4804,8 @@ package body Exp_Ch6 is
 
       Subp : constant Entity_Id := Entity (N);
 
+   --  Start of processing for Freeze_Subprogram
+
    begin
       --  We suppress the initialization of the dispatch table entry when
       --  VM_Target because the dispatching mechanism is handled internally
@@ -5088,8 +4909,9 @@ package body Exp_Ch6 is
       --  Step past qualification or unchecked conversion (the latter can occur
       --  in cases of calls to 'Input).
 
-      if Nkind (Func_Call) = N_Qualified_Expression
-        or else Nkind (Func_Call) = N_Unchecked_Type_Conversion
+      if Nkind_In (Func_Call,
+                   N_Qualified_Expression,
+                   N_Unchecked_Type_Conversion)
       then
          Func_Call := Expression (Func_Call);
       end if;
@@ -5241,8 +5063,8 @@ package body Exp_Ch6 is
       --  Step past qualification or unchecked conversion (the latter can occur
       --  in cases of calls to 'Input).
 
-      if Nkind (Func_Call) = N_Qualified_Expression
-        or else Nkind (Func_Call) = N_Unchecked_Type_Conversion
+      if Nkind_In (Func_Call, N_Qualified_Expression,
+                              N_Unchecked_Type_Conversion)
       then
          Func_Call := Expression (Func_Call);
       end if;
@@ -5369,8 +5191,8 @@ package body Exp_Ch6 is
       --  Step past qualification or unchecked conversion (the latter can occur
       --  in cases of calls to 'Input).
 
-      if Nkind (Func_Call) = N_Qualified_Expression
-        or else Nkind (Func_Call) = N_Unchecked_Type_Conversion
+      if Nkind_In (Func_Call, N_Qualified_Expression,
+                              N_Unchecked_Type_Conversion)
       then
          Func_Call := Expression (Func_Call);
       end if;
@@ -5491,8 +5313,8 @@ package body Exp_Ch6 is
       --  Step past qualification or unchecked conversion (the latter can occur
       --  in cases of calls to 'Input).
 
-      if Nkind (Func_Call) = N_Qualified_Expression
-        or else Nkind (Func_Call) = N_Unchecked_Type_Conversion
+      if Nkind_In (Func_Call, N_Qualified_Expression,
+                              N_Unchecked_Type_Conversion)
       then
          Func_Call := Expression (Func_Call);
       end if;