1 /* Part of SWI-Prolog
2
3 Author: Jan Wielemaker
4 E-mail: J.Wielemaker@vu.nl
5 WWW: http://www.swi-prolog.org
6 Copyright (c) 2016-2020, VU University Amsterdam
7 CWI, Amsterdam
8 All rights reserved.
9
10 Redistribution and use in source and binary forms, with or without
11 modification, are permitted provided that the following conditions
12 are met:
13
14 1. Redistributions of source code must retain the above copyright
15 notice, this list of conditions and the following disclaimer.
16
17 2. Redistributions in binary form must reproduce the above copyright
18 notice, this list of conditions and the following disclaimer in
19 the documentation and/or other materials provided with the
20 distribution.
21
22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
33 POSSIBILITY OF SUCH DAMAGE.
34 */
35
36 #include "pl-incl.h"
37 #include "pl-indirect.h"
38
39 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
40 Indirect datatypes are represented by a tagged pointer to the global
41 stack. The global stack stores the data using a guard cell on both ends
42 of the actual data. The guard cell indicates the length of the blob and
43 is needed for the upward and downward scans needed by the garbage
44 collector. For example, a float is represented using:
45
46 <ptr, tagged with TAG_FLOAT|STG_GLOBAL>
47 |
48 |-----> [guard size 1] (* size 2 on 32-bit hardware *)
49 [IEEE double]
50 [guard size 1]
51
52 This does not play well with the tries as defined in pl-trie.c where we
53 want to switch on a term represented as a single word. We fix this by
54 `interning' the indirects. The intern table is comparable to the global
55 atom table. I consists of a dynamic array of interned indirects and
56 represents the indirect as a tagged index into this array.
57
58 We keep the design similar to the atom table. We have two options for
59 GC: use basically the same as atom-GC or always copy indirects to the
60 global stack. In the latter case there are never references from the
61 volatile areas and thus we can use purely reference count based GC.
62 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
63
64 static void rehash_indirect_table(indirect_table *tab);
65 static int bump_ref(indirect *h, unsigned int refs);
66 static indirect *reserve_indirect(indirect_table *tab, word val ARG_LD);
67 static indirect *create_indirect(indirect *h, size_t index, word val ARG_LD);
68
69 /* TBD: register with LD structure */
70 #define acquire_itable_buckets(tab) (tab->table)
71 #define acquire_itable_bucket(b) (void)0
72 #define release_itable_buckets() (void)0
73
74 #define TIGHT(buckets, tab) ((buckets)->size < (tab)->count)
75
76 #define INDIRECT_STATE_MASK ((unsigned int)0x3 << (INTBITSIZE-2))
77 #define INDIRECT_RESERVED_REFERENCE ((unsigned int)0x1 << (INTBITSIZE-1))
78 #define INDIRECT_VALID_REFERENCE ((unsigned int)0x1 << (INTBITSIZE-2))
79
80 #define INDIRECT_IS_FREE(ref) (((ref) & INDIRECT_STATE_MASK) == 0)
81 #define INDIRECT_IS_RESERVED(ref) ((ref) & INDIRECT_RESERVED_REFERENCE)
82 #define INDIRECT_IS_VALID(ref) ((ref) & INDIRECT_VALID_REFERENCE)
83
84 #define INDIRECT_REF_COUNT_MASK (~INDIRECT_STATE_MASK)
85 #define INDIRECT_REF_COUNT(ref) ((ref) & INDIRECT_REF_COUNT_MASK)
86
87
88 indirect_table *
new_indirect_table(void)89 new_indirect_table(void)
90 { indirect_table *tab = PL_malloc(sizeof(*tab));
91 indirect_array *arr = &tab->array;
92 indirect_buckets *newtab = PL_malloc(sizeof(*newtab));
93 int i;
94
95 memset(tab, 0, sizeof(*tab));
96 #ifdef O_PLMT
97 simpleMutexInit(&tab->mutex);
98 #endif
99
100 for(i=0; i<MSB(PREALLOCATED_INDIRECT_BLOCKS); i++)
101 { arr->blocks[i] = arr->preallocated;
102 }
103
104 newtab->size = 8;
105 newtab->buckets = PL_malloc(newtab->size*sizeof(*newtab->buckets));
106 memset(newtab->buckets, 0, newtab->size*sizeof(*newtab->buckets));
107 newtab->prev = NULL;
108 tab->table = newtab;
109 tab->no_hole_before = 1;
110 tab->highest = 1;
111
112 return tab;
113 }
114
115
116 static void
clean_block(indirect * block,size_t size)117 clean_block(indirect *block, size_t size)
118 { indirect *end = block+size;
119 indirect *b = block;
120
121 for(; b < end; b++)
122 { if ( b->data )
123 PL_free(b->data);
124 }
125 }
126
127 void
destroy_indirect_table(indirect_table * tab)128 destroy_indirect_table(indirect_table *tab)
129 { int i;
130 indirect_buckets *buckets, *prev;
131 indirect_array *arr = &tab->array;
132
133 #ifdef O_PLMT
134 simpleMutexDelete(&tab->mutex);
135 #endif
136 clean_block(arr->preallocated, PREALLOCATED_INDIRECT_BLOCKS);
137 for(i=MSB(PREALLOCATED_INDIRECT_BLOCKS); i<MAX_INDIRECT_BLOCKS; i++)
138 { if ( arr->blocks[i] )
139 { size_t bs = (size_t)1<<i;
140 indirect *block = arr->blocks[i]+bs;
141
142 clean_block(block, bs);
143 PL_free(block);
144 }
145 }
146
147 for(buckets = tab->table; buckets; buckets = prev)
148 { prev = buckets->prev;
149
150 PL_free(buckets->buckets);
151 PL_free(buckets);
152 }
153
154 PL_free(tab);
155 }
156
157
158 word
intern_indirect(indirect_table * tab,word val,int create ARG_LD)159 intern_indirect(indirect_table *tab, word val, int create ARG_LD)
160 { Word idata = addressIndirect(val); /* points at header */
161 size_t isize = wsizeofInd(*idata); /* include header */
162 unsigned int key = MurmurHashAligned2(idata+1, isize*sizeof(word), MURMUR_SEED);
163 indirect_buckets *buckets;
164
165 for(;;)
166 { buckets = acquire_itable_buckets(tab);
167 unsigned int ki = key & (buckets->size-1);
168 indirect *head = buckets->buckets[ki];
169 indirect *h;
170
171 acquire_itable_bucket(&buckets->buckets[ki]);
172 for(h=buckets->buckets[ki]; h; h = h->next)
173 { unsigned int ref = h->references;
174
175 if ( INDIRECT_IS_VALID(ref) &&
176 idata[0] == h->header &&
177 memcmp(idata+1, h->data, isize*sizeof(word)) == 0 )
178 { if ( bump_ref(h, ref) )
179 { release_itable_buckets();
180 return h->handle;
181 }
182 }
183 }
184
185 if ( TIGHT(buckets, tab) )
186 { simpleMutexLock(&tab->mutex);
187 rehash_indirect_table(tab);
188 simpleMutexUnlock(&tab->mutex);
189 }
190
191 if ( buckets != tab->table || head != buckets->buckets[ki] )
192 continue; /* try again */
193
194 if ( create )
195 { indirect *h = reserve_indirect(tab, val PASS_LD);
196
197 h->next = buckets->buckets[ki];
198 if ( !COMPARE_AND_SWAP_PTR(&buckets->buckets[ki], head, h) ||
199 buckets != tab->table )
200 { PL_free(h->data);
201 h->references = 0;
202 continue; /* try again */
203 }
204
205 h->references = 1 | INDIRECT_VALID_REFERENCE | INDIRECT_RESERVED_REFERENCE;
206 ATOMIC_INC(&tab->count);
207 release_itable_buckets();
208
209 return h->handle;
210 } else
211 { release_itable_buckets();
212 return 0;
213 }
214 }
215 }
216
217
218 static int
bump_ref(indirect * h,unsigned int refs)219 bump_ref(indirect *h, unsigned int refs)
220 { for(;;)
221 { if ( COMPARE_AND_SWAP_UINT(&h->references, refs, refs+1) )
222 { return TRUE;
223 } else
224 { refs = h->references;
225 if ( !INDIRECT_IS_VALID(refs) )
226 return FALSE;
227 }
228 }
229 }
230
231
232 static void
allocate_indirect_block(indirect_table * tab,int idx)233 allocate_indirect_block(indirect_table *tab, int idx)
234 { simpleMutexLock(&tab->mutex);
235 if ( !tab->array.blocks[idx] )
236 { size_t bs = (size_t)1<<idx;
237 indirect *newblock;
238
239 if ( !(newblock=PL_malloc(bs*sizeof(*newblock))) )
240 outOfCore();
241
242 memset(newblock, 0, bs*sizeof(*newblock));
243 tab->array.blocks[idx] = newblock-bs;
244 }
245 simpleMutexUnlock(&tab->mutex);
246 }
247
248
249 static indirect *
reserve_indirect(indirect_table * tab,word val ARG_LD)250 reserve_indirect(indirect_table *tab, word val ARG_LD)
251 { size_t index;
252 int i;
253 int last = FALSE;
254
255 for(index=tab->no_hole_before, i=MSB(index); !last; i++)
256 { size_t upto = (size_t)2<<i;
257 indirect *b = tab->array.blocks[i];
258
259 if ( upto >= tab->highest )
260 { upto = tab->highest;
261 last = TRUE;
262 }
263
264 for(; index<upto; index++)
265 { indirect *a = b + index;
266 unsigned int refs = a->references;
267
268 if ( INDIRECT_IS_FREE(refs) &&
269 COMPARE_AND_SWAP_UINT(&a->references, refs, INDIRECT_RESERVED_REFERENCE) )
270 { tab->no_hole_before = index+1;
271 return create_indirect(a, index, val PASS_LD);
272 }
273 }
274 }
275 tab->no_hole_before = tab->highest;
276
277 for(;;)
278 { int idx;
279 indirect *a;
280 unsigned int refs;
281
282 index = tab->highest;
283 idx = MSB(index);
284
285 if ( !tab->array.blocks[idx] )
286 allocate_indirect_block(tab, idx);
287
288 a = &tab->array.blocks[idx][index];
289 refs = a->references;
290
291 if ( INDIRECT_IS_FREE(refs) &&
292 COMPARE_AND_SWAP_UINT(&a->references, refs, INDIRECT_RESERVED_REFERENCE) )
293 { ATOMIC_INC(&tab->highest);
294 return create_indirect(a, index, val PASS_LD);
295 }
296 }
297 }
298
299
300 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
301 Ideally, we use a different storage mask, so we can distinguish interned
302 and normal indirects. STG_STATIC however is an alias for STG_INLINE, so
303 we cannot distinguish inlined integers from bignums and MPZ integers.
304 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
305
306 static indirect *
create_indirect(indirect * h,size_t index,word val ARG_LD)307 create_indirect(indirect *h, size_t index, word val ARG_LD)
308 { Word idata = addressIndirect(val); /* points at header */
309 size_t isize = wsizeofInd(*idata); /* include header */
310
311 h->handle = (index<<LMASK_BITS)|tag(val)|STG_GLOBAL; /* (*) */
312 h->header = idata[0];
313 h->data = PL_malloc(isize*sizeof(word));
314 memcpy(h->data, &idata[1], isize*sizeof(word));
315
316 return h;
317 }
318
319
320 static void
rehash_indirect_table(indirect_table * tab)321 rehash_indirect_table(indirect_table *tab)
322 { if ( TIGHT(tab->table, tab) )
323 { indirect_buckets *oldtab = tab->table;
324 indirect_buckets *newtab = PL_malloc(sizeof(*newtab));
325 unsigned int mask;
326 size_t index;
327 int i, last=FALSE;
328
329 newtab->size = oldtab->size * 2;
330 newtab->buckets = PL_malloc(newtab->size*sizeof(*newtab->buckets));
331 memset(newtab->buckets, 0, newtab->size*sizeof(*newtab->buckets));
332 newtab->prev = oldtab;
333
334 mask = newtab->size - 1;
335 for(index=1, i=0; !last; i++)
336 { size_t upto = (size_t)2<<i;
337 indirect *b = tab->array.blocks[i];
338
339 if ( upto >= tab->highest )
340 { upto = tab->highest;
341 last = TRUE;
342 }
343
344 for(; index<upto; index++)
345 { indirect *a = b+index;
346
347 if ( INDIRECT_IS_VALID(a->references) )
348 { size_t sz = wsizeofInd(a->header);
349 unsigned int v;
350
351 v = MurmurHashAligned2(a->data, sz*sizeof(word), MURMUR_SEED) & mask;
352 a->next = newtab->buckets[v];
353 newtab->buckets[v] = a;
354 }
355 }
356 }
357
358 tab->table = newtab;
359 }
360 }
361
362
363 word
extern_indirect(indirect_table * tab,word val,Word * gp ARG_LD)364 extern_indirect(indirect_table *tab, word val, Word *gp ARG_LD)
365 { size_t index = val>>LMASK_BITS;
366 int idx = MSB(index);
367 indirect *h = &tab->array.blocks[idx][index];
368 size_t wsize = wsizeofInd(h->header);
369 Word p, r;
370
371 if ( !hasGlobalSpace(wsize+2) )
372 { int rc;
373
374 if ( (rc=ensureGlobalSpace(wsize+2, ALLOW_GC)) != TRUE )
375 { raiseStackOverflow(rc);
376 return 0;
377 }
378 }
379
380 if ( gp )
381 r = p = *gp;
382 else
383 r = p = gTop;
384 *p++ = h->header;
385 memcpy(p, h->data, wsize*sizeof(word));
386 p += wsize;
387 *p++ = h->header;
388
389 if ( gp )
390 *gp = p;
391 else
392 gTop = p;
393
394 return consPtr(r, tag(val)|STG_GLOBAL);
395 }
396
397
398 word
extern_indirect_no_shift(indirect_table * tab,word val ARG_LD)399 extern_indirect_no_shift(indirect_table *tab, word val ARG_LD)
400 { size_t index = val>>LMASK_BITS;
401 int idx = MSB(index);
402 indirect *h = &tab->array.blocks[idx][index];
403 size_t wsize = wsizeofInd(h->header);
404 Word p;
405
406 if ( (p=allocGlobalNoShift(wsize+2)) )
407 { Word r = p;
408
409 *p++ = h->header;
410 memcpy(p, h->data, wsize*sizeof(word));
411 p += wsize;
412 *p++ = h->header;
413
414 return consPtr(r, tag(val)|STG_GLOBAL);
415 } else
416 return 0;
417 }
418
419
420 size_t
gsize_indirect(indirect_table * tab,word val)421 gsize_indirect(indirect_table *tab, word val)
422 { size_t index = val>>LMASK_BITS;
423 int idx = MSB(index);
424 indirect *h = &tab->array.blocks[idx][index];
425 size_t wsize = wsizeofInd(h->header);
426
427 return wsize+2;
428 }
429