atree.adb (Flag231..Flag247): New functions

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

From-SVN: r130820

gcc/ada/atree.adb

@@ -364,9 +364,6 @@ package body Atree is
       Flag228 : Boolean;
       Flag229 : Boolean;
       Flag230 : Boolean;
-
-      --  Note: flags 231-247 not in use yet
-
       Flag231 : Boolean;
 
       Flag232 : Boolean;
@@ -647,6 +644,18 @@ package body Atree is
       return Nodes.Table (N).Analyzed;
    end Analyzed;
 
+   --------------------------
+   -- Basic_Set_Convention --
+   --------------------------
+
+   procedure Basic_Set_Convention  (E : Entity_Id; Val : Convention_Id) is
+   begin
+      pragma Assert (Nkind (E) in N_Entity);
+      To_Flag_Word_Ptr
+        (Union_Id_Ptr'
+          (Nodes.Table (E + 2).Field12'Unrestricted_Access)).Convention := Val;
+   end Basic_Set_Convention;
+
    -----------------
    -- Change_Node --
    -----------------
@@ -868,91 +877,6 @@ package body Atree is
       end if;
    end Copy_Separate_Tree;
 
-   -----------------
-   -- Delete_Node --
-   -----------------
-
-   procedure Delete_Node (Node : Node_Id) is
-   begin
-      pragma Assert (not Nodes.Table (Node).In_List);
-
-      if Debug_Flag_N then
-         Write_Str ("Delete node ");
-         Write_Int (Int (Node));
-         Write_Eol;
-      end if;
-
-      Nodes.Table (Node)       := Default_Node;
-      Nodes.Table (Node).Nkind := N_Unused_At_Start;
-      Node_Count := Node_Count - 1;
-
-      --  Note: for now, we are not bothering to reuse deleted nodes
-
-   end Delete_Node;
-
-   -----------------
-   -- Delete_Tree --
-   -----------------
-
-   procedure Delete_Tree (Node : Node_Id) is
-
-      procedure Delete_Field (F : Union_Id);
-      --  Delete item pointed to by field F if it is a syntactic element
-
-      procedure Delete_List (L : List_Id);
-      --  Delete all elements on the given list
-
-      ------------------
-      -- Delete_Field --
-      ------------------
-
-      procedure Delete_Field (F : Union_Id) is
-      begin
-         if F = Union_Id (Empty) then
-            return;
-
-         elsif F in Node_Range
-           and then Parent (Node_Id (F)) = Node
-         then
-            Delete_Tree (Node_Id (F));
-
-         elsif F in List_Range
-           and then Parent (List_Id (F)) = Node
-         then
-            Delete_List (List_Id (F));
-
-         --  No need to test Elist case, there are no syntactic Elists
-
-         else
-            return;
-         end if;
-      end Delete_Field;
-
-      -----------------
-      -- Delete_List --
-      -----------------
-
-      procedure Delete_List (L : List_Id) is
-      begin
-         while Is_Non_Empty_List (L) loop
-            Delete_Tree (Remove_Head (L));
-         end loop;
-      end Delete_List;
-
-   --  Start of processing for Delete_Tree
-
-   begin
-      --  Delete descendents
-
-      Delete_Field (Field1 (Node));
-      Delete_Field (Field2 (Node));
-      Delete_Field (Field3 (Node));
-      Delete_Field (Field4 (Node));
-      Delete_Field (Field5 (Node));
-
-      --  ??? According to spec, Node itself should be deleted as well
-   end Delete_Tree;
-
    -----------
    -- Ekind --
    -----------
@@ -2275,6 +2199,94 @@ package body Atree is
       return Nodes.Table (N).Nkind;
    end Nkind;
 
+   --------------
+   -- Nkind_In --
+   --------------
+
+   function Nkind_In
+     (N  : Node_Id;
+      V1 : Node_Kind;
+      V2 : Node_Kind) return Boolean
+   is
+   begin
+      return Nkind_In (Nkind (N), V1, V2);
+   end Nkind_In;
+
+   function Nkind_In
+     (N  : Node_Id;
+      V1 : Node_Kind;
+      V2 : Node_Kind;
+      V3 : Node_Kind) return Boolean
+   is
+   begin
+      return Nkind_In (Nkind (N), V1, V2, V3);
+   end Nkind_In;
+
+   function Nkind_In
+     (N  : Node_Id;
+      V1 : Node_Kind;
+      V2 : Node_Kind;
+      V3 : Node_Kind;
+      V4 : Node_Kind) return Boolean
+   is
+   begin
+      return Nkind_In (Nkind (N), V1, V2, V3, V4);
+   end Nkind_In;
+
+   function Nkind_In
+     (N  : Node_Id;
+      V1 : Node_Kind;
+      V2 : Node_Kind;
+      V3 : Node_Kind;
+      V4 : Node_Kind;
+      V5 : Node_Kind) return Boolean
+   is
+   begin
+      return Nkind_In (Nkind (N), V1, V2, V3, V4, V5);
+   end Nkind_In;
+
+   function Nkind_In
+     (N  : Node_Id;
+      V1 : Node_Kind;
+      V2 : Node_Kind;
+      V3 : Node_Kind;
+      V4 : Node_Kind;
+      V5 : Node_Kind;
+      V6 : Node_Kind) return Boolean
+   is
+   begin
+      return Nkind_In (Nkind (N), V1, V2, V3, V4, V5, V6);
+   end Nkind_In;
+
+   function Nkind_In
+     (N  : Node_Id;
+      V1 : Node_Kind;
+      V2 : Node_Kind;
+      V3 : Node_Kind;
+      V4 : Node_Kind;
+      V5 : Node_Kind;
+      V6 : Node_Kind;
+      V7 : Node_Kind) return Boolean
+   is
+   begin
+      return Nkind_In (Nkind (N), V1, V2, V3, V4, V5, V6, V7);
+   end Nkind_In;
+
+   function Nkind_In
+     (N  : Node_Id;
+      V1 : Node_Kind;
+      V2 : Node_Kind;
+      V3 : Node_Kind;
+      V4 : Node_Kind;
+      V5 : Node_Kind;
+      V6 : Node_Kind;
+      V7 : Node_Kind;
+      V8 : Node_Kind) return Boolean
+   is
+   begin
+      return Nkind_In (Nkind (N), V1, V2, V3, V4, V5, V6, V7, V8);
+   end Nkind_In;
+
    --------
    -- No --
    --------
@@ -2443,10 +2455,6 @@ package body Atree is
       --  to Rewrite if there were an intention to save the original node.
 
       Orig_Nodes.Table (Old_Node) := Old_Node;
-
-      --  Finally delete the source, since it is now copied
-
-      Delete_Node (New_Node);
    end Replace;
 
    -------------
@@ -2534,19 +2542,6 @@ package body Atree is
       Default_Node.Comes_From_Source := Default;
    end Set_Comes_From_Source_Default;
 
-   --------------------
-   -- Set_Convention --
-   --------------------
-
-   procedure Set_Convention  (E : Entity_Id; Val : Convention_Id) is
-   begin
-      pragma Assert (Nkind (E) in N_Entity);
-      To_Flag_Word_Ptr
-        (Union_Id_Ptr'
-          (Nodes.Table (E + 2).Field12'Unrestricted_Access)).Convention :=
-                                                                        Val;
-   end Set_Convention;
-
    ---------------
    -- Set_Ekind --
    ---------------
@@ -4865,6 +4860,108 @@ package body Atree is
          return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag230;
       end Flag230;
 
+      function Flag231 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag231;
+      end Flag231;
+
+      function Flag232 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag232;
+      end Flag232;
+
+      function Flag233 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag233;
+      end Flag233;
+
+      function Flag234 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag234;
+      end Flag234;
+
+      function Flag235 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag235;
+      end Flag235;
+
+      function Flag236 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag236;
+      end Flag236;
+
+      function Flag237 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag237;
+      end Flag237;
+
+      function Flag238 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag238;
+      end Flag238;
+
+      function Flag239 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag239;
+      end Flag239;
+
+      function Flag240 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag240;
+      end Flag240;
+
+      function Flag241 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag241;
+      end Flag241;
+
+      function Flag242 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag242;
+      end Flag242;
+
+      function Flag243 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag243;
+      end Flag243;
+
+      function Flag244 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag244;
+      end Flag244;
+
+      function Flag245 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag245;
+      end Flag245;
+
+      function Flag246 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag246;
+      end Flag246;
+
+      function Flag247 (N : Node_Id) return Boolean is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         return To_Flag_Word5 (Nodes.Table (N + 4).Field12).Flag247;
+      end Flag247;
+
       procedure Set_Nkind (N : Node_Id; Val : Node_Kind) is
       begin
          pragma Assert (N <= Nodes.Last);
@@ -7091,6 +7188,142 @@ package body Atree is
              (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag230 := Val;
       end Set_Flag230;
 
+      procedure Set_Flag231 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         To_Flag_Word5_Ptr
+           (Union_Id_Ptr'
+             (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag231 := Val;
+      end Set_Flag231;
+
+      procedure Set_Flag232 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         To_Flag_Word5_Ptr
+           (Union_Id_Ptr'
+             (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag232 := Val;
+      end Set_Flag232;
+
+      procedure Set_Flag233 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         To_Flag_Word5_Ptr
+           (Union_Id_Ptr'
+             (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag233 := Val;
+      end Set_Flag233;
+
+      procedure Set_Flag234 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         To_Flag_Word5_Ptr
+           (Union_Id_Ptr'
+             (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag234 := Val;
+      end Set_Flag234;
+
+      procedure Set_Flag235 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         To_Flag_Word5_Ptr
+           (Union_Id_Ptr'
+             (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag235 := Val;
+      end Set_Flag235;
+
+      procedure Set_Flag236 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         To_Flag_Word5_Ptr
+           (Union_Id_Ptr'
+             (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag236 := Val;
+      end Set_Flag236;
+
+      procedure Set_Flag237 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         To_Flag_Word5_Ptr
+           (Union_Id_Ptr'
+             (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag237 := Val;
+      end Set_Flag237;
+
+      procedure Set_Flag238 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         To_Flag_Word5_Ptr
+           (Union_Id_Ptr'
+             (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag238 := Val;
+      end Set_Flag238;
+
+      procedure Set_Flag239 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         To_Flag_Word5_Ptr
+           (Union_Id_Ptr'
+             (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag239 := Val;
+      end Set_Flag239;
+
+      procedure Set_Flag240 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         To_Flag_Word5_Ptr
+           (Union_Id_Ptr'
+             (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag240 := Val;
+      end Set_Flag240;
+
+      procedure Set_Flag241 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         To_Flag_Word5_Ptr
+           (Union_Id_Ptr'
+             (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag241 := Val;
+      end Set_Flag241;
+
+      procedure Set_Flag242 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         To_Flag_Word5_Ptr
+           (Union_Id_Ptr'
+             (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag242 := Val;
+      end Set_Flag242;
+
+      procedure Set_Flag243 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         To_Flag_Word5_Ptr
+           (Union_Id_Ptr'
+             (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag243 := Val;
+      end Set_Flag243;
+
+      procedure Set_Flag244 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         To_Flag_Word5_Ptr
+           (Union_Id_Ptr'
+             (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag244 := Val;
+      end Set_Flag244;
+
+      procedure Set_Flag245 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         To_Flag_Word5_Ptr
+           (Union_Id_Ptr'
+             (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag245 := Val;
+      end Set_Flag245;
+
+      procedure Set_Flag246 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         To_Flag_Word5_Ptr
+           (Union_Id_Ptr'
+             (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag246 := Val;
+      end Set_Flag246;
+
+      procedure Set_Flag247 (N : Node_Id; Val : Boolean) is
+      begin
+         pragma Assert (Nkind (N) in N_Entity);
+         To_Flag_Word5_Ptr
+           (Union_Id_Ptr'
+             (Nodes.Table (N + 4).Field12'Unrestricted_Access)).Flag247 := Val;
+      end Set_Flag247;
+
       procedure Set_Node1_With_Parent (N : Node_Id; Val : Node_Id) is
       begin
          pragma Assert (N <= Nodes.Last);

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;

gcc/ada/exp_util.adb

@@ -1327,7 +1327,7 @@ package body Exp_Util is
 
    function Find_Interface_ADT
      (T     : Entity_Id;
-      Iface : Entity_Id) return Entity_Id
+      Iface : Entity_Id) return Elmt_Id
    is
       ADT   : Elmt_Id;
       Found : Boolean   := False;
@@ -1385,6 +1385,7 @@ package body Exp_Util is
                end if;
 
                Next_Elmt (ADT);
+               Next_Elmt (ADT);
                Next_Elmt (AI_Elmt);
             end loop;
          end if;
@@ -1423,7 +1424,7 @@ package body Exp_Util is
       pragma Assert (Present (Node (ADT)));
       Find_Secondary_Table (Typ);
       pragma Assert (Found);
-      return Node (ADT);
+      return ADT;
    end Find_Interface_ADT;
 
    ------------------------
@@ -2336,14 +2337,31 @@ package body Exp_Util is
 
             when N_And_Then | N_Or_Else =>
                if N = Right_Opnd (P) then
+
+                  --  We are now going to either append the actions to the
+                  --  actions field of the short-circuit operation. We will
+                  --  also analyze the actions now.
+
+                  --  This analysis is really too early, the proper thing would
+                  --  be to just park them there now, and only analyze them if
+                  --  we find we really need them, and to it at the proper
+                  --  final insertion point. However attempting to this proved
+                  --  tricky, so for now we just kill current values before and
+                  --  after the analyze call to make sure we avoid peculiar
+                  --  optimizations from this out of order insertion.
+
+                  Kill_Current_Values;
+
                   if Present (Actions (P)) then
                      Insert_List_After_And_Analyze
-                      (Last (Actions (P)), Ins_Actions);
+                       (Last (Actions (P)), Ins_Actions);
                   else
                      Set_Actions (P, Ins_Actions);
                      Analyze_List (Actions (P));
                   end if;
 
+                  Kill_Current_Values;
+
                   return;
                end if;
 
@@ -2985,11 +3003,12 @@ package body Exp_Util is
            or else TSS_Name  = TSS_Deep_Adjust
            or else TSS_Name  = TSS_Deep_Finalize
            or else (Ada_Version >= Ada_05
-             and then (Chars (E) = Name_uDisp_Asynchronous_Select
-               or else Chars (E) = Name_uDisp_Conditional_Select
-               or else Chars (E) = Name_uDisp_Get_Prim_Op_Kind
-               or else Chars (E) = Name_uDisp_Get_Task_Id
-               or else Chars (E) = Name_uDisp_Timed_Select))
+                      and then (Chars (E) = Name_uDisp_Asynchronous_Select
+                        or else Chars (E) = Name_uDisp_Conditional_Select
+                        or else Chars (E) = Name_uDisp_Get_Prim_Op_Kind
+                        or else Chars (E) = Name_uDisp_Get_Task_Id
+                        or else Chars (E) = Name_uDisp_Requeue
+                        or else Chars (E) = Name_uDisp_Timed_Select))
          then
             return True;
          end if;
@@ -3459,8 +3478,6 @@ package body Exp_Util is
          elsif Nkind (N) in N_Generic_Instantiation then
             Remove_Dead_Instance (N);
          end if;
-
-         Delete_Tree (N);
       end if;
    end Kill_Dead_Code;
 
@@ -3472,11 +3489,11 @@ package body Exp_Util is
    begin
       W := Warn;
       if Is_Non_Empty_List (L) then
-         loop
-            N := Remove_Head (L);
-            exit when No (N);
+         N := First (L);
+         while Present (N) loop
             Kill_Dead_Code (N, W);
             W := False;
+            Next (N);
          end loop;
       end if;
    end Kill_Dead_Code;

gcc/ada/exp_util.ads

@@ -338,9 +338,10 @@ package Exp_Util is
 
    function Find_Interface_ADT
      (T     : Entity_Id;
-      Iface : Entity_Id) return Entity_Id;
+      Iface : Entity_Id) return Elmt_Id;
    --  Ada 2005 (AI-251): Given a type T implementing the interface Iface,
-   --  return the Access_Disp_Table value of the interface.
+   --  return the element of Access_Disp_Table containing the tag of the
+   --  interface.
 
    function Find_Interface_Tag
      (T     : Entity_Id;
@@ -483,16 +484,16 @@ package Exp_Util is
    --  or is a private type whose completion is such a type.
 
    procedure Kill_Dead_Code (N : Node_Id; Warn : Boolean := False);
-   --  N represents a node for a section of code that is known to be dead. The
-   --  node is deleted, and any exception handler references and warning
-   --  messages relating to this code are removed. If Warn is True, a warning
-   --  will be output at the start of N indicating the deletion of the code.
+   --  N represents a node for a section of code that is known to be dead. Any
+   --  exception handler references and warning messages relating to this code
+   --  are removed. If Warn is True, a warning will be output at the start of N
+   --  indicating the deletion of the code. Note that the tree for the deleted
+   --  code is left intact so that e.g. cross-reference data is still valid.
 
    procedure Kill_Dead_Code (L : List_Id; Warn : Boolean := False);
    --  Like the above procedure, but applies to every element in the given
-   --  list. Each of the entries is removed from the list before killing it.
-   --  If Warn is True, a warning will be output at the start of N indicating
-   --  the deletion of the code.
+   --  list. If Warn is True, a warning will be output at the start of N
+   --  indicating the deletion of the code.
 
    function Known_Non_Negative (Opnd : Node_Id) return Boolean;
    --  Given a node for a subexpression, determines if it represents a value

gcc/ada/nlists.adb

@@ -279,22 +279,6 @@ package body Nlists is
       Append (Node, To);
    end Append_To;
 
-   -----------------
-   -- Delete_List --
-   -----------------
-
-   procedure Delete_List (L : List_Id) is
-      N : Node_Id;
-
-   begin
-      while Is_Non_Empty_List (L) loop
-         N := Remove_Head (L);
-         Delete_Tree (N);
-      end loop;
-
-      --  Should recycle list header???
-   end Delete_List;
-
    -----------
    -- First --
    -----------
@@ -315,7 +299,6 @@ package body Nlists is
 
    function First_Non_Pragma (List : List_Id) return Node_Id is
       N : constant Node_Id := First (List);
-
    begin
       if Nkind (N) /= N_Pragma
            and then
@@ -649,7 +632,6 @@ package body Nlists is
 
    function Last_Non_Pragma (List : List_Id) return Node_Id is
       N : constant Node_Id := Last (List);
-
    begin
       if Nkind (N) /= N_Pragma then
          return N;

gcc/ada/nlists.ads

@@ -333,9 +333,6 @@ package Nlists is
    --  These functions return the addresses of the Next_Node and Prev_Node
    --  tables (used in Back_End for Gigi).
 
-   procedure Delete_List (L : List_Id);
-   --  Removes all elements of the given list, and calls Delete_Tree on each
-
    function p (U : Union_Id) return Node_Id;
    --  This function is intended for use from the debugger, it determines
    --  whether U is a Node_Id or List_Id, and calls the appropriate Parent

gcc/ada/par-ch4.adb

@@ -463,8 +463,6 @@ package body Ch4 is
                   Style.Check_Attribute_Name (False);
                end if;
 
-               Delete_Node (Token_Node);
-
             --  Here for case of attribute designator is not an identifier
 
             else

gcc/ada/sem_ch7.adb

@@ -592,9 +592,9 @@ package body Sem_Ch7 is
                   --  the flag for outer level entities that are not
                   --  imported/exported, and which have no interface name.
 
-                  elsif K = N_Object_Declaration
-                    or else K = N_Exception_Declaration
-                    or else K = N_Subprogram_Declaration
+                  elsif Nkind_In (K, N_Object_Declaration,
+                                     N_Exception_Declaration,
+                                     N_Subprogram_Declaration)
                   then
                      E := Defining_Entity (D);
 
@@ -844,8 +844,8 @@ package body Sem_Ch7 is
          then
             Generate_Reference (Id, Scope (Id), 'k', False);
 
-         elsif Nkind (Unit (Cunit (Main_Unit))) /= N_Subprogram_Body
-           and then Nkind (Unit (Cunit (Main_Unit))) /= N_Subunit
+         elsif not Nkind_In (Unit (Cunit (Main_Unit)), N_Subprogram_Body,
+                                                       N_Subunit)
          then
             --  If current unit is an ancestor of main unit, generate
             --  a reference to its own parent.
@@ -909,16 +909,16 @@ package body Sem_Ch7 is
             --  with a known_discriminant_part whose full view is an
             --  Unchecked_Union.
 
-            if (Nkind (Decl) = N_Incomplete_Type_Declaration
-                  or else
-                Nkind (Decl) = N_Private_Type_Declaration)
+            if Nkind_In (Decl, N_Incomplete_Type_Declaration,
+                               N_Private_Type_Declaration)
               and then Has_Discriminants (Defining_Identifier (Decl))
               and then Present (Full_View (Defining_Identifier (Decl)))
-              and then Is_Unchecked_Union
-                (Full_View (Defining_Identifier (Decl)))
+              and then
+                Is_Unchecked_Union (Full_View (Defining_Identifier (Decl)))
             then
-               Error_Msg_N ("completion of discriminated partial view" &
-                 " cannot be an Unchecked_Union",
+               Error_Msg_N
+                 ("completion of discriminated partial view "
+                  & "cannot be an Unchecked_Union",
                  Full_View (Defining_Identifier (Decl)));
             end if;
 
@@ -942,8 +942,8 @@ package body Sem_Ch7 is
          while Present (Gen_Par) and then Is_Child_Unit (Gen_Par) loop
             Inst_Node := Get_Package_Instantiation_Node (Inst_Par);
 
-            if (Nkind (Inst_Node) = N_Package_Instantiation
-                  or else Nkind (Inst_Node) = N_Formal_Package_Declaration)
+            if Nkind_In (Inst_Node, N_Package_Instantiation,
+                                    N_Formal_Package_Declaration)
               and then Nkind (Name (Inst_Node)) = N_Expanded_Name
             then
                Inst_Par := Entity (Prefix (Name (Inst_Node)));

gcc/ada/sinfo.adb

@@ -2192,6 +2192,14 @@ package body Sinfo is
       return List2 (N);
    end Pragma_Argument_Associations;
 
+   function Pragma_Identifier
+      (N : Node_Id) return Node_Id is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Pragma);
+      return Node4 (N);
+   end Pragma_Identifier;
+
    function Pragmas_After
       (N : Node_Id) return List_Id is
    begin
@@ -4915,6 +4923,14 @@ package body Sinfo is
       Set_List2_With_Parent (N, Val);
    end Set_Pragma_Argument_Associations;
 
+   procedure Set_Pragma_Identifier
+      (N : Node_Id; Val : Node_Id) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Pragma);
+      Set_Node4_With_Parent (N, Val);
+   end Set_Pragma_Identifier;
+
    procedure Set_Pragmas_After
       (N : Node_Id; Val : List_Id) is
    begin
@@ -5558,4 +5574,120 @@ package body Sinfo is
         UI_From_Int (Int (S) - Int (Sloc (N))));
    end Set_End_Location;
 
+   --------------------------------
+   -- Node_Kind Membership Tests --
+   --------------------------------
+
+   function Nkind_In
+     (T  : Node_Kind;
+      V1 : Node_Kind;
+      V2 : Node_Kind) return Boolean
+   is
+   begin
+      return T = V1 or else
+             T = V2;
+   end Nkind_In;
+
+   function Nkind_In
+     (T  : Node_Kind;
+      V1 : Node_Kind;
+      V2 : Node_Kind;
+      V3 : Node_Kind) return Boolean
+   is
+   begin
+      return T = V1 or else
+             T = V2 or else
+             T = V3;
+   end Nkind_In;
+
+   function Nkind_In
+     (T  : Node_Kind;
+      V1 : Node_Kind;
+      V2 : Node_Kind;
+      V3 : Node_Kind;
+      V4 : Node_Kind) return Boolean
+   is
+   begin
+      return T = V1 or else
+             T = V2 or else
+             T = V3 or else
+             T = V4;
+   end Nkind_In;
+
+   function Nkind_In
+     (T  : Node_Kind;
+      V1 : Node_Kind;
+      V2 : Node_Kind;
+      V3 : Node_Kind;
+      V4 : Node_Kind;
+      V5 : Node_Kind) return Boolean
+   is
+   begin
+      return T = V1 or else
+             T = V2 or else
+             T = V3 or else
+             T = V4 or else
+             T = V5;
+   end Nkind_In;
+
+   function Nkind_In
+     (T  : Node_Kind;
+      V1 : Node_Kind;
+      V2 : Node_Kind;
+      V3 : Node_Kind;
+      V4 : Node_Kind;
+      V5 : Node_Kind;
+      V6 : Node_Kind) return Boolean
+   is
+   begin
+      return T = V1 or else
+             T = V2 or else
+             T = V3 or else
+             T = V4 or else
+             T = V5 or else
+             T = V6;
+   end Nkind_In;
+
+   function Nkind_In
+     (T  : Node_Kind;
+      V1 : Node_Kind;
+      V2 : Node_Kind;
+      V3 : Node_Kind;
+      V4 : Node_Kind;
+      V5 : Node_Kind;
+      V6 : Node_Kind;
+      V7 : Node_Kind) return Boolean
+   is
+   begin
+      return T = V1 or else
+             T = V2 or else
+             T = V3 or else
+             T = V4 or else
+             T = V5 or else
+             T = V6 or else
+             T = V7;
+   end Nkind_In;
+
+   function Nkind_In
+     (T  : Node_Kind;
+      V1 : Node_Kind;
+      V2 : Node_Kind;
+      V3 : Node_Kind;
+      V4 : Node_Kind;
+      V5 : Node_Kind;
+      V6 : Node_Kind;
+      V7 : Node_Kind;
+      V8 : Node_Kind) return Boolean
+   is
+   begin
+      return T = V1 or else
+             T = V2 or else
+             T = V3 or else
+             T = V4 or else
+             T = V5 or else
+             T = V6 or else
+             T = V7 or else
+             T = V8;
+   end Nkind_In;
+
 end Sinfo;

gcc/ada/sinfo.ads

@@ -549,9 +549,11 @@ package Sinfo is
 
    --  Acts_As_Spec (Flag4-Sem)
    --    A flag set in the N_Subprogram_Body node for a subprogram body which
-   --    is acting as its own spec. This flag also appears in the compilation
-   --    unit node at the library level for such a subprogram (see further
-   --    description in spec of Lib package).
+   --    is acting as its own spec, except in the case of a library level
+   --    subprogram, in which case the flag is set on the parent compilation
+   --    unit node instead (see further description in spec of Lib package).
+   --    ??? Above note about Lib is dubious since lib.ads does not mention
+   --    Acts_As_Spec at all.
 
    --  Actual_Designated_Subtype (Node4-Sem)
    --    Present in N_Free_Statement and N_Explicit_Dereference nodes. If gigi
@@ -907,27 +909,36 @@ package Sinfo is
    --    processing of the variant part of a record type.
 
    --  Entity (Node4-Sem)
-   --    Appears in all direct names (identifier, character literal, operator
-   --    symbol), as well as expanded names, and attributes that denote
-   --    entities, such as 'Class. Points to the entity for the corresponding
-   --    defining occurrence. Set after name resolution. In the case of
-   --    identifiers in a WITH list, the corresponding defining occurrence is
-   --    in a separately compiled file, and this pointer must be set using the
-   --    library Load procedure. Note that during name resolution, the value in
-   --    Entity may be temporarily incorrect (e.g. during overload resolution,
-   --    Entity is initially set to the first possible correct interpretation,
-   --    and then later modified if necessary to contain the correct value
-   --    after resolution). Note that this field overlaps Associated_Node,
-   --    which is used during generic processing (see Sem_Ch12 for details).
-   --    Note also that in generic templates, this means that the Entity field
-   --    does not always point to an Entity. Since the back end is expected to
-   --    ignore generic templates, this is harmless. Note that this field also
-   --    appears in N_Attribute_Definition_Clause nodes. It is used only for
-   --    stream attributes definition clauses. In this case, it denotes a
-   --    (possibly dummy) subprogram entity that is conceptually declared at
-   --    the point of the clause. Thus the visibility of the attribute
-   --    definition clause (in the sense of 8.3(23) as amended by AI-195) can
-   --    be checked by testing the visibility of that subprogram.
+   --    Appears in all direct names (identifiers, character literals, and
+   --    operator symbols), as well as expanded names, and attributes that
+   --    denote entities, such as 'Class. Points to entity for corresponding
+   --    defining occurrence. Set after name resolution. For identifiers in a
+   --    WITH list, the corresponding defining occurrence is in a separately
+   --    compiled file, and Entity must be set by the library Load procedure.
+   --
+   --    Note: During name resolution, the value in Entity may be temporarily
+   --    incorrect (e.g. during overload resolution, Entity is initially set to
+   --    the first possible correct interpretation, and then later modified if
+   --    necessary to contain the correct value after resolution).
+   --
+   --    Note: This field overlaps Associated_Node, which is used during
+   --    generic processing (see Sem_Ch12 for details). Note also that in
+   --    generic templates, this means that the Entity field does not always
+   --    point to an Entity. Since the back end is expected to ignore generic
+   --    templates, this is harmless.
+   --
+   --    Note: This field also appears in N_Attribute_Definition_Clause nodes.
+   --    It is used only for stream attributes definition clauses. In this
+   --    case, it denotes a (possibly dummy) subprogram entity that is declared
+   --    conceptually at the point of the clause. Thus the visibility of the
+   --    attribute definition clause (in the sense of 8.3(23) as amended by
+   --    AI-195) can be checked by testing the visibility of that subprogram.
+   --
+   --    Note: Normally the Entity field of an identifier points to the entity
+   --    for the corresponding defining identifier, and hence the Chars field
+   --    of an identifier will match the Chars field of the entity. However,
+   --    there is no requirement that these match, and there are obscure cases
+   --    of generated code where they do not match.
 
    --  Entity_Or_Associated_Node (Node4-Sem)
    --    A synonym for both Entity and Associated_Node. Used by convention in
@@ -1070,7 +1081,7 @@ package Sinfo is
    --    in the non-generic package case if it determines that no elaboration
    --    code is generated. Note that this flag is not related to the
    --    Is_Preelaborated status, there can be preelaborated packages that
-   --    generate elaboration code, and non- preelaborated packages which do
+   --    generate elaboration code, and non-preelaborated packages which do
    --    not generate elaboration code.
 
    --  Has_Priority_Pragma (Flag6-Sem)
@@ -1864,10 +1875,11 @@ package Sinfo is
       --  which are explicitly documented.
 
       --  N_Pragma
-      --  Sloc points to PRAGMA
+      --  Sloc points to pragma identifier
       --  Chars (Name1) identifier name from pragma identifier
       --  Pragma_Argument_Associations (List2) (set to No_List if none)
       --  Debug_Statement (Node3) (set to Empty if not Debug, Assert)
+      --  Pragma_Identifier (Node4)
       --  Next_Rep_Item (Node5-Sem)
 
       --  Note: we should have a section on what pragmas are passed on to
@@ -1875,6 +1887,13 @@ package Sinfo is
       --  Psect_Object is always converted to Common_Object, but there are
       --  undoubtedly many other similar notes required ???
 
+      --  Note: we don't really need the Chars field, since it can trivially
+      --  be obtained as Chars (Pragma_Identifier (Node)). However, it is
+      --  convenient to have this directly available, and historically the
+      --  Chars field has been around for ever, whereas the Pragma_Identifier
+      --  field was added much later (when we found the need to be able to get
+      --  the Sloc of the pragma identifier).
+
       --------------------------------------
       -- 2.8  Pragma Argument Association --
       --------------------------------------
@@ -3232,9 +3251,9 @@ package Sinfo is
       --    component_SELECTOR_NAME {| component_SELECTOR_NAME}
       --  | others
 
-      --  The entries of a component choice list appear in the Choices list
-      --  of the associated N_Component_Association, as either selector
-      --  names, or as an N_Others_Choice node.
+      --  The entries of a component choice list appear in the Choices list of
+      --  the associated N_Component_Association, as either selector names, or
+      --  as an N_Others_Choice node.
 
       --------------------------------
       -- 4.3.2  Extension Aggregate --
@@ -7385,7 +7404,7 @@ package Sinfo is
 
    subtype N_Unit_Body is Node_Kind range
      N_Package_Body ..
-     N_Subprogram_Body;
+       N_Subprogram_Body;
 
    ---------------------------
    -- Node Access Functions --
@@ -8071,6 +8090,9 @@ package Sinfo is
    function Pragma_Argument_Associations
      (N : Node_Id) return List_Id;    -- List2
 
+   function Pragma_Identifier
+     (N : Node_Id) return Node_Id;    -- Node4
+
    function Pragmas_After
      (N : Node_Id) return List_Id;    -- List5
 
@@ -8935,6 +8957,9 @@ package Sinfo is
    procedure Set_Pragma_Argument_Associations
      (N : Node_Id; Val : List_Id);            -- List2
 
+   procedure Set_Pragma_Identifier
+     (N : Node_Id; Val : Node_Id);            -- Node4
+
    procedure Set_Pragmas_After
      (N : Node_Id; Val : List_Id);            -- List5
 
@@ -9144,6 +9169,75 @@ package Sinfo is
    --  other words, End_Span is set to the difference between S and
    --  Sloc (N), the starting location.
 
+   --------------------------------
+   -- Node_Kind Membership Tests --
+   --------------------------------
+
+   --  The following functions allow a convenient notation for testing wheter
+   --  a Node_Kind value matches any one of a list of possible values. In each
+   --  case True is returned if the given T argument is equal to any of the V
+   --  arguments. Note that there is a similar set of functions defined in
+   --  Atree where the first argument is a Node_Id whose Nkind field is tested.
+
+   function Nkind_In
+     (T  : Node_Kind;
+      V1 : Node_Kind;
+      V2 : Node_Kind) return Boolean;
+
+   function Nkind_In
+     (T  : Node_Kind;
+      V1 : Node_Kind;
+      V2 : Node_Kind;
+      V3 : Node_Kind) return Boolean;
+
+   function Nkind_In
+     (T  : Node_Kind;
+      V1 : Node_Kind;
+      V2 : Node_Kind;
+      V3 : Node_Kind;
+      V4 : Node_Kind) return Boolean;
+
+   function Nkind_In
+     (T  : Node_Kind;
+      V1 : Node_Kind;
+      V2 : Node_Kind;
+      V3 : Node_Kind;
+      V4 : Node_Kind;
+      V5 : Node_Kind) return Boolean;
+
+   function Nkind_In
+     (T  : Node_Kind;
+      V1 : Node_Kind;
+      V2 : Node_Kind;
+      V3 : Node_Kind;
+      V4 : Node_Kind;
+      V5 : Node_Kind;
+      V6 : Node_Kind) return Boolean;
+
+   function Nkind_In
+     (T  : Node_Kind;
+      V1 : Node_Kind;
+      V2 : Node_Kind;
+      V3 : Node_Kind;
+      V4 : Node_Kind;
+      V5 : Node_Kind;
+      V6 : Node_Kind;
+      V7 : Node_Kind) return Boolean;
+
+   function Nkind_In
+     (T  : Node_Kind;
+      V1 : Node_Kind;
+      V2 : Node_Kind;
+      V3 : Node_Kind;
+      V4 : Node_Kind;
+      V5 : Node_Kind;
+      V6 : Node_Kind;
+      V7 : Node_Kind;
+      V8 : Node_Kind) return Boolean;
+
+   pragma Inline (Nkind_In);
+   --  Inline all above functions
+
    -----------------------------
    -- Syntactic Parent Tables --
    -----------------------------
@@ -9198,7 +9292,7 @@ package Sinfo is
        (1 => True,    --  Chars (Name1)
         2 => True,    --  Pragma_Argument_Associations (List2)
         3 => True,    --  Debug_Statement (Node3)
-        4 => False,   --  Entity (Node4-Sem)
+        4 => True,    --  Pragma_Identifier (Node4)
         5 => False),  --  Next_Rep_Item (Node5-Sem)
 
      N_Pragma_Argument_Association =>
@@ -10912,6 +11006,7 @@ package Sinfo is
    pragma Inline (Parent_Spec);
    pragma Inline (Position);
    pragma Inline (Pragma_Argument_Associations);
+   pragma Inline (Pragma_Identifier);
    pragma Inline (Pragmas_After);
    pragma Inline (Pragmas_Before);
    pragma Inline (Prefix);
@@ -11196,6 +11291,7 @@ package Sinfo is
    pragma Inline (Set_Parent_Spec);
    pragma Inline (Set_Position);
    pragma Inline (Set_Pragma_Argument_Associations);
+   pragma Inline (Set_Pragma_Identifier);
    pragma Inline (Set_Pragmas_After);
    pragma Inline (Set_Pragmas_Before);
    pragma Inline (Set_Prefix);