1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
-- 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_Interning 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);
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
(Inst : in out Instance; Params : Params_Type; Res : out Object_Type)
is
Hash_Value : Hash_Value_Type;
Hash_Index : Hash_Value_Type;
Idx : Index_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
Res := E.Obj;
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;
Res := Build (Params);
-- Insert.
Wrapper_Tables.Append (Inst.Els,
(Hash => Hash_Value,
Next => Inst.Hash_Table (Hash_Index),
Obj => Res));
Inst.Hash_Table (Hash_Index) := Wrapper_Tables.Last (Inst.Els);
end Get;
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;
end Dyn_Interning;
|
