diff options
author | Tristan Gingold | 2015-09-10 20:59:08 +0200 |
---|---|---|
committer | Tristan Gingold | 2015-09-10 20:59:08 +0200 |
commit | 42f4c411641c04da2b8f08f9029e17bfd37206e4 (patch) | |
tree | 97db2955734ee7e059f461cef8a2924eeb49271d /src | |
parent | 95632804220716d4993d3e4b0d0cba06d984a837 (diff) | |
download | ghdl-42f4c411641c04da2b8f08f9029e17bfd37206e4.tar.gz ghdl-42f4c411641c04da2b8f08f9029e17bfd37206e4.tar.bz2 ghdl-42f4c411641c04da2b8f08f9029e17bfd37206e4.zip |
Reimplement table package (used instead of GNAT.Table).
Diffstat (limited to 'src')
-rw-r--r-- | src/files_map.adb | 7 | ||||
-rw-r--r-- | src/ghdldrv/ghdldrv.adb | 7 | ||||
-rw-r--r-- | src/ghdldrv/ghdlprint.adb | 7 | ||||
-rw-r--r-- | src/libraries.adb | 7 | ||||
-rw-r--r-- | src/lists.adb | 7 | ||||
-rw-r--r-- | src/name_table.adb | 14 | ||||
-rw-r--r-- | src/ortho/mcode/binary_file.ads | 7 | ||||
-rw-r--r-- | src/ortho/mcode/ortho_code-consts.adb | 12 | ||||
-rw-r--r-- | src/ortho/mcode/ortho_code-decls.adb | 12 | ||||
-rw-r--r-- | src/ortho/mcode/ortho_code-dwarf.adb | 7 | ||||
-rw-r--r-- | src/ortho/mcode/ortho_code-exprs.adb | 7 | ||||
-rw-r--r-- | src/ortho/mcode/ortho_code-types.adb | 12 | ||||
-rw-r--r-- | src/ortho/mcode/ortho_code-x86-abi.adb | 4 | ||||
-rw-r--r-- | src/ortho/mcode/ortho_ident.adb | 12 | ||||
-rw-r--r-- | src/str_table.adb | 7 | ||||
-rw-r--r-- | src/tables.adb | 143 | ||||
-rw-r--r-- | src/tables.ads | 87 | ||||
-rw-r--r-- | src/vhdl/configuration.ads | 7 | ||||
-rw-r--r-- | src/vhdl/nodes.adb | 7 | ||||
-rw-r--r-- | src/vhdl/sem_inst.adb | 12 | ||||
-rw-r--r-- | src/vhdl/sem_scopes.adb | 17 | ||||
-rw-r--r-- | src/vhdl/xrefs.adb | 7 |
22 files changed, 307 insertions, 102 deletions
diff --git a/src/files_map.adb b/src/files_map.adb index 94e4bad..3f561e0 100644 --- a/src/files_map.adb +++ b/src/files_map.adb @@ -20,7 +20,7 @@ with Interfaces.C; with Ada.Characters.Latin_1; with Ada.Text_IO; use Ada.Text_IO; with Ada.Unchecked_Deallocation; -with GNAT.Table; +with Tables; with GNAT.OS_Lib; with GNAT.SHA1; with GNAT.Directory_Operations; @@ -74,12 +74,11 @@ package body Files_Map is -- Next location to use. Next_Location : Location_Type := Location_Nil + 1; - package Source_Files is new GNAT.Table + package Source_Files is new Tables (Table_Index_Type => Source_File_Entry, Table_Component_Type => Source_File_Record, Table_Low_Bound => No_Source_File_Entry + 1, - Table_Initial => 16, - Table_Increment => 100); + Table_Initial => 16); function Get_Last_Source_File_Entry return Source_File_Entry is begin diff --git a/src/ghdldrv/ghdldrv.adb b/src/ghdldrv/ghdldrv.adb index e3008b8..4bacd89 100644 --- a/src/ghdldrv/ghdldrv.adb +++ b/src/ghdldrv/ghdldrv.adb @@ -19,7 +19,7 @@ with Ada.Command_Line; use Ada.Command_Line; with Ada.Text_IO; use Ada.Text_IO; with Ada.Characters.Latin_1; with GNAT.OS_Lib; use GNAT.OS_Lib; -with GNAT.Table; +with Tables; with GNAT.Dynamic_Tables; with Libraries; with Name_Table; use Name_Table; @@ -271,12 +271,11 @@ package body Ghdldrv is Free (Obj_File); end Do_Compile; - package Filelist is new GNAT.Table + package Filelist is new Tables (Table_Component_Type => String_Access, Table_Index_Type => Natural, Table_Low_Bound => 1, - Table_Initial => 16, - Table_Increment => 100); + Table_Initial => 16); Link_Obj_Suffix : String_Access; diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb index d0d2d3a..6d2ea4b 100644 --- a/src/ghdldrv/ghdlprint.adb +++ b/src/ghdldrv/ghdlprint.adb @@ -19,7 +19,7 @@ with Ada.Characters.Latin_1; with Ada.Text_IO; use Ada.Text_IO; with GNAT.Directory_Operations; with GNAT.OS_Lib; use GNAT.OS_Lib; -with GNAT.Table; +with Tables; with Types; use Types; with Flags; with Name_Table; use Name_Table; @@ -1044,12 +1044,11 @@ package body Ghdlprint is use Tokens; use Scanner; - package Ref_Tokens is new GNAT.Table + package Ref_Tokens is new Tables (Table_Component_Type => Token_Type, Table_Index_Type => Integer, Table_Low_Bound => 0, - Table_Initial => 1024, - Table_Increment => 100); + Table_Initial => 1024); Id : Name_Id; Fe : Source_File_Entry; diff --git a/src/libraries.adb b/src/libraries.adb index 1b2945f..d6de2b5 100644 --- a/src/libraries.adb +++ b/src/libraries.adb @@ -16,7 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Text_IO; use Ada.Text_IO; -with GNAT.Table; +with Tables; with GNAT.OS_Lib; with Interfaces.C_Streams; with System; @@ -41,12 +41,11 @@ package body Libraries is Implicit_Location: Location_Type; -- Table of library pathes. - package Pathes is new GNAT.Table + package Pathes is new Tables (Table_Index_Type => Integer, Table_Component_Type => Name_Id, Table_Low_Bound => 1, - Table_Initial => 4, - Table_Increment => 100); + Table_Initial => 4); -- Report an error message. procedure Error_Lib_Msg (Msg : String) is diff --git a/src/lists.adb b/src/lists.adb index 38afea5..ff0702f 100644 --- a/src/lists.adb +++ b/src/lists.adb @@ -16,7 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with System; -with GNAT.Table; +with Tables; package body Lists is type Node_Array_Fat is array (Natural) of Node_Type; @@ -29,12 +29,11 @@ package body Lists is Els : Node_Array_Fat_Acc; end record; - package Listt is new GNAT.Table + package Listt is new Tables (Table_Component_Type => List_Record, Table_Index_Type => List_Type, Table_Low_Bound => 4, - Table_Initial => 128, - Table_Increment => 100); + Table_Initial => 128); --function Get_Max_Nbr_Elements (List : List_Type) return Natural; --pragma Inline (Get_Max_Nbr_Elements); diff --git a/src/name_table.adb b/src/name_table.adb index 1908ff8..b4bc24c 100644 --- a/src/name_table.adb +++ b/src/name_table.adb @@ -18,7 +18,7 @@ with Ada.Text_IO; use Ada.Text_IO; with Ada.Unchecked_Deallocation; with Interfaces; -with GNAT.Table; +with Tables; package body Name_Table is -- Id of the first character (NUL). @@ -57,24 +57,22 @@ package body Name_Table is Hash_Table: Hash_Array_Acc; -- Table of identifiers. - package Names_Table is new GNAT.Table + package Names_Table is new Tables (Table_Index_Type => Name_Id, Table_Component_Type => Identifier, Table_Low_Bound => Name_Id'First, - Table_Initial => 1024, - Table_Increment => 100); + Table_Initial => 1024); -- A NUL character is stored after each word in the strings_table. -- This is used for compatibility with C. NUL : constant Character := Character'Val (0); -- The table to store all the strings. Strings are always NUL terminated. - package Strings_Table is new GNAT.Table + package Strings_Table is new Tables (Table_Index_Type => Natural, Table_Component_Type => Character, Table_Low_Bound => Natural'First, - Table_Initial => 4096, - Table_Increment => 100); + Table_Initial => 4096); -- Allocate place in the strings_table, and store the name_buffer into it. -- Also append a NUL. @@ -107,7 +105,7 @@ package body Name_Table is Strings_Table.Init; Names_Table.Init; - Strings_Table.Set_Last (1); + Strings_Table.Append (NUL); -- Reserve entry 0. Strings_Table.Append (NUL); diff --git a/src/ortho/mcode/binary_file.ads b/src/ortho/mcode/binary_file.ads index 4618aeb..da8341b 100644 --- a/src/ortho/mcode/binary_file.ads +++ b/src/ortho/mcode/binary_file.ads @@ -19,7 +19,7 @@ with System; with Interfaces; use Interfaces; with Ada.Unchecked_Deallocation; with Ortho_Ident; use Ortho_Ident; -with GNAT.Table; +with Tables; with Memsegs; package Binary_File is @@ -250,12 +250,11 @@ private Section_Chain : Section_Acc := null; Section_Last : Section_Acc := null; - package Symbols is new GNAT.Table + package Symbols is new Tables (Table_Component_Type => Symbol_Type, Table_Index_Type => Symbol, Table_Low_Bound => 2, - Table_Initial => 1024, - Table_Increment => 100); + Table_Initial => 1024); function Pow_Align (V : Pc_Type; Align : Natural) return Pc_Type; diff --git a/src/ortho/mcode/ortho_code-consts.adb b/src/ortho/mcode/ortho_code-consts.adb index d09a13c..6e36a07 100644 --- a/src/ortho/mcode/ortho_code-consts.adb +++ b/src/ortho/mcode/ortho_code-consts.adb @@ -16,7 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Unchecked_Conversion; -with GNAT.Table; +with Tables; with Ada.Text_IO; with Ortho_Code.Types; use Ortho_Code.Types; with Ortho_Code.Debug; @@ -77,12 +77,11 @@ package body Ortho_Code.Consts is end record; for Cnode_Union'Size use 64; - package Cnodes is new GNAT.Table + package Cnodes is new Tables (Table_Component_Type => Cnode_Common, Table_Index_Type => O_Cnode, Table_Low_Bound => 2, - Table_Initial => 128, - Table_Increment => 100); + Table_Initial => 128); function Get_Const_Kind (Cst : O_Cnode) return OC_Kind is begin @@ -315,12 +314,11 @@ package body Ortho_Code.Consts is return L + 2; end Get_Lit_Chain; - package Els is new GNAT.Table + package Els is new Tables (Table_Component_Type => O_Cnode, Table_Index_Type => Int32, Table_Low_Bound => 2, - Table_Initial => 128, - Table_Increment => 100); + Table_Initial => 128); function To_Cnode_Common is new Ada.Unchecked_Conversion (Source => Cnode_Aggr, Target => Cnode_Common); diff --git a/src/ortho/mcode/ortho_code-decls.adb b/src/ortho/mcode/ortho_code-decls.adb index 2557204..253ea60 100644 --- a/src/ortho/mcode/ortho_code-decls.adb +++ b/src/ortho/mcode/ortho_code-decls.adb @@ -15,7 +15,7 @@ -- along with GCC; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -with GNAT.Table; +with Tables; with Ada.Text_IO; with Ortho_Ident; with Ortho_Code.Debug; use Ortho_Code.Debug; @@ -103,19 +103,17 @@ package body Ortho_Code.Decls is pragma Pack (Dnode_Common); - package Dnodes is new GNAT.Table + package Dnodes is new Tables (Table_Component_Type => Dnode_Common, Table_Index_Type => O_Dnode, Table_Low_Bound => O_Dnode_First, - Table_Initial => 128, - Table_Increment => 100); + Table_Initial => 128); - package TDnodes is new GNAT.Table + package TDnodes is new Tables (Table_Component_Type => O_Dnode, Table_Index_Type => O_Tnode, Table_Low_Bound => O_Tnode_First, - Table_Initial => 1, - Table_Increment => 100); + Table_Initial => 8); Context : O_Dnode := O_Dnode_Null; diff --git a/src/ortho/mcode/ortho_code-dwarf.adb b/src/ortho/mcode/ortho_code-dwarf.adb index ad67d1f..309c82d 100644 --- a/src/ortho/mcode/ortho_code-dwarf.adb +++ b/src/ortho/mcode/ortho_code-dwarf.adb @@ -16,7 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with GNAT.Directory_Operations; -with GNAT.Table; +with Tables; with Interfaces; use Interfaces; with Binary_File; use Binary_File; with Dwarf; use Dwarf; @@ -523,12 +523,11 @@ package body Ortho_Code.Dwarf is Abbrev_Enum_Name : Unsigned_32 := 0; Abbrev_Enumerator : Unsigned_32 := 0; - package TOnodes is new GNAT.Table + package TOnodes is new Tables (Table_Component_Type => Pc_Type, Table_Index_Type => O_Tnode, Table_Low_Bound => O_Tnode_First, - Table_Initial => 16, - Table_Increment => 100); + Table_Initial => 16); procedure Emit_Type_Ref (Atype : O_Tnode) is diff --git a/src/ortho/mcode/ortho_code-exprs.adb b/src/ortho/mcode/ortho_code-exprs.adb index 9cfffd1..7d840cb 100644 --- a/src/ortho/mcode/ortho_code-exprs.adb +++ b/src/ortho/mcode/ortho_code-exprs.adb @@ -17,7 +17,7 @@ -- 02111-1307, USA. with Ada.Text_IO; with Ada.Unchecked_Deallocation; -with GNAT.Table; +with Tables; with Ortho_Code.Types; use Ortho_Code.Types; with Ortho_Code.Consts; use Ortho_Code.Consts; with Ortho_Code.Decls; use Ortho_Code.Decls; @@ -48,12 +48,11 @@ package body Ortho_Code.Exprs is for Enode_Common'Size use 4*32; for Enode_Common'Alignment use 4; - package Enodes is new GNAT.Table + package Enodes is new Tables (Table_Component_Type => Enode_Common, Table_Index_Type => O_Enode, Table_Low_Bound => 2, - Table_Initial => 1024, - Table_Increment => 100); + Table_Initial => 1024); function Get_Expr_Kind (Enode : O_Enode) return OE_Kind is begin diff --git a/src/ortho/mcode/ortho_code-types.adb b/src/ortho/mcode/ortho_code-types.adb index e5893aa..439c065 100644 --- a/src/ortho/mcode/ortho_code-types.adb +++ b/src/ortho/mcode/ortho_code-types.adb @@ -17,7 +17,7 @@ -- 02111-1307, USA. with Ada.Text_IO; with Ada.Unchecked_Conversion; -with GNAT.Table; +with Tables; with Ortho_Code.Consts; use Ortho_Code.Consts; with Ortho_Code.Debug; with Ortho_Code.Abi; use Ortho_Code.Abi; @@ -69,12 +69,11 @@ package body Ortho_Code.Types is Lit_True : O_Cnode; end record; - package Tnodes is new GNAT.Table + package Tnodes is new Tables (Table_Component_Type => Tnode_Common, Table_Index_Type => O_Tnode, Table_Low_Bound => O_Tnode_First, - Table_Initial => 128, - Table_Increment => 100); + Table_Initial => 128); type Field_Type is record Parent : O_Tnode; @@ -84,12 +83,11 @@ package body Ortho_Code.Types is Next : O_Fnode; end record; - package Fnodes is new GNAT.Table + package Fnodes is new Tables (Table_Component_Type => Field_Type, Table_Index_Type => O_Fnode, Table_Low_Bound => 2, - Table_Initial => 64, - Table_Increment => 100); + Table_Initial => 64); function Get_Type_Kind (Atype : O_Tnode) return OT_Kind is begin diff --git a/src/ortho/mcode/ortho_code-x86-abi.adb b/src/ortho/mcode/ortho_code-x86-abi.adb index 36072ab..38cfc92 100644 --- a/src/ortho/mcode/ortho_code-x86-abi.adb +++ b/src/ortho/mcode/ortho_code-x86-abi.adb @@ -139,7 +139,9 @@ package body Ortho_Code.X86.Abi is Release (Decls_Mark); Consts.Release (Consts_Mark); Release (Types_Mark); - Dwarf.Release (Dwarf_Mark); + if Flag_Debug = Debug_Dwarf then + Dwarf.Release (Dwarf_Mark); + end if; end if; end if; end Finish_Body; diff --git a/src/ortho/mcode/ortho_ident.adb b/src/ortho/mcode/ortho_ident.adb index 0893b75..9b5a36e 100644 --- a/src/ortho/mcode/ortho_ident.adb +++ b/src/ortho/mcode/ortho_ident.adb @@ -16,22 +16,20 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Text_IO; -with GNAT.Table; +with Tables; package body Ortho_Ident is - package Ids is new GNAT.Table + package Ids is new Tables (Table_Component_Type => Natural, Table_Index_Type => O_Ident, Table_Low_Bound => 2, - Table_Initial => 128, - Table_Increment => 100); + Table_Initial => 128); - package Strs is new GNAT.Table + package Strs is new Tables (Table_Component_Type => Character, Table_Index_Type => Natural, Table_Low_Bound => 2, - Table_Initial => 128, - Table_Increment => 100); + Table_Initial => 128); function Get_Identifier (Str : String) return O_Ident is diff --git a/src/str_table.adb b/src/str_table.adb index eeebea1..46a42df 100644 --- a/src/str_table.adb +++ b/src/str_table.adb @@ -15,19 +15,18 @@ -- 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 GNAT.Table; +with Tables; package body Str_Table is -- Be sure the elements are packed. type El_Nat8 is new Nat8; for El_Nat8'Size use 8; - package String8_Table is new GNAT.Table + package String8_Table is new Tables (Table_Index_Type => String8_Id, Table_Component_Type => El_Nat8, Table_Low_Bound => Null_String8 + 1, - Table_Initial => 1024, - Table_Increment => 100); + Table_Initial => 1024); Cur_String8 : String8_Id := 0; diff --git a/src/tables.adb b/src/tables.adb new file mode 100644 index 0000000..ca86742 --- /dev/null +++ b/src/tables.adb @@ -0,0 +1,143 @@ +-- Efficient expandable one dimensional array. +-- Copyright (C) 2015 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 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); + begin + Expand (Num); + + return Res; + end Allocate; + + procedure Increment_Last is + begin + -- Increase by 1. + Expand (1); + end Increment_Last; + + procedure Decrement_Last is + begin + Last_Pos := Last_Pos - 1; + 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); + begin + if New_Last < Last_Pos then + -- Decrease length. + Last_Pos := New_Last; + else + -- Increase length. + Expand (New_Last - Last_Pos); + end if; + end Set_Last; + + procedure Init + is + -- Direct interface to malloc. + function Cmalloc (Size : size_t) return Table_Thin_Ptr; + pragma Import (C, Cmalloc, "malloc"); + 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; + 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); + 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; + end Free; + + procedure Append (Val : Table_Component_Type) is + begin + Increment_Last; + Table (Last) := Val; + end Append; + +begin + Init; +end Tables; diff --git a/src/tables.ads b/src/tables.ads new file mode 100644 index 0000000..0b10266 --- /dev/null +++ b/src/tables.ads @@ -0,0 +1,87 @@ +-- Efficient expandable one dimensional array. +-- Copyright (C) 2015 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 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; + + -- 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; + + -- Initialize the table. This is done automatically at elaboration. + procedure Init; + + -- Logical bounds of the array. + First : constant Table_Index_Type := Table_Low_Bound; + function Last return Table_Index_Type; + pragma Inline (Last); + + -- Deallocate all the memory. Makes the array unusable until the next + -- call to Init. + procedure Free; + + -- Increase by 1 the length of the array. This may allocate memory. + procedure Increment_Last; + pragma Inline (Increment_Last); + + -- Decrease by 1 the length of the array. + procedure Decrement_Last; + pragma Inline (Decrement_Last); + + -- Increase or decrease the length of the array by specifying the upper + -- bound. + procedure Set_Last (Index : Table_Index_Type); + + -- Append VAL to the array. This always increase the length of the array. + procedure Append (Val : Table_Component_Type); + pragma Inline (Append); + + -- 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; +end Tables; diff --git a/src/vhdl/configuration.ads b/src/vhdl/configuration.ads index e02a2cd..8545c22 100644 --- a/src/vhdl/configuration.ads +++ b/src/vhdl/configuration.ads @@ -17,15 +17,14 @@ -- 02111-1307, USA. with Types; use Types; with Iirs; use Iirs; -with GNAT.Table; +with Tables; package Configuration is - package Design_Units is new GNAT.Table + package Design_Units is new Tables (Table_Component_Type => Iir_Design_Unit, Table_Index_Type => Natural, Table_Low_Bound => 1, - Table_Initial => 16, - Table_Increment => 100); + Table_Initial => 16); -- Get the top configuration to build a design hierarchy whose top is -- PRIMARY + SECONDARY. diff --git a/src/vhdl/nodes.adb b/src/vhdl/nodes.adb index 3f0a2b3..88548f7 100644 --- a/src/vhdl/nodes.adb +++ b/src/vhdl/nodes.adb @@ -15,7 +15,7 @@ -- 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 GNAT.Table; +with Tables; package body Nodes is -- Suppress the access check of the table base. This is really safe to @@ -31,12 +31,11 @@ package body Nodes is -- iirs do their own checks. pragma Suppress (Discriminant_Check); - package Nodet is new GNAT.Table + package Nodet is new Tables (Table_Component_Type => Node_Record, Table_Index_Type => Node_Type, Table_Low_Bound => 2, - Table_Initial => 1024, - Table_Increment => 100); + Table_Initial => 1024); function Get_Last_Node return Node_Type is begin diff --git a/src/vhdl/sem_inst.adb b/src/vhdl/sem_inst.adb index b60b34b..cb46b83 100644 --- a/src/vhdl/sem_inst.adb +++ b/src/vhdl/sem_inst.adb @@ -14,7 +14,7 @@ -- package to its duplicated node. Links from instantiated declaration to -- the original declaration are also stored in that table. -with GNAT.Table; +with Tables; with Nodes; with Nodes_Meta; with Types; use Types; @@ -38,12 +38,11 @@ package body Sem_Inst is -- The origin of Nat1 is Nat and this is true forever. During -- instantiation, the instance of Nat is Nat1, so that the type of N will -- be set to Nat1. - package Origin_Table is new GNAT.Table + package Origin_Table is new Tables (Table_Component_Type => Iir, Table_Index_Type => Iir, Table_Low_Bound => 2, - Table_Initial => 1024, - Table_Increment => 100); + Table_Initial => 1024); procedure Expand_Origin_Table is @@ -109,12 +108,11 @@ package body Sem_Inst is -- have uninstantiated packages in instantiated packages. In that case, -- the slot in Origin_Table cannot be the origin and the instance at the -- same time. - package Prev_Instance_Table is new GNAT.Table + package Prev_Instance_Table is new Tables (Table_Component_Type => Instance_Entry_Type, Table_Index_Type => Instance_Index_Type, Table_Low_Bound => 1, - Table_Initial => 256, - Table_Increment => 100); + Table_Initial => 256); procedure Set_Instance (Orig : Iir; N : Iir) is diff --git a/src/vhdl/sem_scopes.adb b/src/vhdl/sem_scopes.adb index 442da38..4add633 100644 --- a/src/vhdl/sem_scopes.adb +++ b/src/vhdl/sem_scopes.adb @@ -16,7 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Text_IO; -with GNAT.Table; +with Tables; with Flags; use Flags; with Name_Table; -- use Name_Table; with Files_Map; use Files_Map; @@ -52,12 +52,11 @@ package body Sem_Scopes is end record; pragma Pack (Interpretation_Cell); - package Interpretations is new GNAT.Table + package Interpretations is new Tables (Table_Component_Type => Interpretation_Cell, Table_Index_Type => Name_Interpretation_Type, Table_Low_Bound => First_Valid_Interpretation, - Table_Initial => 1024, - Table_Increment => 100); + Table_Initial => 1024); -- Cached value of Prev_In_Region of current region. Last_In_Region : Name_Id := Null_Identifier; @@ -76,12 +75,11 @@ package body Sem_Scopes is type Hide_Index is new Nat32; No_Hide_Index : constant Hide_Index := 0; - package Hidden_Decls is new GNAT.Table + package Hidden_Decls is new Tables (Table_Component_Type => Name_Interpretation_Type, Table_Index_Type => Hide_Index, Table_Low_Bound => No_Hide_Index + 1, - Table_Initial => 32, - Table_Increment => 100); + Table_Initial => 32); -- First non-local hidden declarations. In VHDL, it is possible to hide -- an overloaded declaration (by declaring a subprogram with the same @@ -118,12 +116,11 @@ package body Sem_Scopes is Saved_First_Interpretation : Name_Interpretation_Type; end record; - package Scopes is new GNAT.Table + package Scopes is new Tables (Table_Component_Type => Scope_Cell, Table_Index_Type => Natural, Table_Low_Bound => 1, - Table_Initial => 64, - Table_Increment => 100); + Table_Initial => 64); function Valid_Interpretation (Inter : Name_Interpretation_Type) return Boolean is diff --git a/src/vhdl/xrefs.adb b/src/vhdl/xrefs.adb index 1569669..aa23295 100644 --- a/src/vhdl/xrefs.adb +++ b/src/vhdl/xrefs.adb @@ -15,7 +15,7 @@ -- 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 GNAT.Table; +with Tables; with GNAT.Heap_Sort_A; with Flags; with Std_Package; @@ -34,12 +34,11 @@ package body Xrefs is Kind : Xref_Kind; end record; - package Xref_Table is new GNAT.Table + package Xref_Table is new Tables (Table_Index_Type => Natural, Table_Component_Type => Xref_Type, Table_Low_Bound => 0, - Table_Initial => 128, - Table_Increment => 100); + Table_Initial => 128); function Get_Xref_Location (N : Xref) return Location_Type is begin |