sinput.adb: Minor code cleanup.

2017-04-27  Bob Duff  <duff@adacore.com>

	* sinput.adb: Minor code cleanup.
	* namet.adb (Append): Create faster versions of
	Append(String) and Append(Name_Id) by using slice assignment
	instead of loops.
	* sem_util.adb (In_Instance): Speed this up by removing
	unnecessary tests; Is_Generic_Instance is defined for all
	entities.
	* sem_util.ads, sem_util.adb (In_Parameter_Specification):
	Remove unused function.
	* alloc.ads (Nodes_Initial): Use a much larger value, because
	the compiler was spending a lot of time copying the nodes table
	when it grows. This number was chosen in 1996, so is rather out
	of date with current memory sizes. Anyway, it's virtual memory.
	Get rid of Orig_Nodes_...; use Node_... instead.
	* atree.adb (Lock): Do not release the Nodes tables; it's a
	waste of time.
	Orig_Nodes_ ==> Nodes_
	* nlists.adb: Orig_Nodes_ ==> Nodes_
	* g-table.adb: Remove unused "with" clause.
	* g-table.ads, table.ads: Remove Big_Table_Type, which should
	not be used by clients.
	* g-dyntab.adb (Last_Allocated): New function
	to encapsulate T.P.Last_Allocated, which I'm thinking of changing.

From-SVN: r247335

gcc/ada/ChangeLog

+2017-04-27  Bob Duff  <duff@adacore.com>
+
+	* sinput.adb: Minor code cleanup.
+	* namet.adb (Append): Create faster versions of
+	Append(String) and Append(Name_Id) by using slice assignment
+	instead of loops.
+	* sem_util.adb (In_Instance): Speed this up by removing
+	unnecessary tests; Is_Generic_Instance is defined for all
+	entities.
+	* sem_util.ads, sem_util.adb (In_Parameter_Specification):
+	Remove unused function.
+	* alloc.ads (Nodes_Initial): Use a much larger value, because
+	the compiler was spending a lot of time copying the nodes table
+	when it grows. This number was chosen in 1996, so is rather out
+	of date with current memory sizes. Anyway, it's virtual memory.
+	Get rid of Orig_Nodes_...; use Node_... instead.
+	* atree.adb (Lock): Do not release the Nodes tables; it's a
+	waste of time.
+	Orig_Nodes_ ==> Nodes_
+	* nlists.adb: Orig_Nodes_ ==> Nodes_
+	* g-table.adb: Remove unused "with" clause.
+	* g-table.ads, table.ads: Remove Big_Table_Type, which should
+	not be used by clients.
+	* g-dyntab.adb (Last_Allocated): New function
+	to encapsulate T.P.Last_Allocated, which I'm thinking of changing.
+
 2017-04-27  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* sem_eval.adb (Subtypes_Statically_Compatible): Remove duplicated

gcc/ada/alloc.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -100,7 +100,7 @@ package Alloc is
    Names_Initial                    : constant := 6_000;   -- Namet
    Names_Increment                  : constant := 100;
 
-   Nodes_Initial                    : constant := 50_000;  -- Atree
+   Nodes_Initial                    : constant := 5_000_000;  -- Atree
    Nodes_Increment                  : constant := 100;
    Nodes_Release_Threshold          : constant := 100_000;
 
@@ -110,10 +110,6 @@ package Alloc is
    Obsolescent_Warnings_Initial     : constant := 50;      -- Sem_Prag
    Obsolescent_Warnings_Increment   : constant := 200;
 
-   Orig_Nodes_Initial               : constant := 50_000;  -- Atree
-   Orig_Nodes_Increment             : constant := 100;
-   Orig_Nodes_Release_Threshold     : constant := 100_000;
-
    Pending_Instantiations_Initial   : constant := 10;      -- Inline
    Pending_Instantiations_Increment : constant := 100;
 

gcc/ada/atree.adb

@@ -519,9 +519,9 @@ package body Atree is
       Table_Component_Type => Node_Id,
       Table_Index_Type     => Node_Id'Base,
       Table_Low_Bound      => First_Node_Id,
-      Table_Initial        => Alloc.Orig_Nodes_Initial,
-      Table_Increment      => Alloc.Orig_Nodes_Increment,
-      Release_Threshold    => Alloc.Orig_Nodes_Release_Threshold,
+      Table_Initial        => Alloc.Nodes_Initial,
+      Table_Increment      => Alloc.Nodes_Increment,
+      Release_Threshold    => Alloc.Nodes_Release_Threshold,
       Table_Name           => "Orig_Nodes");
 
    --------------------------
@@ -1579,11 +1579,15 @@ package body Atree is
 
    procedure Lock is
    begin
-      Nodes.Release;
+      --  We used to Release the tables, as in the comments below, but that is
+      --  a waste of time. We're only wasting virtual memory here, and the
+      --  release calls copy large amounts of data.
+
+      --  Nodes.Release;
       Nodes.Locked := True;
-      Flags.Release;
+      --  Flags.Release;
       Flags.Locked := True;
-      Orig_Nodes.Release;
+      --  Orig_Nodes.Release;
       Orig_Nodes.Locked := True;
    end Lock;
 

gcc/ada/g-dyntab.adb

@@ -42,6 +42,10 @@ package body GNAT.Dynamic_Tables is
    -- Local Subprograms --
    -----------------------
 
+   function Last_Allocated (T : Instance) return Table_Last_Type;
+   pragma Inline (Last_Allocated);
+   --  Return the index of the last allocated element
+
    procedure Grow (T : in out Instance; New_Last : Table_Last_Type);
    --  This is called when we are about to set the value of Last to a value
    --  that is larger than Last_Allocated. This reallocates the table to the
@@ -68,7 +72,7 @@ package body GNAT.Dynamic_Tables is
       pragma Assert (not T.Locked);
       New_Last : constant Table_Last_Type := Last (T) + 1;
    begin
-      if New_Last <= T.P.Last_Allocated then
+      if New_Last <= Last_Allocated (T) then
          --  fast path
          T.P.Last := New_Last;
          T.Table (New_Last) := New_Val;
@@ -115,7 +119,7 @@ package body GNAT.Dynamic_Tables is
    procedure For_Each (Table : Instance) is
       Quit : Boolean := False;
    begin
-      for Index in Table_Low_Bound .. Table.P.Last loop
+      for Index in First .. Last (Table) loop
          Action (Index, Table.Table (Index), Quit);
          exit when Quit;
       end loop;
@@ -135,12 +139,12 @@ package body GNAT.Dynamic_Tables is
       --  storage. Fortunately, GNAT doesn't do that.
 
       pragma Assert (not T.Locked);
-      pragma Assert (New_Last > T.P.Last_Allocated);
+      pragma Assert (New_Last > Last_Allocated (T));
 
       subtype Table_Length_Type is Table_Index_Type'Base
         range 0 .. Table_Index_Type'Base'Last;
 
-      Old_Last_Allocated   : constant Table_Last_Type  := T.P.Last_Allocated;
+      Old_Last_Allocated   : constant Table_Last_Type  := Last_Allocated (T);
       Old_Allocated_Length : constant Table_Length_Type :=
                                Old_Last_Allocated - First + 1;
 
@@ -200,7 +204,7 @@ package body GNAT.Dynamic_Tables is
          T.Table := To_Table_Ptr (New_Table);
       end;
 
-      pragma Assert (New_Last <= T.P.Last_Allocated);
+      pragma Assert (New_Last <= Last_Allocated (T));
       pragma Assert (T.Table /= null);
       pragma Assert (T.Table /= Empty_Table_Ptr);
    end Grow;
@@ -221,7 +225,7 @@ package body GNAT.Dynamic_Tables is
 
    procedure Init (T : in out Instance) is
       pragma Assert (not T.Locked);
-      subtype Alloc_Type is Table_Type (First .. T.P.Last_Allocated);
+      subtype Alloc_Type is Table_Type (First .. Last_Allocated (T));
       type Alloc_Ptr is access all Alloc_Type;
 
       procedure Free is new Ada.Unchecked_Deallocation (Alloc_Type, Alloc_Ptr);
@@ -247,7 +251,7 @@ package body GNAT.Dynamic_Tables is
 
    function Is_Empty (T : Instance) return Boolean is
    begin
-      return Last (T) = Table_Low_Bound - 1;
+      return Last (T) = First - 1;
    end Is_Empty;
 
    ----------
@@ -259,6 +263,15 @@ package body GNAT.Dynamic_Tables is
       return T.P.Last;
    end Last;
 
+   --------------------
+   -- Last_Allocated --
+   --------------------
+
+   function Last_Allocated (T : Instance) return Table_Last_Type is
+   begin
+      return T.P.Last_Allocated;
+   end Last_Allocated;
+
    ----------
    -- Move --
    ----------
@@ -272,8 +285,8 @@ package body GNAT.Dynamic_Tables is
 
       From.Table            := Empty_Table_Ptr;
       From.Locked           := False;
-      From.P.Last_Allocated := Table_Low_Bound - 1;
-      From.P.Last           := Table_Low_Bound - 1;
+      From.P.Last_Allocated := First - 1;
+      From.P.Last           := First - 1;
       pragma Assert (Is_Empty (From));
    end Move;
 
@@ -283,7 +296,7 @@ package body GNAT.Dynamic_Tables is
 
    procedure Release (T : in out Instance) is
       pragma Assert (not T.Locked);
-      Old_Last_Allocated : constant Table_Last_Type := T.P.Last_Allocated;
+      Old_Last_Allocated : constant Table_Last_Type := Last_Allocated (T);
 
       function New_Last_Allocated return Table_Last_Type;
       --  Compute the new value of Last_Allocated. This is normally equal to
@@ -325,8 +338,8 @@ package body GNAT.Dynamic_Tables is
    --  Start of processing for Release
 
    begin
-      if New_Last_Alloc < T.P.Last_Allocated then
-         pragma Assert (Last (T) < T.P.Last_Allocated);
+      if New_Last_Alloc < Last_Allocated (T) then
+         pragma Assert (Last (T) < Last_Allocated (T));
          pragma Assert (T.Table /= Empty_Table_Ptr);
 
          declare
@@ -373,7 +386,7 @@ package body GNAT.Dynamic_Tables is
       --  passed by reference. Without the copy, we would deallocate the array
       --  containing Item, leaving a dangling pointer.
 
-      if Index > T.P.Last_Allocated then
+      if Index > Last_Allocated (T) then
          declare
             Item_Copy : constant Table_Component_Type := Item;
          begin
@@ -397,7 +410,7 @@ package body GNAT.Dynamic_Tables is
    procedure Set_Last (T : in out Instance; New_Val : Table_Last_Type) is
    begin
       pragma Assert (not T.Locked);
-      if New_Val > T.P.Last_Allocated then
+      if New_Val > Last_Allocated (T) then
          Grow (T, New_Val);
       end if;
 

gcc/ada/g-table.adb

@@ -32,8 +32,6 @@
 with System;        use System;
 with System.Memory; use System.Memory;
 
-with Ada.Unchecked_Conversion;
-
 package body GNAT.Table is
 
    --------------

gcc/ada/g-table.ads

@@ -71,7 +71,6 @@ package GNAT.Table is
    subtype Table_Last_Type is Tab.Table_Last_Type;
    subtype Table_Type is Tab.Table_Type;
    function "=" (X, Y : Table_Type) return Boolean renames Tab."=";
-   subtype Big_Table_Type is Tab.Big_Table_Type;
 
    subtype Table_Ptr is Tab.Table_Ptr;
 

gcc/ada/namet.adb

@@ -116,14 +116,15 @@ package body Namet is
 
    procedure Append (Buf : in out Bounded_String; C : Character) is
    begin
-      if Buf.Length >= Buf.Chars'Last then
+      Buf.Length := Buf.Length + 1;
+
+      if Buf.Length > Buf.Chars'Last then
          Write_Str ("Name buffer overflow; Max_Length = ");
          Write_Int (Int (Buf.Max_Length));
          Write_Line ("");
          raise Program_Error;
       end if;
 
-      Buf.Length := Buf.Length + 1;
       Buf.Chars (Buf.Length) := C;
    end Append;
 
@@ -137,10 +138,20 @@ package body Namet is
    end Append;
 
    procedure Append (Buf : in out Bounded_String; S : String) is
+      First : constant Natural := Buf.Length + 1;
    begin
-      for J in S'Range loop
-         Append (Buf, S (J));
-      end loop;
+      Buf.Length := Buf.Length + S'Length;
+
+      if Buf.Length > Buf.Chars'Last then
+         Write_Str ("Name buffer overflow; Max_Length = ");
+         Write_Int (Int (Buf.Max_Length));
+         Write_Line ("");
+         raise Program_Error;
+      end if;
+
+      Buf.Chars (First .. Buf.Length) := S;
+      --  A loop calling Append(Character) would be cleaner, but this slice
+      --  assignment is substantially faster.
    end Append;
 
    procedure Append (Buf : in out Bounded_String; Buf2 : Bounded_String) is
@@ -150,12 +161,12 @@ package body Namet is
 
    procedure Append (Buf : in out Bounded_String; Id : Name_Id) is
       pragma Assert (Id in Name_Entries.First .. Name_Entries.Last);
-      S : constant Int := Name_Entries.Table (Id).Name_Chars_Index;
-
+      Index : constant Int := Name_Entries.Table (Id).Name_Chars_Index;
+      Len : constant Short := Name_Entries.Table (Id).Name_Len;
+      Chars : Name_Chars.Table_Type renames
+        Name_Chars.Table (Index + 1 .. Index + Int (Len));
    begin
-      for J in 1 .. Natural (Name_Entries.Table (Id).Name_Len) loop
-         Append (Buf, Name_Chars.Table (S + Int (J)));
-      end loop;
+      Append (Buf, String (Chars));
    end Append;
 
    --------------------

gcc/ada/nlists.adb

@@ -92,17 +92,17 @@ package body Nlists is
       Table_Component_Type => Node_Or_Entity_Id,
       Table_Index_Type     => Node_Or_Entity_Id'Base,
       Table_Low_Bound      => First_Node_Id,
-      Table_Initial        => Alloc.Orig_Nodes_Initial,
-      Table_Increment      => Alloc.Orig_Nodes_Increment,
-      Release_Threshold    => Alloc.Orig_Nodes_Release_Threshold,
+      Table_Initial        => Alloc.Nodes_Initial,
+      Table_Increment      => Alloc.Nodes_Increment,
+      Release_Threshold    => Alloc.Nodes_Release_Threshold,
       Table_Name           => "Next_Node");
 
    package Prev_Node is new Table.Table (
       Table_Component_Type => Node_Or_Entity_Id,
       Table_Index_Type     => Node_Or_Entity_Id'Base,
       Table_Low_Bound      => First_Node_Id,
-      Table_Initial        => Alloc.Orig_Nodes_Initial,
-      Table_Increment      => Alloc.Orig_Nodes_Increment,
+      Table_Initial        => Alloc.Nodes_Initial,
+      Table_Increment      => Alloc.Nodes_Increment,
       Table_Name           => "Prev_Node");
 
    -----------------------

gcc/ada/sem_util.adb

@@ -11250,9 +11250,7 @@ package body Sem_Util is
    begin
       S := Current_Scope;
       while Present (S) and then S /= Standard_Standard loop
-         if Ekind_In (S, E_Function, E_Package, E_Procedure)
-           and then Is_Generic_Instance (S)
-         then
+         if Is_Generic_Instance (S) then
             --  A child instance is always compiled in the context of a parent
             --  instance. Nevertheless, the actuals are not analyzed in an
             --  instance context. We detect this case by examining the current
@@ -11376,26 +11374,6 @@ package body Sem_Util is
       return False;
    end In_Package_Body;
 
-   --------------------------------
-   -- In_Parameter_Specification --
-   --------------------------------
-
-   function In_Parameter_Specification (N : Node_Id) return Boolean is
-      PN : Node_Id;
-
-   begin
-      PN := Parent (N);
-      while Present (PN) loop
-         if Nkind (PN) = N_Parameter_Specification then
-            return True;
-         end if;
-
-         PN := Parent (PN);
-      end loop;
-
-      return False;
-   end In_Parameter_Specification;
-
    --------------------------
    -- In_Pragma_Expression --
    --------------------------

gcc/ada/sem_util.ads

@@ -1326,9 +1326,6 @@ package Sem_Util is
    function In_Package_Body return Boolean;
    --  Returns True if current scope is within a package body
 
-   function In_Parameter_Specification (N : Node_Id) return Boolean;
-   --  Returns True if node N belongs to a parameter specification
-
    function In_Pragma_Expression (N : Node_Id; Nam : Name_Id) return Boolean;
    --  Returns true if the expression N occurs within a pragma with name Nam
 

gcc/ada/sinput.adb

@@ -882,7 +882,7 @@ package body Sinput is
    is
       --  A fat pointer is a pair consisting of data pointer and dope pointer,
       --  in that order. So we want to overwrite the second word.
-      Dope : Address;
+      Dope : System.Address;
       pragma Import (Ada, Dope);
       use System.Storage_Elements;
       for Dope'Address use Src + System.Address'Size / 8;

gcc/ada/table.ads

@@ -71,7 +71,6 @@ package Table is
       subtype Valid_Table_Index_Type is Tab.Valid_Table_Index_Type;
       subtype Table_Last_Type is Tab.Table_Last_Type;
       subtype Table_Type is Tab.Table_Type;
-      subtype Big_Table_Type is Tab.Big_Table_Type;
 
       subtype Table_Ptr is Tab.Table_Ptr;