1 /* Copyright (C) 1995,1996,1998,2000,2001, 2003, 2006, 2008 Free Software Foundation, Inc.
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public
5 * License as published by the Free Software Foundation; either
6 * version 2.1 of the License, or (at your option) any later version.
8 * This library is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
23 #include "libguile/_scm.h"
24 #include "libguile/vectors.h"
25 #include "libguile/lang.h"
26 #include "libguile/hashtab.h"
28 #include "libguile/validate.h"
29 #include "libguile/weaks.h"
33 /* 1. The current hash table implementation in hashtab.c uses weak alist
34 * vectors (formerly called weak hash tables) internally.
36 * 2. All hash table operations still work on alist vectors.
38 * 3. The weak vector and alist vector Scheme API is accessed through
39 * the module (ice-9 weak-vector).
47 SCM_DEFINE (scm_make_weak_vector
, "make-weak-vector", 1, 1, 0,
49 "Return a weak vector with @var{size} elements. If the optional\n"
50 "argument @var{fill} is given, all entries in the vector will be\n"
51 "set to @var{fill}. The default value for @var{fill} is the\n"
53 #define FUNC_NAME s_scm_make_weak_vector
55 return scm_i_allocate_weak_vector (0, size
, fill
);
60 SCM_REGISTER_PROC(s_list_to_weak_vector
, "list->weak-vector", 1, 0, 0, scm_weak_vector
);
62 SCM_DEFINE (scm_weak_vector
, "weak-vector", 0, 0, 1,
64 "@deffnx {Scheme Procedure} list->weak-vector l\n"
65 "Construct a weak vector from a list: @code{weak-vector} uses\n"
66 "the list of its arguments while @code{list->weak-vector} uses\n"
67 "its only argument @var{l} (a list) to construct a weak vector\n"
68 "the same way @code{list->vector} would.")
69 #define FUNC_NAME s_scm_weak_vector
71 scm_t_array_handle handle
;
76 SCM_ASSERT (i
>= 0, l
, SCM_ARG1
, FUNC_NAME
);
78 res
= scm_make_weak_vector (scm_from_int (i
), SCM_UNSPECIFIED
);
79 data
= scm_vector_writable_elements (res
, &handle
, NULL
, NULL
);
81 while (scm_is_pair (l
) && i
> 0)
83 *data
++ = SCM_CAR (l
);
88 scm_array_handle_release (&handle
);
95 SCM_DEFINE (scm_weak_vector_p
, "weak-vector?", 1, 0, 0,
97 "Return @code{#t} if @var{obj} is a weak vector. Note that all\n"
98 "weak hashes are also weak vectors.")
99 #define FUNC_NAME s_scm_weak_vector_p
101 return scm_from_bool (SCM_I_WVECTP (obj
) && !SCM_IS_WHVEC (obj
));
107 SCM_DEFINE (scm_make_weak_key_alist_vector
, "make-weak-key-alist-vector", 0, 1, 0,
109 "@deffnx {Scheme Procedure} make-weak-value-alist-vector size\n"
110 "@deffnx {Scheme Procedure} make-doubly-weak-alist-vector size\n"
111 "Return a weak hash table with @var{size} buckets. As with any\n"
112 "hash table, choosing a good size for the table requires some\n"
115 "You can modify weak hash tables in exactly the same way you\n"
116 "would modify regular hash tables. (@pxref{Hash Tables})")
117 #define FUNC_NAME s_scm_make_weak_key_alist_vector
119 return scm_i_allocate_weak_vector
120 (1, SCM_UNBNDP (size
) ? scm_from_int (31) : size
, SCM_EOL
);
125 SCM_DEFINE (scm_make_weak_value_alist_vector
, "make-weak-value-alist-vector", 0, 1, 0,
127 "Return a hash table with weak values with @var{size} buckets.\n"
128 "(@pxref{Hash Tables})")
129 #define FUNC_NAME s_scm_make_weak_value_alist_vector
131 return scm_i_allocate_weak_vector
132 (2, SCM_UNBNDP (size
) ? scm_from_int (31) : size
, SCM_EOL
);
137 SCM_DEFINE (scm_make_doubly_weak_alist_vector
, "make-doubly-weak-alist-vector", 1, 0, 0,
139 "Return a hash table with weak keys and values with @var{size}\n"
140 "buckets. (@pxref{Hash Tables})")
141 #define FUNC_NAME s_scm_make_doubly_weak_alist_vector
143 return scm_i_allocate_weak_vector
144 (3, SCM_UNBNDP (size
) ? scm_from_int (31) : size
, SCM_EOL
);
149 SCM_DEFINE (scm_weak_key_alist_vector_p
, "weak-key-alist-vector?", 1, 0, 0,
151 "@deffnx {Scheme Procedure} weak-value-alist-vector? obj\n"
152 "@deffnx {Scheme Procedure} doubly-weak-alist-vector? obj\n"
153 "Return @code{#t} if @var{obj} is the specified weak hash\n"
154 "table. Note that a doubly weak hash table is neither a weak key\n"
155 "nor a weak value hash table.")
156 #define FUNC_NAME s_scm_weak_key_alist_vector_p
158 return scm_from_bool (SCM_I_WVECTP (obj
) && SCM_IS_WHVEC (obj
));
163 SCM_DEFINE (scm_weak_value_alist_vector_p
, "weak-value-alist-vector?", 1, 0, 0,
165 "Return @code{#t} if @var{obj} is a weak value hash table.")
166 #define FUNC_NAME s_scm_weak_value_alist_vector_p
168 return scm_from_bool (SCM_I_WVECTP (obj
) && SCM_IS_WHVEC_V (obj
));
173 SCM_DEFINE (scm_doubly_weak_alist_vector_p
, "doubly-weak-alist-vector?", 1, 0, 0,
175 "Return @code{#t} if @var{obj} is a doubly weak hash table.")
176 #define FUNC_NAME s_scm_doubly_weak_alist_vector_p
178 return scm_from_bool (SCM_I_WVECTP (obj
) && SCM_IS_WHVEC_B (obj
));
182 #define UNMARKED_CELL_P(x) (SCM_NIMP(x) && !SCM_GC_MARK_P (x))
184 static SCM weak_vectors
;
187 scm_i_init_weak_vectors_for_gc ()
189 weak_vectors
= SCM_EOL
;
193 scm_i_mark_weak_vector (SCM w
)
195 SCM_I_SET_WVECT_GC_CHAIN (w
, weak_vectors
);
200 scm_i_mark_weak_vector_non_weaks (SCM w
)
204 if (SCM_IS_WHVEC_ANY (w
))
207 long n
= SCM_I_WVECT_LENGTH (w
);
209 int weak_keys
= SCM_IS_WHVEC (w
) || SCM_IS_WHVEC_B (w
);
210 int weak_values
= SCM_IS_WHVEC_V (w
) || SCM_IS_WHVEC_B (w
);
212 ptr
= SCM_I_WVECT_GC_WVELTS (w
);
214 for (j
= 0; j
< n
; ++j
)
216 SCM alist
, slow_alist
;
219 /* We do not set the mark bits of the alist spine cells here
220 since we do not want to ever create the situation where a
221 marked cell references an unmarked cell (except in
222 scm_gc_mark, where the referenced cells will be marked
223 immediately). Thus, we can not use mark bits to stop us
224 from looping indefinitely over a cyclic alist. Instead,
225 we use the standard tortoise and hare trick to catch
226 cycles. The fast walker does the work, and stops when it
227 catches the slow walker to ensure that the whole cycle
231 alist
= slow_alist
= ptr
[j
];
233 while (scm_is_pair (alist
))
235 SCM elt
= SCM_CAR (alist
);
237 if (UNMARKED_CELL_P (elt
))
239 if (scm_is_pair (elt
))
241 SCM key
= SCM_CAR (elt
);
242 SCM value
= SCM_CDR (elt
);
244 if (!((weak_keys
&& UNMARKED_CELL_P (key
))
245 || (weak_values
&& UNMARKED_CELL_P (value
))))
247 /* The item should be kept. We need to mark it
256 /* A non-pair cell element. This should not
257 appear in a real alist, but when it does, we
265 alist
= SCM_CDR (alist
);
267 if (slow_toggle
&& scm_is_pair (slow_alist
))
269 slow_alist
= SCM_CDR (slow_alist
);
270 slow_toggle
= !slow_toggle
;
271 if (scm_is_eq (slow_alist
, alist
))
275 if (!scm_is_pair (alist
))
284 scm_i_mark_weak_vectors_non_weaks ()
287 SCM w
= weak_vectors
;
288 while (!scm_is_null (w
))
290 if (scm_i_mark_weak_vector_non_weaks (w
))
292 w
= SCM_I_WVECT_GC_CHAIN (w
);
298 scm_i_remove_weaks (SCM w
)
300 SCM
*ptr
= SCM_I_WVECT_GC_WVELTS (w
);
301 size_t n
= SCM_I_WVECT_LENGTH (w
);
304 if (!SCM_IS_WHVEC_ANY (w
))
306 for (i
= 0; i
< n
; ++i
)
307 if (UNMARKED_CELL_P (ptr
[i
]))
314 for (i
= 0; i
< n
; ++i
)
320 while (scm_is_pair (alist
) && !SCM_GC_MARK_P (alist
))
322 if (UNMARKED_CELL_P (SCM_CAR (alist
)))
324 *fixup
= SCM_CDR (alist
);
329 SCM_SET_GC_MARK (alist
);
330 fixup
= SCM_CDRLOC (alist
);
337 fprintf (stderr
, "vector %p, delta %d\n", w
, delta
);
339 SCM_I_SET_WVECT_DELTA (w
, delta
);
344 scm_i_remove_weaks_from_weak_vectors ()
346 SCM w
= weak_vectors
;
347 while (!scm_is_null (w
))
349 scm_i_remove_weaks (w
);
350 w
= SCM_I_WVECT_GC_CHAIN (w
);
357 scm_init_weaks_builtins ()
359 #include "libguile/weaks.x"
360 return SCM_UNSPECIFIED
;
366 scm_c_define_gsubr ("%init-weaks-builtins", 0, 0, 0,
367 scm_init_weaks_builtins
);