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
26 #include "libguile/_scm.h"
27 #include "libguile/vectors.h"
28 #include "libguile/lang.h"
29 #include "libguile/hashtab.h"
31 #include "libguile/validate.h"
32 #include "libguile/weaks.h"
36 /* 1. The current hash table implementation in hashtab.c uses weak alist
37 * vectors (formerly called weak hash tables) internally.
39 * 2. All hash table operations still work on alist vectors.
41 * 3. The weak vector and alist vector Scheme API is accessed through
42 * the module (ice-9 weak-vector).
50 SCM_DEFINE (scm_make_weak_vector, "make-weak-vector", 1, 1, 0,
52 "Return a weak vector with @var{size} elements. If the optional\n"
53 "argument @var{fill} is given, all entries in the vector will be\n"
54 "set to @var{fill}. The default value for @var{fill} is the\n"
56 #define FUNC_NAME s_scm_make_weak_vector
58 return scm_i_allocate_weak_vector (0, size, fill);
63 SCM_REGISTER_PROC(s_list_to_weak_vector, "list->weak-vector", 1, 0, 0, scm_weak_vector);
65 SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1,
67 "@deffnx {Scheme Procedure} list->weak-vector l\n"
68 "Construct a weak vector from a list: @code{weak-vector} uses\n"
69 "the list of its arguments while @code{list->weak-vector} uses\n"
70 "its only argument @var{l} (a list) to construct a weak vector\n"
71 "the same way @code{list->vector} would.")
72 #define FUNC_NAME s_scm_weak_vector
74 scm_t_array_handle handle;
79 SCM_ASSERT (i >= 0, l, SCM_ARG1, FUNC_NAME);
81 res = scm_make_weak_vector (scm_from_int (i), SCM_UNSPECIFIED);
82 data = scm_vector_writable_elements (res, &handle, NULL, NULL);
84 while (scm_is_pair (l) && i > 0)
86 *data++ = SCM_CAR (l);
91 scm_array_handle_release (&handle);
98 SCM_DEFINE (scm_weak_vector_p, "weak-vector?", 1, 0, 0,
100 "Return @code{#t} if @var{obj} is a weak vector. Note that all\n"
101 "weak hashes are also weak vectors.")
102 #define FUNC_NAME s_scm_weak_vector_p
104 return scm_from_bool (SCM_I_WVECTP (obj) && !SCM_IS_WHVEC (obj));
110 SCM_DEFINE (scm_make_weak_key_alist_vector, "make-weak-key-alist-vector", 0, 1, 0,
112 "@deffnx {Scheme Procedure} make-weak-value-alist-vector size\n"
113 "@deffnx {Scheme Procedure} make-doubly-weak-alist-vector size\n"
114 "Return a weak hash table with @var{size} buckets. As with any\n"
115 "hash table, choosing a good size for the table requires some\n"
118 "You can modify weak hash tables in exactly the same way you\n"
119 "would modify regular hash tables. (@pxref{Hash Tables})")
120 #define FUNC_NAME s_scm_make_weak_key_alist_vector
122 return scm_i_allocate_weak_vector
123 (1, SCM_UNBNDP (size) ? scm_from_int (31) : size, SCM_EOL);
128 SCM_DEFINE (scm_make_weak_value_alist_vector, "make-weak-value-alist-vector", 0, 1, 0,
130 "Return a hash table with weak values with @var{size} buckets.\n"
131 "(@pxref{Hash Tables})")
132 #define FUNC_NAME s_scm_make_weak_value_alist_vector
134 return scm_i_allocate_weak_vector
135 (2, SCM_UNBNDP (size) ? scm_from_int (31) : size, SCM_EOL);
140 SCM_DEFINE (scm_make_doubly_weak_alist_vector, "make-doubly-weak-alist-vector", 1, 0, 0,
142 "Return a hash table with weak keys and values with @var{size}\n"
143 "buckets. (@pxref{Hash Tables})")
144 #define FUNC_NAME s_scm_make_doubly_weak_alist_vector
146 return scm_i_allocate_weak_vector
147 (3, SCM_UNBNDP (size) ? scm_from_int (31) : size, SCM_EOL);
152 SCM_DEFINE (scm_weak_key_alist_vector_p, "weak-key-alist-vector?", 1, 0, 0,
154 "@deffnx {Scheme Procedure} weak-value-alist-vector? obj\n"
155 "@deffnx {Scheme Procedure} doubly-weak-alist-vector? obj\n"
156 "Return @code{#t} if @var{obj} is the specified weak hash\n"
157 "table. Note that a doubly weak hash table is neither a weak key\n"
158 "nor a weak value hash table.")
159 #define FUNC_NAME s_scm_weak_key_alist_vector_p
161 return scm_from_bool (SCM_I_WVECTP (obj) && SCM_IS_WHVEC (obj));
166 SCM_DEFINE (scm_weak_value_alist_vector_p, "weak-value-alist-vector?", 1, 0, 0,
168 "Return @code{#t} if @var{obj} is a weak value hash table.")
169 #define FUNC_NAME s_scm_weak_value_alist_vector_p
171 return scm_from_bool (SCM_I_WVECTP (obj) && SCM_IS_WHVEC_V (obj));
176 SCM_DEFINE (scm_doubly_weak_alist_vector_p, "doubly-weak-alist-vector?", 1, 0, 0,
178 "Return @code{#t} if @var{obj} is a doubly weak hash table.")
179 #define FUNC_NAME s_scm_doubly_weak_alist_vector_p
181 return scm_from_bool (SCM_I_WVECTP (obj) && SCM_IS_WHVEC_B (obj));
185 #define UNMARKED_CELL_P(x) (SCM_NIMP(x) && !SCM_GC_MARK_P (x))
187 static SCM weak_vectors;
190 scm_i_init_weak_vectors_for_gc ()
192 weak_vectors = SCM_EOL;
196 scm_i_mark_weak_vector (SCM w)
198 SCM_I_SET_WVECT_GC_CHAIN (w, weak_vectors);
203 scm_i_mark_weak_vector_non_weaks (SCM w)
207 if (SCM_IS_WHVEC_ANY (w))
210 long n = SCM_I_WVECT_LENGTH (w);
212 int weak_keys = SCM_IS_WHVEC (w) || SCM_IS_WHVEC_B (w);
213 int weak_values = SCM_IS_WHVEC_V (w) || SCM_IS_WHVEC_B (w);
215 ptr = SCM_I_WVECT_GC_WVELTS (w);
217 for (j = 0; j < n; ++j)
219 SCM alist, slow_alist;
222 /* We do not set the mark bits of the alist spine cells here
223 since we do not want to ever create the situation where a
224 marked cell references an unmarked cell (except in
225 scm_gc_mark, where the referenced cells will be marked
226 immediately). Thus, we can not use mark bits to stop us
227 from looping indefinitely over a cyclic alist. Instead,
228 we use the standard tortoise and hare trick to catch
229 cycles. The fast walker does the work, and stops when it
230 catches the slow walker to ensure that the whole cycle
234 alist = slow_alist = ptr[j];
236 while (scm_is_pair (alist))
238 SCM elt = SCM_CAR (alist);
240 if (UNMARKED_CELL_P (elt))
242 if (scm_is_pair (elt))
244 SCM key = SCM_CAR (elt);
245 SCM value = SCM_CDR (elt);
247 if (!((weak_keys && UNMARKED_CELL_P (key))
248 || (weak_values && UNMARKED_CELL_P (value))))
250 /* The item should be kept. We need to mark it
259 /* A non-pair cell element. This should not
260 appear in a real alist, but when it does, we
268 alist = SCM_CDR (alist);
270 if (slow_toggle && scm_is_pair (slow_alist))
272 slow_alist = SCM_CDR (slow_alist);
273 slow_toggle = !slow_toggle;
274 if (scm_is_eq (slow_alist, alist))
278 if (!scm_is_pair (alist))
287 scm_i_mark_weak_vectors_non_weaks ()
290 SCM w = weak_vectors;
291 while (!scm_is_null (w))
293 if (scm_i_mark_weak_vector_non_weaks (w))
295 w = SCM_I_WVECT_GC_CHAIN (w);
301 scm_i_remove_weaks (SCM w)
303 SCM *ptr = SCM_I_WVECT_GC_WVELTS (w);
304 size_t n = SCM_I_WVECT_LENGTH (w);
307 if (!SCM_IS_WHVEC_ANY (w))
309 for (i = 0; i < n; ++i)
310 if (UNMARKED_CELL_P (ptr[i]))
317 for (i = 0; i < n; ++i)
323 while (scm_is_pair (alist) && !SCM_GC_MARK_P (alist))
325 if (UNMARKED_CELL_P (SCM_CAR (alist)))
327 *fixup = SCM_CDR (alist);
332 SCM_SET_GC_MARK (alist);
333 fixup = SCM_CDRLOC (alist);
340 fprintf (stderr, "vector %p, delta %d\n", w, delta);
342 SCM_I_SET_WVECT_DELTA (w, delta);
347 scm_i_remove_weaks_from_weak_vectors ()
349 SCM w = weak_vectors;
350 while (!scm_is_null (w))
352 scm_i_remove_weaks (w);
353 w = SCM_I_WVECT_GC_CHAIN (w);
360 scm_init_weaks_builtins ()
362 #include "libguile/weaks.x"
363 return SCM_UNSPECIFIED;
369 scm_c_define_gsubr ("%init-weaks-builtins", 0, 0, 0,
370 scm_init_weaks_builtins);