From 7494697b8c55022b046dbed542369289646fbe22 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Thu, 27 Apr 2017 13:05:10 +0000 Subject: [PATCH] g-dyntab.ads, [...]: Remove incorrect assertion. 2017-04-27 Bob Duff * g-dyntab.ads, g-dyntab.adb, g-table.ads: Remove incorrect assertion. If the table grows and then shrinks back to empty, we won't necessarily point back to the empty array. Code cleanups. * sinput.ads: Add 'Base to Size clause to match the declared component subtypes. From-SVN: r247329 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/g-dyntab.adb | 42 +++++++++++++++++++++++------------------- gcc/ada/g-dyntab.ads | 1 + gcc/ada/g-table.ads | 8 ++++++++ gcc/ada/sinput.ads | 2 +- 5 files changed, 41 insertions(+), 20 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 83b6596..d01469f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2017-04-27 Bob Duff + + * g-dyntab.ads, g-dyntab.adb, g-table.ads: Remove incorrect assertion. + If the table grows and then shrinks back to empty, we won't necessarily + point back to the empty array. Code cleanups. + * sinput.ads: Add 'Base to Size clause to match the declared + component subtypes. + 2017-04-27 Claire Dross * a-cforma.adb, a-cforma.ads (=): Generic parameter removed to diff --git a/gcc/ada/g-dyntab.adb b/gcc/ada/g-dyntab.adb index eff48cb..7159059 100644 --- a/gcc/ada/g-dyntab.adb +++ b/gcc/ada/g-dyntab.adb @@ -46,7 +46,7 @@ package body GNAT.Dynamic_Tables is -- 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 -- larger size, as indicated by New_Last. At the time this is called, - -- T.P.Last is still the old value. + -- Last (T) is still the old value, and this does not modify it. -------------- -- Allocate -- @@ -57,7 +57,7 @@ package body GNAT.Dynamic_Tables is -- Note that Num can be negative pragma Assert (not T.Locked); - Set_Last (T, T.P.Last + Table_Index_Type'Base (Num)); + Set_Last (T, Last (T) + Table_Index_Type'Base (Num)); end Allocate; ------------ @@ -65,9 +65,17 @@ package body GNAT.Dynamic_Tables is ------------ procedure Append (T : in out Instance; New_Val : Table_Component_Type) is - begin pragma Assert (not T.Locked); - Set_Item (T, T.P.Last + 1, New_Val); + New_Last : constant Table_Last_Type := Last (T) + 1; + begin + if New_Last <= T.P.Last_Allocated then + -- fast path + T.P.Last := New_Last; + T.Table (New_Last) := New_Val; + + else + Set_Item (T, New_Last, New_Val); + end if; end Append; ---------------- @@ -185,7 +193,7 @@ package body GNAT.Dynamic_Tables is begin if T.Table /= Empty_Table_Ptr then - New_Table (First .. T.P.Last) := Old_Table (First .. T.P.Last); + New_Table (First .. Last (T)) := Old_Table (First .. Last (T)); Free (Old_Table); end if; @@ -238,10 +246,8 @@ package body GNAT.Dynamic_Tables is -------------- function Is_Empty (T : Instance) return Boolean is - Result : constant Boolean := T.P.Last = Table_Low_Bound - 1; begin - pragma Assert (Result = (T.Table = Empty_Table_Ptr)); - return Result; + return Last (T) = Table_Low_Bound - 1; end Is_Empty; ---------- @@ -292,7 +298,7 @@ package body GNAT.Dynamic_Tables is subtype Table_Length_Type is Table_Index_Type'Base range 0 .. Table_Index_Type'Base'Last; - Length : constant Table_Length_Type := T.P.Last - First + 1; + Length : constant Table_Length_Type := Last (T) - First + 1; Comp_Size_In_Bytes : constant Table_Length_Type := Table_Type'Component_Size / System.Storage_Unit; @@ -302,7 +308,7 @@ package body GNAT.Dynamic_Tables is begin if Release_Threshold = 0 or else Length < Length_Threshold then - return T.P.Last; + return Last (T); else declare Extra_Length : constant Table_Length_Type := Length / 1000; @@ -320,7 +326,7 @@ package body GNAT.Dynamic_Tables is begin if New_Last_Alloc < T.P.Last_Allocated then - pragma Assert (T.P.Last < T.P.Last_Allocated); + pragma Assert (Last (T) < T.P.Last_Allocated); pragma Assert (T.Table /= Empty_Table_Ptr); declare @@ -359,10 +365,9 @@ package body GNAT.Dynamic_Tables is Index : Valid_Table_Index_Type; Item : Table_Component_Type) is + begin pragma Assert (not T.Locked); - Item_Copy : constant Table_Component_Type := Item; - begin -- If Set_Last is going to reallocate the table, we make a copy of Item, -- in case the call was "Set_Item (T, X, T.Table (Y));", and Item is -- passed by reference. Without the copy, we would deallocate the array @@ -376,14 +381,13 @@ package body GNAT.Dynamic_Tables is T.Table (Index) := Item_Copy; end; - return; - end if; + else + if Index > Last (T) then + Set_Last (T, Index); + end if; - if Index > T.P.Last then - Set_Last (T, Index); + T.Table (Index) := Item; end if; - - T.Table (Index) := Item_Copy; end Set_Item; -------------- diff --git a/gcc/ada/g-dyntab.ads b/gcc/ada/g-dyntab.ads index a1e9507..cb4b741 100644 --- a/gcc/ada/g-dyntab.ads +++ b/gcc/ada/g-dyntab.ads @@ -183,6 +183,7 @@ package GNAT.Dynamic_Tables is end record; function Is_Empty (T : Instance) return Boolean; + pragma Inline (Is_Empty); procedure Init (T : in out Instance); -- Reinitializes the table to empty. There is no need to call this before diff --git a/gcc/ada/g-table.ads b/gcc/ada/g-table.ads index 3df5694..77e5baf 100644 --- a/gcc/ada/g-table.ads +++ b/gcc/ada/g-table.ads @@ -82,7 +82,9 @@ package GNAT.Table is function Is_Empty return Boolean; procedure Init; + pragma Inline (Init); procedure Free; + pragma Inline (Free); function First return Table_Index_Type; pragma Inline (First); @@ -91,6 +93,7 @@ package GNAT.Table is pragma Inline (Last); procedure Release; + pragma Inline (Release); procedure Set_Last (New_Val : Table_Last_Type); pragma Inline (Set_Last); @@ -105,6 +108,7 @@ package GNAT.Table is pragma Inline (Append); procedure Append_All (New_Vals : Table_Type); + pragma Inline (Append_All); procedure Set_Item (Index : Valid_Table_Index_Type; @@ -115,10 +119,12 @@ package GNAT.Table is -- Type used for Save/Restore subprograms function Save return Saved_Table; + pragma Inline (Save); -- Resets table to empty, but saves old contents of table in returned -- value, for possible later restoration by a call to Restore. procedure Restore (T : in out Saved_Table); + pragma Inline (Restore); -- Given a Saved_Table value returned by a prior call to Save, restores -- the table to the state it was in at the time of the Save call. @@ -137,9 +143,11 @@ package GNAT.Table is Item : Table_Component_Type; Quit : in out Boolean) is <>; procedure For_Each; + pragma Inline (For_Each); generic with function Lt (Comp1, Comp2 : Table_Component_Type) return Boolean; procedure Sort_Table; + pragma Inline (Sort_Table); end GNAT.Table; diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads index 7162d0f..6b5b412 100644 --- a/gcc/ada/sinput.ads +++ b/gcc/ada/sinput.ads @@ -936,7 +936,7 @@ private type Dope_Rec is record First, Last : Source_Ptr'Base; end record; - Dope_Rec_Size : constant := 2 * Source_Ptr'Size; + Dope_Rec_Size : constant := 2 * Source_Ptr'Base'Size; for Dope_Rec'Size use Dope_Rec_Size; for Dope_Rec'Alignment use Dope_Rec_Size / 8; type Dope_Ptr is access all Dope_Rec; -- 2.7.4