Skip to content

R
riscv-gcc-1
Commit a3ef4e65 by Bob Duff Committed by Arnaud Charlet
Options

g-dyntab.ads, [...]: Default for Table_Low_Bound. 

2017-04-27  Bob Duff  <duff@adacore.com>

	* 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
parent de33eb38
Showing with 45 additions and 49 deletions
gcc/ada/ChangeLog
2017-04-27 Bob Duff <duff@adacore.com>
* 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 <duff@adacore.com>
* g-dyntab.ads, g-dyntab.adb: Add assertions to subprograms that
can reallocate.
* atree.adb, elists.adb, fname-uf.adb, ghost.adb, inline.adb,
......
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 --
-----------------------
......@@ -117,32 +114,6 @@ package body GNAT.Dynamic_Tables is
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);
......
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
......
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);
......
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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment