aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBob Duff <duff@adacore.com>2017-04-27 13:05:10 +0000
committerArnaud Charlet <charlet@gcc.gnu.org>2017-04-27 15:05:10 +0200
commit7494697b8c55022b046dbed542369289646fbe22 (patch)
tree9f69f475620cc998a16ebc1e844d5d66b8f6addb
parentf2acfbce60d8225bff9f469a68606ebd2fe54736 (diff)
downloadgcc-7494697b8c55022b046dbed542369289646fbe22.zip
gcc-7494697b8c55022b046dbed542369289646fbe22.tar.gz
gcc-7494697b8c55022b046dbed542369289646fbe22.tar.bz2
g-dyntab.ads, [...]: Remove incorrect assertion.
2017-04-27 Bob Duff <duff@adacore.com> * 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
-rw-r--r--gcc/ada/ChangeLog8
-rw-r--r--gcc/ada/g-dyntab.adb42
-rw-r--r--gcc/ada/g-dyntab.ads1
-rw-r--r--gcc/ada/g-table.ads8
-rw-r--r--gcc/ada/sinput.ads2
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 <duff@adacore.com>
+
+ * 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 <dross@adacore.com>
* 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;