1 /* Copyright (C) 2012,2016 Matthew Fluet.
2 * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
3 * Jagannathan, and Stephen Weeks.
4 * Copyright (C) 1997-2000 NEC Research Institute.
6 * MLton is released under a BSD-style license.
7 * See the file MLton-LICENSE for details.
10 /* ---------------------------------------------------------------- */
11 /* Object hash consing */
12 /* ---------------------------------------------------------------- */
14 /* Hashing based on Introduction to Algorithms by Cormen, Leiserson, and Rivest.
15 * Section numbers in parens.
16 * k is key to be hashed.
17 * table is of size 2^p (it must be a power of two)
18 * Open addressing (12.4), meaning that we stick the entries directly in the
19 * table and probe until we find what we want.
20 * Multiplication method (12.3.2), meaning that we compute the hash by
21 * multiplying by a magic number, chosen by Knuth, and take the high-order p
22 * bits of the low order 32 bits.
23 * Double hashing (12.4), meaning that we use two hash functions, the first to
24 * decide where to start looking and a second to decide at what offset to
25 * probe. The second hash must be relatively prime to the table size, which
26 * we ensure by making it odd and keeping the table size as a power of 2.
29 GC_objectHashTable
allocHashTable (GC_state s
) {
30 uint32_t elementsLengthMax
;
35 t
= (GC_objectHashTable
)(malloc_safe (sizeof(*t
)));
36 // Try to use space in the heap for the elements.
37 if (not (isHeapInit (&s
->secondaryHeap
))) {
39 fprintf (stderr
, "using secondaryHeap\n");
40 regionStart
= s
->secondaryHeap
.start
;
41 regionEnd
= s
->secondaryHeap
.start
+ s
->secondaryHeap
.size
;
42 } else if (s
->amInGC
or not s
->canMinor
) {
44 fprintf (stderr
, "using end of heap\n");
45 regionStart
= s
->frontier
;
46 regionEnd
= s
->limitPlusSlop
;
49 fprintf (stderr
, "using minor space\n");
51 regionStart
= s
->heap
.start
+ s
->heap
.oldGenSize
;
52 regionEnd
= s
->heap
.nursery
;
54 elementsLengthMax
= (uint32_t)((size_t)(regionEnd
- regionStart
) / sizeof (*(t
->elements
)));
56 fprintf (stderr
, "elementsLengthMax = %"PRIu32
"\n", elementsLengthMax
);
57 t
->elementsLengthMax
= 64; // some small power of two
58 t
->elementsLengthMaxLog2
= 6; // and its log base 2
59 if (elementsLengthMax
< t
->elementsLengthMax
) {
61 fprintf (stderr
, "elementsLengthMax too small -- using calloc\n");
62 t
->elementsIsInHeap
= FALSE
;
64 (struct GC_objectHashElement
*)
65 (calloc_safe(t
->elementsLengthMax
, sizeof(*(t
->elements
))));
68 fprintf (stderr
, "elementsLengthMax big enough -- using heap\n");
69 t
->elementsIsInHeap
= TRUE
;
70 t
->elements
= (struct GC_objectHashElement
*)regionStart
;
71 // Find the largest power of two that fits.
73 t
->elementsLengthMax
<= elementsLengthMax
;
74 t
->elementsLengthMax
<<= 1, t
->elementsLengthMaxLog2
++)
76 t
->elementsLengthMax
>>= 1;
77 t
->elementsLengthMaxLog2
--;
78 assert (t
->elementsLengthMax
<= elementsLengthMax
);
79 for (unsigned int i
= 0; i
< t
->elementsLengthMax
; ++i
)
80 t
->elements
[i
].object
= NULL
;
82 t
->elementsLengthCur
= 0;
85 fprintf (stderr
, "elementsIsInHeap = %s\n",
86 boolToString (t
->elementsIsInHeap
));
87 fprintf (stderr
, "elementsLengthMax = %"PRIu32
"\n", t
->elementsLengthMax
);
88 fprintf (stderr
, FMTPTR
" = allocHashTable ()\n", (uintptr_t)t
);
93 void freeHashTable (GC_objectHashTable t
) {
94 unless (t
->elementsIsInHeap
)
99 pointer
insertHashTableElem (GC_state s
,
100 GC_objectHashTable t
,
101 GC_hash hash
, pointer object
,
102 pointer max
, bool mightBeThere
) {
103 static bool init
= FALSE
;
104 static uint64_t mult
; // magic multiplier for hashing
105 static uint32_t maxNumProbes
= 0;
107 GC_objectHashElement e
;
110 uint32_t slot
; // slot in the hash table we are considering
115 fprintf (stderr
, "insertHashTableElem ("FMTHASH
", "FMTPTR
", "FMTPTR
", %s)\n",
119 boolToString (mightBeThere
));
122 double dmult
= floor (((sqrt (5.0) - 1.0) / 2.0) * (double)0x100000000llu
);
123 mult
= (uint64_t)dmult
;
125 slot
= (uint32_t)(mult
* (uint64_t)hash
) >> (32 - t
->elementsLengthMaxLog2
);
126 probe
= (1 == slot
% 2) ? slot
: slot
- 1;
128 fprintf (stderr
, "probe = 0x%"PRIx32
"\n", probe
);
129 assert (1 == probe
% 2);
133 fprintf (stderr
, "slot = 0x%"PRIx32
"\n", slot
);
134 assert (slot
< t
->elementsLengthMax
);
136 e
= &t
->elements
[slot
];
137 if (NULL
== e
->object
) {
138 /* It's not in the table. Add it. */
139 unless (t
->mayInsert
) {
141 fprintf (stderr
, "not inserting\n");
146 t
->elementsLengthCur
++;
147 if (numProbes
> maxNumProbes
) {
148 maxNumProbes
= numProbes
;
150 fprintf (stderr
, "numProbes = %"PRIu32
"\n", numProbes
);
154 unless (hash
== e
->hash
) {
156 slot
= (slot
+ probe
) % t
->elementsLengthMax
;
159 unless (mightBeThere
)
162 fprintf (stderr
, "comparing "FMTPTR
" to "FMTPTR
"\n",
163 (uintptr_t)object
, (uintptr_t)e
->object
);
164 /* Compare object to e->object. */
165 unless (object
== e
->object
) {
167 GC_objectTypeTag tag
;
169 header
= getHeader (object
);
170 unless (header
== getHeader (e
->object
))
172 for (p1
= (unsigned int*)object
,
173 p2
= (unsigned int*)e
->object
;
174 p1
< (unsigned int*)max
;
178 splitHeader (s
, header
, &tag
, NULL
, NULL
, NULL
);
180 and (getArrayLength (object
) != getArrayLength (e
->object
)))
183 /* object is equal to e->object. */
187 void growHashTableMaybe (GC_state s
, GC_objectHashTable t
) {
188 GC_objectHashElement oldElement
;
189 struct GC_objectHashElement
*oldElements
;
190 uint32_t oldElementsLengthMax
;
191 uint32_t newElementsLengthMax
;
193 if (not t
->mayInsert
or t
->elementsLengthCur
* 2 <= t
->elementsLengthMax
)
195 oldElements
= t
->elements
;
196 oldElementsLengthMax
= t
->elementsLengthMax
;
197 newElementsLengthMax
= oldElementsLengthMax
* 2;
200 "trying to grow table to cardinality %"PRIu32
"\n",
201 newElementsLengthMax
);
202 // Try to alocate the new table.
204 (struct GC_objectHashElement
*)
205 (calloc(newElementsLengthMax
, sizeof(*(t
->elements
))));
206 if (NULL
== t
->elements
) {
207 t
->mayInsert
= FALSE
;
208 t
->elements
= oldElements
;
210 fprintf (stderr
, "unable to grow table\n");
213 t
->elementsLengthMax
= newElementsLengthMax
;
214 t
->elementsLengthMaxLog2
++;
215 for (unsigned int i
= 0; i
< oldElementsLengthMax
; ++i
) {
216 oldElement
= &oldElements
[i
];
217 unless (NULL
== oldElement
->object
)
219 (s
, t
, oldElement
->hash
, oldElement
->object
, NULL
, FALSE
);
221 if (t
->elementsIsInHeap
)
222 t
->elementsIsInHeap
= FALSE
;
226 fprintf (stderr
, "done growing table\n");
229 pointer
hashConsPointer (GC_state s
, pointer object
, bool countBytesHashConsed
) {
230 GC_objectHashTable t
;
232 uint16_t bytesNonObjptrs
;
235 GC_objectTypeTag tag
;
242 fprintf (stderr
, "hashConsPointer ("FMTPTR
")\n", (uintptr_t)object
);
243 t
= s
->objectHashTable
;
244 header
= getHeader (object
);
245 splitHeader(s
, header
, &tag
, &hasIdentity
, &bytesNonObjptrs
, &numObjptrs
);
247 /* Don't hash cons. */
251 assert ((ARRAY_TAG
== tag
) or (NORMAL_TAG
== tag
));
255 ? (sizeofArrayNoMetaData (s
, getArrayLength (object
),
256 bytesNonObjptrs
, numObjptrs
))
257 : (bytesNonObjptrs
+ (numObjptrs
* OBJPTR_SIZE
)));
259 hash
= (GC_hash
)header
;
260 for (p
= (GC_hash
*)object
; p
< (GC_hash
*)max
; ++p
)
261 hash
= hash
* 31 + *p
;
262 /* Insert into table. */
263 res
= insertHashTableElem (s
, t
, hash
, object
, max
, TRUE
);
264 growHashTableMaybe (s
, t
);
265 if (countBytesHashConsed
and res
!= object
) {
268 amount
= (size_t)(max
- object
);
269 if (ARRAY_TAG
== tag
)
270 amount
+= GC_ARRAY_METADATA_SIZE
;
272 amount
+= GC_NORMAL_METADATA_SIZE
;
273 s
->lastMajorStatistics
.bytesHashConsed
+= amount
;
277 fprintf (stderr
, FMTPTR
" = hashConsPointer ("FMTPTR
")\n",
278 (uintptr_t)res
, (uintptr_t)object
);
282 void shareObjptr (GC_state s
, objptr
*opp
) {
285 p
= objptrToPointer (*opp
, s
->heap
.start
);
287 fprintf (stderr
, "shareObjptr opp = "FMTPTR
" *opp = "FMTOBJPTR
"\n",
288 (uintptr_t)opp
, *opp
);
289 p
= hashConsPointer (s
, p
, FALSE
);
290 *opp
= pointerToObjptr (p
, s
->heap
.start
);
291 markIntergenerationalObjptr (s
, opp
);
294 void printBytesHashConsedMessage (size_t bytesHashConsed
, size_t bytesExamined
) {
295 fprintf (stderr
, "[GC: hash-consed %s bytes (%.1f%% of bytes examined).]\n",
296 uintmaxToCommaString(bytesHashConsed
),
297 100.0 * ((double)bytesHashConsed
/ (double)bytesExamined
));