From a2168462958f03ca5b060ad49e217a3e262750d0 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Thu, 27 Apr 2017 13:43:49 +0000 Subject: sinput.adb: Minor code cleanup. 2017-04-27 Bob Duff * 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 | 26 ++++++++++++++++++++++++++ gcc/ada/alloc.ads | 8 ++------ gcc/ada/atree.adb | 16 ++++++++++------ gcc/ada/g-dyntab.adb | 41 +++++++++++++++++++++++++++-------------- gcc/ada/g-table.adb | 2 -- gcc/ada/g-table.ads | 1 - gcc/ada/namet.adb | 31 +++++++++++++++++++++---------- gcc/ada/nlists.adb | 10 +++++----- gcc/ada/sem_util.adb | 24 +----------------------- gcc/ada/sem_util.ads | 3 --- gcc/ada/sinput.adb | 2 +- gcc/ada/table.ads | 1 - 12 files changed, 93 insertions(+), 72 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1be7e3e..30dbbfc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,29 @@ +2017-04-27 Bob Duff + + * 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 * sem_eval.adb (Subtypes_Statically_Compatible): Remove duplicated diff --git a/gcc/ada/alloc.ads b/gcc/ada/alloc.ads index 7112fab..74885fd 100644 --- a/gcc/ada/alloc.ads +++ b/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; diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 0505b86..16feee0 100644 --- a/gcc/ada/atree.adb +++ b/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; diff --git a/gcc/ada/g-dyntab.adb b/gcc/ada/g-dyntab.adb index eed1365..f975e6c 100644 --- a/gcc/ada/g-dyntab.adb +++ b/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; diff --git a/gcc/ada/g-table.adb b/gcc/ada/g-table.adb index 1c122d7..ac33bc3 100644 --- a/gcc/ada/g-table.adb +++ b/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 -------------- diff --git a/gcc/ada/g-table.ads b/gcc/ada/g-table.ads index 77e5baf..ab53813 100644 --- a/gcc/ada/g-table.ads +++ b/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; diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb index b87dd91..4e6a69a 100644 --- a/gcc/ada/namet.adb +++ b/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; -------------------- diff --git a/gcc/ada/nlists.adb b/gcc/ada/nlists.adb index 7050c3e..0f111d8 100644 --- a/gcc/ada/nlists.adb +++ b/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"); ----------------------- diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index b01ee08..1a3b042 100644 --- a/gcc/ada/sem_util.adb +++ b/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 -- -------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index b1dc68a..3cc3df4 100644 --- a/gcc/ada/sem_util.ads +++ b/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 diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb index a5f345d..bab55c1 100644 --- a/gcc/ada/sinput.adb +++ b/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; diff --git a/gcc/ada/table.ads b/gcc/ada/table.ads index 7311f6f..8782f11 100644 --- a/gcc/ada/table.ads +++ b/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; -- cgit v1.1