diff options
author | Tristan Gingold <tgingold@free.fr> | 2020-05-22 08:11:58 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2020-05-22 08:50:36 +0200 |
commit | e4bff0d914b25645bed8c28921f00f4f4c4a3293 (patch) | |
tree | c12d0c7ae3a14546934cf3084403ba86eeb39350 /src/dyn_maps.adb | |
parent | 157761d65a3ce403cc82b5332b1cbe66a858dbe5 (diff) | |
download | ghdl-e4bff0d914b25645bed8c28921f00f4f4c4a3293.tar.gz ghdl-e4bff0d914b25645bed8c28921f00f4f4c4a3293.tar.bz2 ghdl-e4bff0d914b25645bed8c28921f00f4f4c4a3293.zip |
Add dyn_maps package
Diffstat (limited to 'src/dyn_maps.adb')
-rw-r--r-- | src/dyn_maps.adb | 147 |
1 files changed, 147 insertions, 0 deletions
diff --git a/src/dyn_maps.adb b/src/dyn_maps.adb new file mode 100644 index 000000000..72a195c62 --- /dev/null +++ b/src/dyn_maps.adb @@ -0,0 +1,147 @@ +-- Type interning - set of unique objects. +-- Copyright (C) 2019 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 Ada.Unchecked_Deallocation; + +package body Dyn_Maps is + procedure Deallocate is new Ada.Unchecked_Deallocation + (Hash_Array, Hash_Array_Acc); + + procedure Init (Inst : out Instance) is + begin + Inst.Size := Initial_Size; + Inst.Hash_Table := new Hash_Array'(0 .. Initial_Size - 1 => No_Index); + Wrapper_Tables.Init (Inst.Els, 128); + pragma Assert (Wrapper_Tables.Last (Inst.Els) = No_Index); + end Init; + + procedure Free (Inst : in out Instance) is + begin + Deallocate (Inst.Hash_Table); + Inst.Size := 0; + Wrapper_Tables.Free (Inst.Els); + end Free; + + -- Expand the hash table (double the size). + procedure Expand (Inst : in out Instance) + is + Old_Hash_Table : Hash_Array_Acc; + Idx : Index_Type; + begin + Old_Hash_Table := Inst.Hash_Table; + Inst.Size := Inst.Size * 2; + Inst.Hash_Table := new Hash_Array'(0 .. Inst.Size - 1 => No_Index); + + -- Rehash. + for I in Old_Hash_Table'Range loop + Idx := Old_Hash_Table (I); + while Idx /= No_Index loop + -- Note: collisions are put in reverse order. + declare + Ent : Element_Wrapper renames Inst.Els.Table (Idx); + Hash_Index : constant Hash_Value_Type := + Ent.Hash and (Inst.Size - 1); + Next_Idx : constant Index_Type := Ent.Next; + begin + Ent.Next := Inst.Hash_Table (Hash_Index); + Inst.Hash_Table (Hash_Index) := Idx; + Idx := Next_Idx; + end; + end loop; + end loop; + + Deallocate (Old_Hash_Table); + end Expand; + + procedure Get_Index + (Inst : in out Instance; Params : Params_Type; Idx : out Index_Type) + is + Hash_Value : Hash_Value_Type; + Hash_Index : Hash_Value_Type; + begin + -- Check if the package was initialized. + pragma Assert (Inst.Hash_Table /= null); + + Hash_Value := Hash (Params); + Hash_Index := Hash_Value and (Inst.Size - 1); + + Idx := Inst.Hash_Table (Hash_Index); + while Idx /= No_Index loop + declare + E : Element_Wrapper renames Inst.Els.Table (Idx); + begin + if E.Hash = Hash_Value and then Equal (E.Obj, Params) then + return; + end if; + Idx := E.Next; + end; + end loop; + + -- Maybe expand the table. + if Hash_Value_Type (Wrapper_Tables.Last (Inst.Els)) > 2 * Inst.Size then + Expand (Inst); + + -- Recompute hash index. + Hash_Index := Hash_Value and (Inst.Size - 1); + end if; + + declare + Res : Object_Type; + Val : Value_Type; + begin + Res := Build (Params); + Val := Build_Value (Res); + + -- Insert. + Wrapper_Tables.Append (Inst.Els, + (Hash => Hash_Value, + Next => Inst.Hash_Table (Hash_Index), + Obj => Res, + Val => Val)); + Inst.Hash_Table (Hash_Index) := Wrapper_Tables.Last (Inst.Els); + end; + + Idx := Wrapper_Tables.Last (Inst.Els); + end Get_Index; + + function Last_Index (Inst : Instance) return Index_Type is + begin + return Wrapper_Tables.Last (Inst.Els); + end Last_Index; + + function Get_By_Index (Inst : Instance; Index : Index_Type) + return Object_Type is + begin + pragma Assert (Index <= Wrapper_Tables.Last (Inst.Els)); + return Inst.Els.Table (Index).Obj; + end Get_By_Index; + + function Get_Value (Inst : Instance; Index : Index_Type) + return Value_Type is + begin + pragma Assert (Index <= Wrapper_Tables.Last (Inst.Els)); + return Inst.Els.Table (Index).Val; + end Get_Value; + + procedure Set_Value + (Inst : in out Instance; Index : Index_Type; Val : Value_Type) is + begin + pragma Assert (Index <= Wrapper_Tables.Last (Inst.Els)); + Inst.Els.Table (Index).Val := Val; + end Set_Value; +end Dyn_Maps; |