-DEFUN ("make-weak-hashtable", Fmake_weak_hashtable, 1, 2, 0, /*
-Return a new fully weak hashtable object of initial size SIZE.
-A weak hashtable is one whose pointers do not count as GC referents:
-for any key-value pair in the hashtable, if the only remaining pointer
-to either the key or the value is in a weak hash table, then the pair
-will be removed from the table, and the key and value collected. A
-non-weak hash table (or any other pointer) would prevent the object
-from being collected.
-
-You can also create semi-weak hashtables; see `make-key-weak-hashtable'
-and `make-value-weak-hashtable'.
-*/
- (size, test_fun))
-{
- CHECK_NATNUM (size);
- return make_lisp_hashtable (XINT (size), HASHTABLE_WEAK,
- decode_hashtable_test_fun (test_fun));
-}
-
-DEFUN ("make-key-weak-hashtable", Fmake_key_weak_hashtable, 1, 2, 0, /*
-Return a new key-weak hashtable object of initial size SIZE.
-A key-weak hashtable is similar to a fully-weak hashtable (see
-`make-weak-hashtable') except that a key-value pair will be removed
-only if the key remains unmarked outside of weak hashtables. The pair
-will remain in the hashtable if the key is pointed to by something other
-than a weak hashtable, even if the value is not.
-*/
- (size, test_fun))
-{
- CHECK_NATNUM (size);
- return make_lisp_hashtable (XINT (size), HASHTABLE_KEY_WEAK,
- decode_hashtable_test_fun (test_fun));
-}
-
-DEFUN ("make-value-weak-hashtable", Fmake_value_weak_hashtable, 1, 2, 0, /*
-Return a new value-weak hashtable object of initial size SIZE.
-A value-weak hashtable is similar to a fully-weak hashtable (see
-`make-weak-hashtable') except that a key-value pair will be removed only
-if the value remains unmarked outside of weak hashtables. The pair will
-remain in the hashtable if the value is pointed to by something other
-than a weak hashtable, even if the key is not.
-*/
- (size, test_fun))
-{
- CHECK_NATNUM (size);
- return make_lisp_hashtable (XINT (size), HASHTABLE_VALUE_WEAK,
- decode_hashtable_test_fun (test_fun));
-}
-
-struct marking_closure
-{
- int (*obj_marked_p) (Lisp_Object);
- void (*markobj) (Lisp_Object);
- enum hashtable_type type;
- int did_mark;
-};
-
-static int
-marking_mapper (CONST void *key, void *contents, void *closure)
-{
- Lisp_Object keytem, valuetem;
- struct marking_closure *fmh =
- (struct marking_closure *) closure;
-
- /* This function is called over each pair in the hashtable.
- We complete the marking for semi-weak hashtables. */
- CVOID_TO_LISP (keytem, key);
- CVOID_TO_LISP (valuetem, contents);
-
- switch (fmh->type)
- {
- case HASHTABLE_KEY_WEAK:
- if ((fmh->obj_marked_p) (keytem) &&
- !(fmh->obj_marked_p) (valuetem))
- {
- (fmh->markobj) (valuetem);
- fmh->did_mark = 1;
- }
- break;
-
- case HASHTABLE_VALUE_WEAK:
- if ((fmh->obj_marked_p) (valuetem) &&
- !(fmh->obj_marked_p) (keytem))
- {
- (fmh->markobj) (keytem);
- fmh->did_mark = 1;
- }
- break;
-
- case HASHTABLE_KEY_CAR_WEAK:
- if (!CONSP (keytem) || (fmh->obj_marked_p) (XCAR (keytem)))
- {
- if (!(fmh->obj_marked_p) (keytem))
- {
- (fmh->markobj) (keytem);
- fmh->did_mark = 1;
- }
- if (!(fmh->obj_marked_p) (valuetem))
- {
- (fmh->markobj) (valuetem);
- fmh->did_mark = 1;
- }
- }
- break;
-
- case HASHTABLE_VALUE_CAR_WEAK:
- if (!CONSP (valuetem) || (fmh->obj_marked_p) (XCAR (valuetem)))
- {
- if (!(fmh->obj_marked_p) (keytem))
- {
- (fmh->markobj) (keytem);
- fmh->did_mark = 1;
- }
- if (!(fmh->obj_marked_p) (valuetem))
- {
- (fmh->markobj) (valuetem);
- fmh->did_mark = 1;
- }
- }
- break;
-
- default:
- abort (); /* Huh? */
- }
-
- return 0;
-}
projects / chise / xemacs-chise.git.1 / blobdiff