diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/dyn_tables.adb | 129 | ||||
| -rw-r--r-- | src/dyn_tables.ads | 105 | ||||
| -rw-r--r-- | src/tables.adb | 97 | ||||
| -rw-r--r-- | src/tables.ads | 24 |
4 files changed, 256 insertions, 99 deletions
diff --git a/src/dyn_tables.adb b/src/dyn_tables.adb new file mode 100644 index 000000000..be733acc8 --- /dev/null +++ b/src/dyn_tables.adb @@ -0,0 +1,129 @@ +-- Efficient expandable one dimensional array. +-- Copyright (C) 2015 - 2016 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Interfaces.C; use Interfaces.C; +with System; + +package body Dyn_Tables is + -- Size of an element in storage units (bytes). + El_Size : constant size_t := + size_t (Table_Type'Component_Size / System.Storage_Unit); + + -- Expand the table by doubling its size. The table must have been + -- initialized. + procedure Expand (T : in out Instance; Num : Natural) + is + -- For efficiency, directly call realloc. + function Crealloc (Ptr : Table_Thin_Ptr; Size : size_t) + return Table_Thin_Ptr; + pragma Import (C, Crealloc, "realloc"); + begin + pragma Assert (T.Priv.Length /= 0); + pragma Assert (T.Table /= null); + + -- Expand the bound. + T.Priv.Last_Pos := T.Priv.Last_Pos + Num; + + -- Check if need to reallocate. + if T.Priv.Last_Pos < T.Priv.Length then + return; + else + -- Double the length. + loop + T.Priv.Length := T.Priv.Length * 2; + exit when T.Priv.Length > T.Priv.Last_Pos; + end loop; + end if; + + -- Realloc and check result. + T.Table := Crealloc (T.Table, size_t (T.Priv.Length) * El_Size); + if T.Table = null then + raise Storage_Error; + end if; + end Expand; + + procedure Allocate (T : in out Instance; Num : Natural := 1) is + begin + Expand (T, Num); + end Allocate; + + procedure Increment_Last (T : in out Instance) is + begin + -- Increase by 1. + Expand (T, 1); + end Increment_Last; + + procedure Decrement_Last (T : in out Instance) is + begin + T.Priv.Last_Pos := T.Priv.Last_Pos - 1; + end Decrement_Last; + + procedure Set_Last (T : in out Instance; Index : Table_Index_Type) + is + New_Last : constant Natural := + (Table_Index_Type'Pos (Index) + - Table_Index_Type'Pos (Table_Low_Bound) + 1); + begin + if New_Last < T.Priv.Last_Pos then + -- Decrease length. + T.Priv.Last_Pos := New_Last; + else + -- Increase length. + Expand (T, New_Last - T.Priv.Last_Pos); + end if; + end Set_Last; + + procedure Init (T : in out Instance) + is + -- Direct interface to malloc. + function Cmalloc (Size : size_t) return Table_Thin_Ptr; + pragma Import (C, Cmalloc, "malloc"); + begin + if T.Table = null then + -- Allocate memory if not already allocated. + T.Priv.Length := Table_Initial; + T.Table := Cmalloc (size_t (T.Priv.Length) * El_Size); + end if; + + -- Table is initially empty. + T.Priv.Last_Pos := 0; + end Init; + + function Last (T : Instance) return Table_Index_Type is + begin + return Table_Index_Type'Val + (Table_Index_Type'Pos (Table_Low_Bound) + T.Priv.Last_Pos - 1); + end Last; + + procedure Free (T : in out Instance) is + -- Direct interface to free. + procedure Cfree (Ptr : Table_Thin_Ptr); + pragma Import (C, Cfree, "free"); + begin + Cfree (T.Table); + T := (Table => null, + Priv => (Length => 0, + Last_Pos => 0)); + end Free; + + procedure Append (T : in out Instance; Val : Table_Component_Type) is + begin + Increment_Last (T); + T.Table (Last (T)) := Val; + end Append; +end Dyn_Tables; diff --git a/src/dyn_tables.ads b/src/dyn_tables.ads new file mode 100644 index 000000000..600e2bf85 --- /dev/null +++ b/src/dyn_tables.ads @@ -0,0 +1,105 @@ +-- Efficient expandable one dimensional array type. +-- Copyright (C) 2015 - 2016 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY +-- WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +-- This package mimics GNAT.Table, but: +-- - the index type can be any discrete type (in particular a modular type) +-- - the increment is not used +-- - the interface is simplified. +generic + -- This package creates: + -- array (Table_Index_Type range Table_Low_Bound .. <>) + -- of Table_Component_Type; + type Table_Component_Type is private; + type Table_Index_Type is (<>); + + -- The lowest bound of the array. Note that Table_Low_Bound shouldn't be + -- Table_Index_Type'First, as otherwise Last may raise constraint error + -- when the table is empty. + Table_Low_Bound : Table_Index_Type; + + -- Initial number of elements. + Table_Initial : Positive; + +package Dyn_Tables is + -- Ada type for the array. + type Table_Type is + array (Table_Index_Type range <>) of Table_Component_Type; + -- Fat subtype (so that the access is thin). + subtype Big_Table_Type is + Table_Type (Table_Low_Bound .. Table_Index_Type'Last); + + -- Access type for the vector. This is a thin pointer so that it is + -- compatible with C pointer, as this package uses malloc/realloc/free for + -- memory management. + type Table_Thin_Ptr is access all Big_Table_Type; + pragma Convention (C, Table_Thin_Ptr); + for Table_Thin_Ptr'Storage_Size use 0; + + -- Non user visible data. + type Instance_Private is private; + + -- Type for the dynamic table. + type Instance is record + -- Pointer to the table. Note that the use of a thin pointer to the + -- largest array, this implementation bypasses Ada index checks. + Table : Table_Thin_Ptr := null; + + -- Private data. + Priv : Instance_Private; + end record; + + -- Initialize the table. This is done automatically at elaboration. + procedure Init (T : in out Instance); + + -- Logical bounds of the array. + First : constant Table_Index_Type := Table_Low_Bound; + function Last (T : Instance) return Table_Index_Type; + pragma Inline (Last); + + -- Deallocate all the memory. Makes the array unusable until the next + -- call to Init. + procedure Free (T : in out Instance); + + -- Increase by 1 the length of the array. This may allocate memory. + procedure Increment_Last (T : in out Instance); + pragma Inline (Increment_Last); + + -- Decrease by 1 the length of the array. + procedure Decrement_Last (T : in out Instance); + pragma Inline (Decrement_Last); + + -- Increase or decrease the length of the array by specifying the upper + -- bound. + procedure Set_Last (T : in out Instance; Index : Table_Index_Type); + + -- Append VAL to the array. This always increase the length of the array. + procedure Append (T : in out Instance; Val : Table_Component_Type); + pragma Inline (Append); + + -- Increase by NUM the length of the array. + procedure Allocate (T : in out Instance; Num : Natural := 1); + +private + type Instance_Private is record + -- Number of allocated elements in the table. + Length : Natural := 0; + + -- Number of used elements in the table. + Last_Pos : Natural := 0; + end record; +end Dyn_Tables; diff --git a/src/tables.adb b/src/tables.adb index ca8674269..ef4cc385a 100644 --- a/src/tables.adb +++ b/src/tables.adb @@ -16,59 +16,13 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -with Interfaces.C; use Interfaces.C; -with System; - package body Tables is - -- Number of allocated elements in the table. - Length : Natural := 0; - - -- Number of used elements in the table. - Last_Pos : Natural := 0; - - -- Size of an element in storage units (bytes). - El_Size : constant size_t := - size_t (Table_Type'Component_Size / System.Storage_Unit); - - -- Expand the table by doubling its size. The table must have been - -- initialized. - procedure Expand (Num : Natural) - is - -- For efficiency, directly call realloc. - function Crealloc (Ptr : Table_Thin_Ptr; Size : size_t) - return Table_Thin_Ptr; - pragma Import (C, Crealloc, "realloc"); - begin - pragma Assert (Length /= 0); - pragma Assert (Table /= null); - - -- Expand the bound. - Last_Pos := Last_Pos + Num; - - -- Check if need to reallocate. - if Last_Pos < Length then - return; - else - -- Double the length. - loop - Length := Length * 2; - exit when Length > Last_Pos; - end loop; - end if; - - -- Realloc and check result. - Table := Crealloc (Table, size_t (Length) * El_Size); - if Table = null then - raise Storage_Error; - end if; - end Expand; - function Allocate (Num : Natural := 1) return Table_Index_Type is Res : constant Table_Index_Type := Table_Index_Type'Val - (Table_Index_Type'Pos (Table_Low_Bound) + Last_Pos); + (Table_Index_Type'Pos (Last) + 1); begin - Expand (Num); + Dyn_Table.Allocate (T, Num); return Res; end Allocate; @@ -76,66 +30,37 @@ package body Tables is procedure Increment_Last is begin -- Increase by 1. - Expand (1); + Dyn_Table.Increment_Last (T); end Increment_Last; procedure Decrement_Last is begin - Last_Pos := Last_Pos - 1; + Dyn_Table.Decrement_Last (T); end Decrement_Last; - procedure Set_Last (Index : Table_Index_Type) - is - New_Last : constant Natural := - (Table_Index_Type'Pos (Index) - - Table_Index_Type'Pos (Table_Low_Bound) + 1); + procedure Set_Last (Index : Table_Index_Type) is begin - if New_Last < Last_Pos then - -- Decrease length. - Last_Pos := New_Last; - else - -- Increase length. - Expand (New_Last - Last_Pos); - end if; + Dyn_Table.Set_Last (T, Index); end Set_Last; - procedure Init - is - -- Direct interface to malloc. - function Cmalloc (Size : size_t) return Table_Thin_Ptr; - pragma Import (C, Cmalloc, "malloc"); + procedure Init is begin - if Table = null then - -- Allocate memory if not already allocated. - Length := Table_Initial; - Table := Cmalloc (size_t (Length) * El_Size); - end if; - - -- Table is initially empty. - Last_Pos := 0; + Dyn_Table.Init (T); end Init; function Last return Table_Index_Type is begin - return Table_Index_Type'Val - (Table_Index_Type'Pos (Table_Low_Bound) + Last_Pos - 1); + return Dyn_Table.Last (T); end Last; procedure Free is - -- Direct interface to free. - procedure Cfree (Ptr : Table_Thin_Ptr); - pragma Import (C, Cfree, "free"); begin - Cfree (Table); - Table := null; - Length := 0; - Last_Pos := 0; + Dyn_Table.Free (T); end Free; procedure Append (Val : Table_Component_Type) is begin - Increment_Last; - Table (Last) := Val; + Dyn_Table.Append (T, Val); end Append; begin diff --git a/src/tables.ads b/src/tables.ads index 0b1026646..b7a4b0344 100644 --- a/src/tables.ads +++ b/src/tables.ads @@ -20,6 +20,8 @@ -- - the index type can be any discrete type (in particular a modular type) -- - the increment is not used -- - the interface is simplified. +with Dyn_Tables; + generic -- This package creates: -- array (Table_Index_Type range Table_Low_Bound .. <>) @@ -35,23 +37,18 @@ generic -- Initial number of elements. Table_Initial : Positive; package Tables is - -- Ada type for the array. - type Table_Type is - array (Table_Index_Type range <>) of Table_Component_Type; - -- Fat subtype (so that the access is thin). - subtype Big_Table_Type is - Table_Type (Table_Low_Bound .. Table_Index_Type'Last); + package Dyn_Table is new Dyn_Tables (Table_Component_Type, + Table_Index_Type, + Table_Low_Bound, + Table_Initial); + + T : Dyn_Table.Instance; - -- Access type for the vector. This is a thin pointer so that it is - -- compatible with C pointer, as this package uses malloc/realloc/free for - -- memory management. - type Table_Thin_Ptr is access all Big_Table_Type; - pragma Convention (C, Table_Thin_Ptr); - for Table_Thin_Ptr'Storage_Size use 0; + subtype Table_Type is Dyn_Table.Table_Type; -- Pointer to the table. Note that the use of a thin pointer to the -- largest array, this implementation bypasses Ada index checks. - Table : Table_Thin_Ptr := null; + Table : Dyn_Table.Table_Thin_Ptr renames T.Table; -- Initialize the table. This is done automatically at elaboration. procedure Init; @@ -84,4 +81,5 @@ package Tables is -- Increase by NUM the length of the array, and returns the old value -- of Last + 1. function Allocate (Num : Natural := 1) return Table_Index_Type; + pragma Inline (Allocate); end Tables; |