FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

sinput.adb: Minor code cleanup.

Browse source 
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
This commit is contained in:
Bob Duff 2017-04-27 13:43:49 +00:00 • committed by Arnaud Charlet
parent f8a36447db
commit a216846295
12 changed files with 93 additions and 72 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
gcc/ada/ChangeLog
View file

@ -1,3 +1,29 @@
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

8
gcc/ada/alloc.ads
View file

@ -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;

16
gcc/ada/atree.adb
View file

@ -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;

41
gcc/ada/g-dyntab.adb
View file

@ -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;

2
gcc/ada/g-table.adb
View file

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

1
gcc/ada/g-table.ads
View file

@ -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;

31
gcc/ada/namet.adb
View file

@ -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;
--------------------

10
gcc/ada/nlists.adb
View file

@ -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");
-----------------------

24
gcc/ada/sem_util.adb
View file

@ -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 --
--------------------------

3
gcc/ada/sem_util.ads
View file

@ -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

2
gcc/ada/sinput.adb
View file

@ -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;

1
gcc/ada/table.ads
View file

@ -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;