From a3ef4e650e37bb768468d18d7c0f0b45298c3452 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Thu, 27 Apr 2017 12:10:04 +0000 Subject: [PATCH] g-dyntab.ads, [...]: Default for Table_Low_Bound. 2017-04-27 Bob Duff * g-dyntab.ads, g-dyntab.adb: Default for Table_Low_Bound. Rename Empty --> Empty_Table_Ptr, and don't duplicate code for it. Free renames Init, since they do the same thing. * g-table.ads: Default for Table_Low_Bound. * table.ads: Default for Table_Low_Bound, Table_Initial, and Table_Increment. From-SVN: r247324 --- gcc/ada/ChangeLog | 9 +++++++ gcc/ada/g-dyntab.adb | 61 +++++++++++++++++--------------------------- gcc/ada/g-dyntab.ads | 12 ++++----- gcc/ada/g-table.ads | 6 ++--- gcc/ada/table.ads | 6 ++--- 5 files changed, 45 insertions(+), 49 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7c5953fd674..ce6a02c8c66 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2017-04-27 Bob Duff + + * g-dyntab.ads, g-dyntab.adb: Default for Table_Low_Bound. + Rename Empty --> Empty_Table_Ptr, and don't duplicate code for it. + Free renames Init, since they do the same thing. + * g-table.ads: Default for Table_Low_Bound. + * table.ads: Default for Table_Low_Bound, Table_Initial, and + Table_Increment. + 2017-04-27 Bob Duff * g-dyntab.ads, g-dyntab.adb: Add assertions to subprograms that diff --git a/gcc/ada/g-dyntab.adb b/gcc/ada/g-dyntab.adb index 60bf3455c28..1b539369939 100644 --- a/gcc/ada/g-dyntab.adb +++ b/gcc/ada/g-dyntab.adb @@ -38,9 +38,6 @@ with System; package body GNAT.Dynamic_Tables is - Empty : constant Table_Ptr := - Empty_Table_Array_Ptr_To_Table_Ptr (Empty_Table_Array'Access); - ----------------------- -- Local Subprograms -- ----------------------- @@ -116,32 +113,6 @@ package body GNAT.Dynamic_Tables is end loop; end For_Each; - ---------- - -- Free -- - ---------- - - procedure Free (T : in out Instance) is - pragma Assert (not T.Locked); - subtype Alloc_Type is Table_Type (First .. T.P.Last_Allocated); - type Alloc_Ptr is access all Alloc_Type; - - procedure Free is new Ada.Unchecked_Deallocation (Alloc_Type, Alloc_Ptr); - function To_Alloc_Ptr is - new Ada.Unchecked_Conversion (Table_Ptr, Alloc_Ptr); - - Temp : Alloc_Ptr := To_Alloc_Ptr (T.Table); - - begin - if T.Table = Empty then - pragma Assert (T.P = (Last_Allocated | Last => First - 1)); - null; - else - Free (Temp); - T.Table := Empty; - T.P := (Last_Allocated | Last => First - 1); - end if; - end Free; - ---------- -- Grow -- ---------- @@ -169,7 +140,7 @@ package body GNAT.Dynamic_Tables is New_Allocated_Length : Table_Length_Type; begin - if T.Table = Empty then + if T.Table = Empty_Table_Ptr then New_Allocated_Length := Table_Length_Type (Table_Initial); else New_Allocated_Length := @@ -213,7 +184,7 @@ package body GNAT.Dynamic_Tables is New_Table : constant Alloc_Ptr := new Alloc_Type; begin - if T.Table /= Empty then + if T.Table /= Empty_Table_Ptr then New_Table (First .. T.P.Last) := Old_Table (First .. T.P.Last); Free (Old_Table); end if; @@ -223,7 +194,7 @@ package body GNAT.Dynamic_Tables is pragma Assert (New_Last <= T.P.Last_Allocated); pragma Assert (T.Table /= null); - pragma Assert (T.Table /= Empty); + pragma Assert (T.Table /= Empty_Table_Ptr); end Grow; -------------------- @@ -241,9 +212,25 @@ package body GNAT.Dynamic_Tables is ---------- procedure Init (T : in out Instance) is - begin pragma Assert (not T.Locked); - Free (T); + subtype Alloc_Type is Table_Type (First .. T.P.Last_Allocated); + type Alloc_Ptr is access all Alloc_Type; + + procedure Free is new Ada.Unchecked_Deallocation (Alloc_Type, Alloc_Ptr); + function To_Alloc_Ptr is + new Ada.Unchecked_Conversion (Table_Ptr, Alloc_Ptr); + + Temp : Alloc_Ptr := To_Alloc_Ptr (T.Table); + + begin + if T.Table = Empty_Table_Ptr then + pragma Assert (T.P = (Last_Allocated | Last => First - 1)); + null; + else + Free (Temp); + T.Table := Empty_Table_Ptr; + T.P := (Last_Allocated | Last => First - 1); + end if; end Init; -------------- @@ -253,7 +240,7 @@ 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)); + pragma Assert (Result = (T.Table = Empty_Table_Ptr)); return Result; end Is_Empty; @@ -277,7 +264,7 @@ package body GNAT.Dynamic_Tables is pragma Assert (Is_Empty (To)); To := From; - From.Table := Empty; + From.Table := Empty_Table_Ptr; From.Locked := False; From.P.Last_Allocated := Table_Low_Bound - 1; From.P.Last := Table_Low_Bound - 1; @@ -326,7 +313,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 (T.Table /= Empty); + pragma Assert (T.Table /= Empty_Table_Ptr); declare subtype Old_Alloc_Type is Table_Type (First .. Old_Last_Allocated); diff --git a/gcc/ada/g-dyntab.ads b/gcc/ada/g-dyntab.ads index b3095b64fbf..a98345660e7 100644 --- a/gcc/ada/g-dyntab.ads +++ b/gcc/ada/g-dyntab.ads @@ -53,7 +53,7 @@ generic type Table_Component_Type is private; type Table_Index_Type is range <>; - Table_Low_Bound : Table_Index_Type; + Table_Low_Bound : Table_Index_Type := Table_Index_Type'First; Table_Initial : Positive := 8; Table_Increment : Natural := 100; Release_Threshold : Natural := 0; -- size in bytes @@ -153,12 +153,13 @@ package GNAT.Dynamic_Tables is Empty_Table_Array : aliased Empty_Table_Array_Type; function Empty_Table_Array_Ptr_To_Table_Ptr is new Ada.Unchecked_Conversion (Empty_Table_Array_Ptr, Table_Ptr); + Empty_Table_Ptr : constant Table_Ptr := + Empty_Table_Array_Ptr_To_Table_Ptr (Empty_Table_Array'Access); -- End private use only. The above are used to initialize Table to point to -- an empty array. type Instance is record - Table : Table_Ptr := - Empty_Table_Array_Ptr_To_Table_Ptr (Empty_Table_Array'Access); + Table : Table_Ptr := Empty_Table_Ptr; -- The table itself. The lower bound is the value of First. Logically -- the upper bound is the current value of Last (although the actual -- size of the allocated table may be larger than this). The program may @@ -187,6 +188,8 @@ package GNAT.Dynamic_Tables is -- Reinitializes the table to empty. There is no need to call this before -- using a table; tables default to empty. + procedure Free (T : in out Instance) renames Init; + function First return Table_Index_Type; pragma Inline (First); -- Export First as synonym for Table_Low_Bound (parallel with use of Last) @@ -208,9 +211,6 @@ package GNAT.Dynamic_Tables is -- chunk of memory. In both cases current array values are not affected by -- this call. - procedure Free (T : in out Instance); - -- Same as Init - procedure Set_Last (T : in out Instance; New_Val : Table_Last_Type); pragma Inline (Set_Last); -- This procedure sets Last to the indicated value. If necessary the table diff --git a/gcc/ada/g-table.ads b/gcc/ada/g-table.ads index c2c33244d95..3df5694fcf7 100644 --- a/gcc/ada/g-table.ads +++ b/gcc/ada/g-table.ads @@ -49,7 +49,7 @@ generic type Table_Component_Type is private; type Table_Index_Type is range <>; - Table_Low_Bound : Table_Index_Type; + Table_Low_Bound : Table_Index_Type := Table_Index_Type'First; Table_Initial : Positive := 8; Table_Increment : Natural := 100; Table_Name : String := ""; -- for debugging printouts @@ -70,6 +70,7 @@ package GNAT.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; + 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; @@ -81,6 +82,7 @@ package GNAT.Table is function Is_Empty return Boolean; procedure Init; + procedure Free; function First return Table_Index_Type; pragma Inline (First); @@ -90,8 +92,6 @@ package GNAT.Table is procedure Release; - procedure Free; - procedure Set_Last (New_Val : Table_Last_Type); pragma Inline (Set_Last); diff --git a/gcc/ada/table.ads b/gcc/ada/table.ads index 066dc4ff18d..7311f6f0e1f 100644 --- a/gcc/ada/table.ads +++ b/gcc/ada/table.ads @@ -51,9 +51,9 @@ package Table is type Table_Component_Type is private; type Table_Index_Type is range <>; - Table_Low_Bound : Table_Index_Type; - Table_Initial : Pos; - Table_Increment : Nat; + Table_Low_Bound : Table_Index_Type := Table_Index_Type'First; + Table_Initial : Pos := 8; + Table_Increment : Nat := 100; Table_Name : String; -- for debugging printouts Release_Threshold : Nat := 0; -- 2.30.2