1 /* weak.c -*- mode:c; coding:utf-8; -*-
2 *
3 * Copyright (c) 2010-2021 Takashi Kato <ktakashi@ymail.com>
4 *
5 * Redistribution and use in source and binary forms, with or without
6 * modification, are permitted provided that the following conditions
7 * are met:
8 *
9 * 1. Redistributions of source code must retain the above copyright
10 * notice, this list of conditions and the following disclaimer.
11 *
12 * 2. Redistributions in binary form must reproduce the above copyright
13 * notice, this list of conditions and the following disclaimer in the
14 * documentation and/or other materials provided with the distribution.
15 *
16 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
17 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
18 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
19 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
20 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
21 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
22 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
23 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
24 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
25 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
26 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 *
28 * $Id: $
29 */
30 #define LIBSAGITTARIUS_BODY
31 #include "sagittarius/private/weak.h"
32 #include "sagittarius/private/collection.h"
33 #include "sagittarius/private/core.h"
34 #include "sagittarius/private/error.h"
35 #include "sagittarius/private/pair.h"
36 #include "sagittarius/private/port.h"
37 #include "sagittarius/private/string.h"
38 #include "sagittarius/private/writer.h"
39
wvector_print(SgObject obj,SgPort * port,SgWriteContext * ctx)40 static void wvector_print(SgObject obj, SgPort *port, SgWriteContext *ctx)
41 {
42 SgWeakVector *wvec = SG_WEAK_VECTOR(obj);
43 long size = wvec->size, i;
44 Sg_Putuz(port, UC("#<weak-vector"));
45 for (i = 0; i < size; i++) {
46 Sg_Putc(port, ' ');
47 Sg_Write(Sg_WeakVectorRef(wvec, i, SG_FALSE), port, ctx->mode);
48 }
49 Sg_Putc(port, '>');
50 }
51
52 SG_DEFINE_BUILTIN_CLASS(Sg_WeakVectorClass, wvector_print, NULL, NULL, NULL,
53 SG_CLASS_SEQUENCE_CPL);
54
whash_print(SgObject obj,SgPort * port,SgWriteContext * ctx)55 static void whash_print(SgObject obj, SgPort *port, SgWriteContext *ctx)
56 {
57 /* dummy */
58 Sg_Putuz(port, UC("#<weak-hashtable>"));
59 }
60
61 static SgClass *weak_hashtable_cpl[] = {
62 SG_CLASS_HASHTABLE,
63 SG_CLASS_DICTIONARY,
64 SG_CLASS_COLLECTION,
65 SG_CLASS_TOP,
66 NULL,
67 };
68
69 SG_DEFINE_BUILTIN_CLASS(Sg_WeakHashTableClass, whash_print, NULL, NULL, NULL,
70 weak_hashtable_cpl);
71
72
weakvector_finalize(SgObject obj,void * data)73 static void weakvector_finalize(SgObject obj, void *data)
74 {
75 int i;
76 SgWeakVector *v = SG_WEAK_VECTOR(obj);
77 SgObject *p = (SgObject*)v->pointers;
78 for (i = 0; i < v->size; i++) {
79 if (p[i] == NULL || SG_PTRP(p[i])) {
80 Sg_UnregisterDisappearingLink((void **)&p[i]);
81 }
82 p[i] = SG_FALSE;
83 }
84 }
85
Sg_MakeWeakVector(long size)86 SgObject Sg_MakeWeakVector(long size)
87 {
88 long i;
89 SgObject *p;
90 SgWeakVector *v = SG_NEW(SgWeakVector);
91
92 SG_SET_CLASS(v, SG_CLASS_WEAK_VECTOR);
93 v->size = size;
94 /* Allocate pointer array by ATOMIC, so that GC won't trace the
95 pointers in it.
96 */
97 p = SG_NEW_ATOMIC2(SgObject *, size * sizeof(SgObject));
98 for (i = 0; i < size; i++) p[i] = SG_FALSE;
99 v->pointers = (void*)p;
100 Sg_RegisterFinalizer(SG_OBJ(v), weakvector_finalize, NULL);
101 return SG_OBJ(v);
102 }
103
Sg_WeakVectorRef(SgWeakVector * v,long index,SgObject fallback)104 SgObject Sg_WeakVectorRef(SgWeakVector *v, long index, SgObject fallback)
105 {
106 SgObject *p;
107 if (index < 0 || index >= v->size) {
108 if (SG_UNBOUNDP(fallback)) {
109 Sg_Error(UC("weak-vector-ref: argument out of range: %d"), index);
110 }
111 return fallback;
112 }
113 p = (SgObject*)v->pointers;
114 if (p[index] == NULL) {
115 if (SG_UNBOUNDP(fallback)) return SG_FALSE;
116 else return fallback;
117 } else {
118 return p[index];
119 }
120 }
121
Sg_WeakVectorSet(SgWeakVector * v,long index,SgObject value)122 SgObject Sg_WeakVectorSet(SgWeakVector *v, long index, SgObject value)
123 {
124 SgObject *p;
125 if (index < 0 || index >= v->size) {
126 Sg_Error(UC("weak-vector-set!: argument out of range: %d"), index);
127 }
128 p = (SgObject*)v->pointers;
129 /* unregister the location if it was registered before */
130 if (p[index] == NULL || SG_PTRP(p[index])) {
131 Sg_UnregisterDisappearingLink((void **)&p[index]);
132 }
133 p[index] = value;
134 /* register the location if the value is a heap object */
135 if (SG_PTRP(value)) {
136 Sg_RegisterDisappearingLink((void **)&p[index], (void *)value);
137 }
138 return SG_UNDEF;
139 }
140
141 /* weak box is a SgObject. but not public */
wbox_print(SgObject obj,SgPort * port,SgWriteContext * ctx)142 static void wbox_print(SgObject obj, SgPort *port, SgWriteContext *ctx)
143 {
144 SgWeakBox *wb = SG_WEAK_BOX(obj);
145 /* Don't even try to print ptr as if it's a Scheme object. There is
146 no guarantee!! */
147 Sg_Printf(port, UC("#<weak-box %p:%d>"), wb->ptr, wb->registered);
148 }
149
150 SG_DEFINE_BUILTIN_CLASS_SIMPLE(Sg_WeakBoxClass, wbox_print);
151
152
wbox_setvalue(SgWeakBox * wbox,void * value)153 static void wbox_setvalue(SgWeakBox *wbox, void *value)
154 {
155 void *base = Sg_GCBase(value);
156 wbox->ptr = value;
157 if (base != NULL) {
158 Sg_RegisterDisappearingLink((void *)&wbox->ptr, base);
159 wbox->registered = TRUE;
160 } else {
161 wbox->registered = FALSE;
162 }
163 }
164
Sg_MakeWeakBox(void * value)165 SgWeakBox* Sg_MakeWeakBox(void *value)
166 {
167 SgWeakBox *wbox = SG_NEW_ATOMIC(SgWeakBox);
168 SG_SET_CLASS(wbox, SG_CLASS_WEAK_BOX);
169 wbox_setvalue(wbox, value);
170 return wbox;
171 }
172
Sg_WeakBoxEmptyP(SgWeakBox * wbox)173 int Sg_WeakBoxEmptyP(SgWeakBox *wbox)
174 {
175 /* if the content is static allocated, then we can't return
176 empty. */
177 return (wbox->registered && wbox->ptr == NULL);
178 }
179
Sg_WeakBoxSet(SgWeakBox * wbox,void * value)180 void Sg_WeakBoxSet(SgWeakBox *wbox, void *value)
181 {
182 if (wbox->registered) {
183 Sg_UnregisterDisappearingLink((void *)&wbox->ptr);
184 wbox->registered = FALSE;
185 }
186 wbox_setvalue(wbox, value);
187 }
188
Sg_WeakBoxRef(SgWeakBox * wbox)189 void* Sg_WeakBoxRef(SgWeakBox *wbox)
190 {
191 return wbox->ptr;
192 }
193
194
195 #define MARK_GONE_ENTRY(ht, e) (ht->goneEntries++)
196
weak_key_hash(const SgHashCore * hc,intptr_t key)197 static SgHashVal weak_key_hash(const SgHashCore *hc, intptr_t key)
198 {
199 SgWeakHashTable *wh = SG_WEAK_HASHTABLE(hc->data);
200 SgWeakBox *box;
201 intptr_t realkey;
202
203 if (SG_WEAK_BOXP(key)) {
204 box = (SgWeakBox *)key;
205 if (Sg_WeakBoxEmptyP(box)) {
206 return 0;
207 }
208 realkey = (intptr_t)Sg_WeakBoxRef(box);
209 } else {
210 realkey = key;
211 }
212 return wh->hasher(hc, realkey);
213 }
214
weak_key_compare(const SgHashCore * hc,intptr_t key,intptr_t entryKey)215 static int weak_key_compare(const SgHashCore *hc, intptr_t key,
216 intptr_t entryKey)
217 {
218 SgWeakHashTable *wh = SG_WEAK_HASHTABLE(hc->data);
219 SgWeakBox *box;
220 intptr_t realkey, realentrykey;
221 if (SG_WEAK_BOXP(key)) {
222 box = (SgWeakBox *)key;
223 if (Sg_WeakBoxEmptyP(box)) return FALSE;
224 realkey = (intptr_t)Sg_WeakBoxRef(box);
225 } else {
226 realkey = key;
227 }
228 /* entry key must always be weak box */
229 box = (SgWeakBox *)entryKey;
230 realentrykey = (intptr_t)Sg_WeakBoxRef(box);
231 if (Sg_WeakBoxEmptyP(box)) {
232 return FALSE;
233 } else {
234 return wh->compare(hc, realkey, realentrykey);
235 }
236 }
237
238
239 /* Operations */
240 typedef struct gc_value_rec
241 {
242 SgWeakHashTable *table;
243 intptr_t key;
244 } gc_value_t;
245
246 static SgWeakHashTable * make_weak_hashtable(SgHashType type,
247 SgWeakness weakness,
248 SgObject defaultValue);
249 static void weak_hashtable_create_entry(SgHashCore *core, SgHashEntry *e);
250
weak_hashtable_ref(SgObject table,SgHashEntry * e,int flags)251 static SgObject weak_hashtable_ref(SgObject table, SgHashEntry *e, int flags)
252 {
253 if (SG_WEAK_HASHTABLE_WEAKNESS(table) & SG_WEAK_VALUE) {
254 /* get value first so that it won't be GCed */
255 void *val = Sg_WeakBoxRef((SgWeakBox*)e->value);
256 if (Sg_WeakBoxEmptyP((SgWeakBox*)e->value))
257 return SG_WEAK_HASHTABLE_DEFAULT_VALUE(table);
258 ASSERT(val != NULL);
259 return SG_OBJ(val);
260 } else {
261 return SG_HASH_ENTRY_VALUE(e);
262 }
263 }
264
265 static SgObject weak_hashtable_delete_rec(SgObject table, SgObject key);
266 /* ugly solution for managing entry count of weak hash table. */
key_finalizer(SgObject z,void * data)267 static void key_finalizer(SgObject z, void *data)
268 {
269 /* when key is gone, means the entry is gone.
270 so we want to decrease the entry count to avoid the unnecessary
271 rehash operation.
272 */
273 SgWeakHashTable *table = SG_WEAK_HASHTABLE(data);
274 SgObject e = weak_hashtable_delete_rec(table, z);
275 /* maybe we shouldn't support SG_WEAK_REMOVE_BOTH */
276 if (e && SG_UNBOUNDP(e)) {
277 if ((table->weakness & SG_WEAK_VALUE) &&
278 (table->weakness & SG_WEAK_REMOVE)) {
279 Sg_UnregisterFinalizer(e);
280 }
281 }
282 /* it's gone so decrease count manually... */
283 if (!e) {
284 SG_WEAK_HASHTABLE_CORE(data)->entryCount--;
285 }
286 }
287
value_finalizer(SgObject z,void * data)288 static void value_finalizer(SgObject z, void *data)
289 {
290 /* when key is gone, means the entry is gone.
291 so we want to decrease the entry count to avoid the unnecessary
292 rehash operation.
293 */
294 SgWeakHashTable *table = ((gc_value_t *)data)->table;
295 intptr_t key = ((gc_value_t *)data)->key;
296 SgObject e = NULL; /* dummy */
297 SgHashEntry *et = Sg_HashCoreSearch(SG_WEAK_HASHTABLE_CORE(table),
298 (intptr_t)key, SG_DICT_GET,
299 SG_HASH_NO_ERROR);
300
301 if (et) e = weak_hashtable_ref(table, et, 0);
302
303 /* ok, it's still there, so delete it */
304 if (SG_EQ(e, z)) {
305 e = weak_hashtable_delete_rec(table, SG_OBJ(key));
306 }
307
308 /* in case */
309 /* maybe we shouldn't support SG_WEAK_REMOVE_BOTH */
310 if (key && (table->weakness & SG_WEAK_KEY)) {
311 Sg_UnregisterFinalizer(SG_OBJ(key));
312 Sg_UnregisterDisappearingLink((void *)&((gc_value_t *)data)->key);
313 }
314 /* it's gone so decrease count manually... */
315 if (!e) {
316 SG_WEAK_HASHTABLE_CORE(data)->entryCount--;
317 }
318 #if 0
319 else {
320 Sg_Printf(Sg_StandardErrorPort(), UC("%x, %S, %S"), table,key,z);
321 fprintf(stderr, "[%p]\n", z);
322 #endif
323 }
324
325 static SgObject weak_hashtable_set(SgObject table,
326 SgHashEntry *e, SgObject value, int flags)
327 {
328 if (SG_WEAK_HASHTABLE_WEAKNESS(table) & SG_WEAK_VALUE) {
329 /* strip out weakbox if this is during copying */
330 if ((flags & SG_DICT_ON_COPY) && SG_WEAK_BOXP(value)) {
331 if (Sg_WeakBoxEmptyP(value)) {
332 value = SG_WEAK_HASHTABLE_DEFAULT_VALUE(table);
333 } else {
334 value = Sg_WeakBoxRef(value);
335 }
336 }
337
338 if (e->value && (flags & SG_HASH_NO_OVERWRITE)) {
339 void *val = Sg_WeakBoxRef((SgWeakBox *)e->value);
340 if (!Sg_WeakBoxEmptyP((SgWeakBox *)e->value)) {
341 return SG_OBJ(val);
342 }
343 }
344 if (SG_WEAK_HASHTABLE_WEAKNESS(table) & SG_WEAK_REMOVE) {
345 gc_value_t *data;
346 intptr_t key = e->key;
347 void *base;
348 if (SG_WEAK_BOXP(key)) {
349 key = (intptr_t)Sg_WeakBoxRef(SG_WEAK_BOX(key));
350 }
351 base = Sg_GCBase(SG_OBJ(key));
352 if (e->value) {
353 /* not sure if we need this */
354 void *val = Sg_WeakBoxRef((SgWeakBox *)e->value);
355 if (!Sg_WeakBoxEmptyP((SgWeakBox *)e->value)) {
356 Sg_UnregisterFinalizer(val);
357 }
358 }
359 data = SG_NEW(gc_value_t);
360 data->table = table;
361 data->key = key;
362 if (base) {
363 Sg_RegisterDisappearingLink((void *)&data->key, base);
364 }
365 Sg_RegisterFinalizer(value, value_finalizer, data);
366 }
367 if (e->value) {
368 Sg_WeakBoxSet((SgWeakBox *)e->value, value);
369 } else {
370 (void)SG_HASH_ENTRY_SET_VALUE(e, Sg_MakeWeakBox(value));
371 }
372 return value;
373 } else {
374 if (flags & SG_HASH_NO_OVERWRITE && e->value) {
375 return SG_HASH_ENTRY_VALUE(e);
376 }
377 return SG_HASH_ENTRY_SET_VALUE(e, value);
378 }
379 }
380
381 static SgObject weak_hashtable_delete_rec(SgObject table, SgObject key)
382 {
383 SgHashEntry *e = Sg_HashCoreSearch(SG_WEAK_HASHTABLE_CORE(table),
384 (intptr_t)key, SG_DICT_DELETE, 0);
385 if (e && e->value) {
386 if (SG_WEAK_HASHTABLE_WEAKNESS(table) & SG_WEAK_VALUE) {
387 void *val = Sg_WeakBoxRef((SgWeakBox*)e->value);
388 if (!Sg_WeakBoxEmptyP((SgWeakBox*)e->value))
389 return SG_OBJ(val);
390 else
391 return SG_UNBOUND;
392 } else {
393 return SG_HASH_ENTRY_VALUE(e);
394 }
395 } else {
396 return NULL;
397 }
398 }
399
400 static SgObject weak_hashtable_delete(SgObject table, SgObject key)
401 {
402 /* remove finalizer */
403 SgObject v;
404 if (SG_WEAK_HASHTABLE_WEAKNESS(table) & SG_WEAK_KEY) {
405 Sg_UnregisterFinalizer(key);
406 }
407 v = weak_hashtable_delete_rec(table, key);
408 if (v) {
409 /* remove value finalizer if there is.
410 NOTE: if it's gone, then it's removed anyway
411 */
412 if (!SG_UNBOUNDP(v)) {
413 if ((SG_WEAK_HASHTABLE_WEAKNESS(table) & SG_WEAK_VALUE) &&
414 (SG_WEAK_HASHTABLE_WEAKNESS(table) & SG_WEAK_REMOVE)) {
415 Sg_UnregisterFinalizer(v);
416 }
417 }
418 return v;
419 } else {
420 return SG_UNBOUND;
421 }
422 }
423
424 static SgObject weak_hashtable_copy(SgObject table, int mutableP)
425 {
426 SgWeakHashTable *src = SG_WEAK_HASHTABLE(table);
427 SgWeakHashTable *wh = make_weak_hashtable(SG_WEAK_HASHTABLE_TYPE(src),
428 src->weakness,
429 src->defaultValue);
430 wh->hasher = src->hasher;
431 wh->compare = src->compare;
432 /* FIXME maybe we should initialise the core? */
433 SG_WEAK_HASHTABLE_CORE(wh)->create_entry = weak_hashtable_create_entry;
434 Sg_HashCoreCopy(SG_HASHTABLE(wh), SG_HASHTABLE(src));
435 /* the data must be copied one */
436 SG_WEAK_HASHTABLE_CORE(wh)->data = wh;
437 SG_HASHTABLE_TYPE(wh) = SG_HASHTABLE_TYPE(src);
438 if (!mutableP) {
439 SG_HASHTABLE(wh)->immutablep = TRUE;
440 }
441 return SG_OBJ(wh);
442 }
443
444 extern SgHashEntry * hash_iter_next(SgHashIter *itr, SgObject *key,
445 SgObject *value);
446 static SgHashEntry * weak_hash_iter_next(SgHashIter *iter,
447 SgObject *key, SgObject *value)
448 {
449 SgWeakHashTable *wh = SG_WEAK_HASHTABLE(iter->table);
450 for (;;) {
451 SgHashEntry *e = hash_iter_next(iter, NULL, NULL);
452 if (e == NULL) return NULL;
453 if (wh->weakness & SG_WEAK_KEY) {
454 SgWeakBox *box = (SgWeakBox *)e->key;
455 SgObject realkey = SG_OBJ(Sg_WeakBoxRef(box));
456 if (Sg_WeakBoxEmptyP(box)) {
457 MARK_GONE_ENTRY(wh, e);
458 continue;
459 }
460 if (key) *key = realkey;
461 } else {
462 if (key) *key = (SgObject)e->key;
463 }
464 if (wh->weakness & SG_WEAK_VALUE) {
465 SgWeakBox *box = (SgWeakBox *)e->value;
466 SgObject realval = SG_OBJ(Sg_WeakBoxRef(box));
467 if (Sg_WeakBoxEmptyP(box)) {
468 if (value) *value = wh->defaultValue;
469 } else {
470 if (value) *value = realval;
471 }
472 } else {
473 if (value) *value = (SgObject)e->value;
474 }
475 /* rather useless but required...*/
476 return e;
477 }
478 }
479 /* avoid infinite loop */
480 extern void hash_iter_init(SgHashCore *core, SgHashIter *itr);
481 static void weak_hashtable_init_iter(SgObject table, SgHashIter *iter)
482 {
483 hash_iter_init(SG_WEAK_HASHTABLE_CORE(table), iter);
484 iter->table = table;
485 iter->iter_next = weak_hash_iter_next;
486 }
487
488
489 static SgHashOpTable weak_hashtable_operations = {
490 weak_hashtable_ref,
491 weak_hashtable_set,
492 weak_hashtable_delete,
493 weak_hashtable_copy,
494 weak_hashtable_init_iter,
495 };
496
497 static SgWeakHashTable * make_weak_hashtable(SgHashType type,
498 SgWeakness weakness,
499 SgObject defaultValue)
500 {
501 SgWeakHashTable *wh = SG_NEW(SgWeakHashTable);
502 SG_SET_CLASS(wh, SG_CLASS_WEAK_HASHTABLE);
503 wh->weakness = weakness;
504 SG_WEAK_HASHTABLE_TYPE(wh) = type;
505 wh->defaultValue = defaultValue;
506 SG_HASHTABLE_OPTABLE(wh) = &weak_hashtable_operations;
507 return wh;
508 }
509
510 static void weak_hashtable_create_entry(SgHashCore *core, SgHashEntry *e)
511 {
512 SgObject table = SG_OBJ(core->data);
513 if (SG_WEAK_HASHTABLE_WEAKNESS(table) & SG_WEAK_KEY) {
514 SgObject key = SG_OBJ(e->key);
515 e->key = (intptr_t)Sg_MakeWeakBox(key);
516 /* needed for managing entryCount... */
517 Sg_RegisterFinalizer(key, key_finalizer, table);
518 }
519 }
520
521 SgObject Sg_MakeWeakHashTableSimple(SgHashType type,
522 SgWeakness weakness,
523 long initSize,
524 SgObject defaultValue)
525 {
526 SgWeakHashTable *wh = make_weak_hashtable(type, weakness, defaultValue);
527
528 if (weakness & SG_WEAK_KEY) {
529 if (!Sg_HashCoreTypeToProcs(type, &wh->hasher, &wh->compare)) {
530 Sg_Error(UC("Sg_MakeWeakHashTableSimple: unsupported type: %d"), type);
531 }
532 /* wh->keyStore = Sg_MakeWeakVector(initSize); */
533 Sg_HashCoreInitGeneral(SG_WEAK_HASHTABLE_CORE(wh), weak_key_hash,
534 weak_key_compare, initSize, wh);
535 } else {
536 Sg_HashCoreInitSimple(SG_WEAK_HASHTABLE_CORE(wh), type, initSize, wh);
537 }
538 SG_WEAK_HASHTABLE_CORE(wh)->create_entry = weak_hashtable_create_entry;
539 return SG_OBJ(wh);
540 }
541
542 SgObject Sg_MakeWeakHashTable(SgObject hasher,
543 SgObject compare,
544 SgWeakness weakness,
545 long initSize,
546 SgObject defaultValue)
547 {
548 SgWeakHashTable *wh =
549 SG_WEAK_HASHTABLE(Sg_MakeWeakHashTableSimple(SG_HASH_GENERAL,
550 weakness,
551 initSize,
552 defaultValue));
553 SG_WEAK_HASHTABLE_CORE(wh)->generalHasher = hasher;
554 SG_WEAK_HASHTABLE_CORE(wh)->generalCompare = compare;
555 return wh;
556 }
557
558 SgObject Sg_WeakHashTableCopy(SgWeakHashTable *src)
559 {
560 return weak_hashtable_copy(src, TRUE);
561 }
562
563 SgObject Sg_WeakHashTableRef(SgWeakHashTable *table,
564 SgObject key, SgObject fallback)
565 {
566 SgHashEntry *e = Sg_HashCoreSearch(SG_WEAK_HASHTABLE_CORE(table),
567 (intptr_t)key, SG_DICT_GET, 0);
568 if (!e) return fallback;
569 return weak_hashtable_ref(table, e, 0);
570 }
571
572 SgObject Sg_WeakHashTableSet(SgWeakHashTable *table,
573 SgObject key, SgObject value, int flags)
574 {
575 SgHashEntry *e;
576
577 if (SG_IMMUTABLE_HASHTABLE_P(table)) {
578 Sg_Error(UC("attemp to modify immutable hashtable"));
579 return SG_UNDEF;
580 }
581 e = Sg_HashCoreSearch(SG_WEAK_HASHTABLE_CORE(table), (intptr_t)key,
582 (flags & SG_HASH_NO_CREATE)
583 ? SG_DICT_GET: SG_DICT_CREATE,
584 0);
585
586 if (!e) return SG_UNBOUND;
587 return weak_hashtable_set(table, e, value, flags);
588 }
589
590 SgObject Sg_WeakHashTableDelete(SgWeakHashTable *table,
591 SgObject key)
592 {
593 if (SG_IMMUTABLE_HASHTABLE_P(table)) {
594 Sg_Error(UC("attemp to modify immutable hashtable"));
595 return SG_UNDEF;
596 }
597 return weak_hashtable_delete(table, key);
598 }
599
600 SgObject Sg_WeakHashTableKeys(SgWeakHashTable *table)
601 {
602 SgWeakHashIter iter;
603 SgObject h = SG_NIL, t = SG_NIL, k, v;
604 Sg_WeakHashIterInit(&iter, table);
605 while (Sg_WeakHashIterNext(&iter, &k, &v)) {
606 SG_APPEND1(h, t, k);
607 }
608 return h;
609 }
610
611 SgObject Sg_WeakHashTableValues(SgWeakHashTable *table)
612 {
613 SgWeakHashIter iter;
614 SgObject h = SG_NIL, t = SG_NIL, k, v;
615 Sg_WeakHashIterInit(&iter, table);
616 while (Sg_WeakHashIterNext(&iter, &k, &v)) {
617 SG_APPEND1(h, t, v);
618 }
619 return h;
620 }
621
622
623 void Sg_WeakHashIterInit(SgWeakHashIter *iter,
624 SgWeakHashTable *table)
625 {
626 weak_hashtable_init_iter(table, iter);
627 }
628
629 int Sg_WeakHashIterNext(SgWeakHashIter *iter,
630 SgObject *key, SgObject *value)
631 {
632 return weak_hash_iter_next(iter, key, value) != NULL;
633 }
634
635 /* for GC friendliness */
636 int Sg_WeakHashTableShrink(SgWeakHashTable *table)
637 {
638 SgHashIter iter;
639 SgHashEntry *e = NULL;
640 int count = 0;
641 Sg_HashIterInit(table, &iter);
642 while ((e = Sg_HashIterNext(&iter, NULL, NULL)) != NULL) {
643 /* feeling like this is actually useless.
644 if the weak key is gone, how could we delete
645 the entry? */
646 if (table->weakness & SG_WEAK_KEY) {
647 SgWeakBox *box = (SgWeakBox *)e->key;
648 if (box && Sg_WeakBoxEmptyP(box)) {
649 Sg_WeakHashTableDelete(table, SG_OBJ(e->key));
650 count++;
651 continue;
652 }
653 }
654 if (table->weakness & SG_WEAK_VALUE) {
655 SgWeakBox *box = (SgWeakBox *)e->value;
656 if (box && Sg_WeakBoxEmptyP(box)) {
657 Sg_WeakHashTableDelete(table, SG_OBJ(e->key));
658 count++;
659 continue;
660 }
661 }
662 }
663 return count;
664 }
665