Use thread-local allocation (significant perf. improvement!); added the `boehm-gc...
[bpt/guile.git] / libguile / weaks.c
CommitLineData
2b829bbb 1/* Copyright (C) 1995,1996,1998,2000,2001, 2003, 2006 Free Software Foundation, Inc.
0f2d19dd
JB
2 *
3 * This program is free software; you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation; either version 2, or (at your option)
6 * any later version.
7 *
8 * This program 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
11 * GNU General Public License for more details.
12 *
13 * You should have received a copy of the GNU General Public License
14 * along with this software; see the file COPYING. If not, write to
92205699
MV
15 * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
16 * Boston, MA 02110-1301 USA
0f2d19dd
JB
17 *
18 * As a special exception, Free Software Foundation gives permission
19 * for additional uses of the text contained in its release of this library.
20 *
21 * The exception is that, if you link this library with other files
22 * to produce an executable, this does not by itself cause the
23 * resulting executable to be covered by the GNU General Public License.
24 * Your use of that executable is in no way restricted on account of
25 * linking this library code into it.
26 *
27 * This exception does not however invalidate any other reasons why
28 * the executable file might be covered by the GNU General Public License.
29 *
30 * This exception applies only to the code released by
31 * Free Software Foundation as part of this library. If you copy
32 * code from other releases distributed under the terms of the GPL into a copy of
33 * this library, as the General Public License permits, the exception does
34 * not apply to the code that you add in this way. To avoid misleading
35 * anyone as to the status of such modified files, you must delete
36 * this exception notice from such code.
37 *
38 * If you write modifications of your own for this library, it is your choice
39 * whether to permit this exception to apply to your modifications.
82892bed 40 * If you do not wish that, delete this exception notice. */
1bbd0b84 41
1bbd0b84 42
0f2d19dd 43\f
592996c9 44
06c1d900
MV
45#include <stdio.h>
46
a0599745
MD
47#include "libguile/_scm.h"
48#include "libguile/vectors.h"
c96d76b8 49#include "libguile/lang.h"
f59a096e 50#include "libguile/hashtab.h"
0f2d19dd 51
a0599745
MD
52#include "libguile/validate.h"
53#include "libguile/weaks.h"
0f2d19dd 54
e7bca227 55#include "libguile/boehm-gc.h"
986ec822
LC
56#include <gc/gc_typed.h>
57
58
59\f
60/* Weak pairs for use in weak alist vectors and weak hash tables.
61
62 We have weal-car pairs, weak-cdr pairs, and doubly weak pairs. In weak
63 pairs, the weak component(s) are not scanned for pointers and are
64 registered as disapperaring links; therefore, the weak component may be
65 set to NULL by the garbage collector when no other reference to that word
66 exist. Thus, users should only access weak pairs via the
67 `SCM_WEAK_PAIR_C[AD]R ()' macros. See also `scm_fixup_weak_alist ()' in
68 `hashtab.c'. */
69
70/* Type descriptors for weak-c[ad]r pairs. */
71static GC_descr wcar_pair_descr, wcdr_pair_descr;
72
73
74SCM
75scm_weak_car_pair (SCM car, SCM cdr)
76{
77 scm_t_cell *cell;
78
79 cell = (scm_t_cell *)GC_malloc_explicitly_typed (sizeof (*cell),
80 wcar_pair_descr);
81
82 cell->word_0 = car;
83 cell->word_1 = cdr;
84
85 if (SCM_NIMP (car))
86 {
87 /* Weak car cells make sense iff the car is non-immediate. */
88 GC_GENERAL_REGISTER_DISAPPEARING_LINK ((GC_PTR)&cell->word_0,
89 (GC_PTR)SCM_UNPACK (car));
90 }
91
92 return (SCM_PACK (cell));
93}
94
95SCM
96scm_weak_cdr_pair (SCM car, SCM cdr)
97{
98 scm_t_cell *cell;
99
100 cell = (scm_t_cell *)GC_malloc_explicitly_typed (sizeof (*cell),
101 wcdr_pair_descr);
102
103 cell->word_0 = car;
104 cell->word_1 = cdr;
105
106 if (SCM_NIMP (cdr))
107 {
108 /* Weak cdr cells make sense iff the cdr is non-immediate. */
109 GC_GENERAL_REGISTER_DISAPPEARING_LINK ((GC_PTR)&cell->word_1,
110 (GC_PTR)SCM_UNPACK (cdr));
111 }
112
113 return (SCM_PACK (cell));
114}
115
116SCM
117scm_doubly_weak_pair (SCM car, SCM cdr)
118{
119 /* Doubly weak cells shall not be scanned at all for pointers. */
120 scm_t_cell *cell = (scm_t_cell *)scm_gc_malloc_pointerless (sizeof (*cell),
121 "weak cell");
122
123 cell->word_0 = car;
124 cell->word_1 = cdr;
125
126 if (SCM_NIMP (car))
127 {
128 GC_GENERAL_REGISTER_DISAPPEARING_LINK ((GC_PTR)&cell->word_0,
129 (GC_PTR)SCM_UNPACK (car));
130 }
131 if (SCM_NIMP (cdr))
132 {
133 GC_GENERAL_REGISTER_DISAPPEARING_LINK ((GC_PTR)&cell->word_1,
134 (GC_PTR)SCM_UNPACK (cdr));
135 }
136
137 return (SCM_PACK (cell));
138}
139
140
592996c9 141\f
0f2d19dd 142
c35738c1
MD
143/* 1. The current hash table implementation in hashtab.c uses weak alist
144 * vectors (formerly called weak hash tables) internally.
145 *
146 * 2. All hash table operations still work on alist vectors.
147 *
148 * 3. The weak vector and alist vector Scheme API is accessed through
149 * the module (ice-9 weak-vector).
150 */
151
152
0f2d19dd
JB
153/* {Weak Vectors}
154 */
155
156
3b3b36dd 157SCM_DEFINE (scm_make_weak_vector, "make-weak-vector", 1, 1, 0,
1e6808ea 158 (SCM size, SCM fill),
b380b885 159 "Return a weak vector with @var{size} elements. If the optional\n"
1e6808ea
MG
160 "argument @var{fill} is given, all entries in the vector will be\n"
161 "set to @var{fill}. The default value for @var{fill} is the\n"
162 "empty list.")
1bbd0b84 163#define FUNC_NAME s_scm_make_weak_vector
0f2d19dd 164{
d525e4f9 165 return scm_i_make_weak_vector (0, size, fill);
0f2d19dd 166}
1bbd0b84 167#undef FUNC_NAME
0f2d19dd
JB
168
169
1bbd0b84 170SCM_REGISTER_PROC(s_list_to_weak_vector, "list->weak-vector", 1, 0, 0, scm_weak_vector);
1cc91f1b 171
3b3b36dd 172SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1,
1bbd0b84 173 (SCM l),
8f85c0c6 174 "@deffnx {Scheme Procedure} list->weak-vector l\n"
1e6808ea
MG
175 "Construct a weak vector from a list: @code{weak-vector} uses\n"
176 "the list of its arguments while @code{list->weak-vector} uses\n"
177 "its only argument @var{l} (a list) to construct a weak vector\n"
178 "the same way @code{list->vector} would.")
1bbd0b84 179#define FUNC_NAME s_scm_weak_vector
0f2d19dd 180{
d525e4f9 181 return scm_i_make_weak_vector_from_list (0, l);
0f2d19dd 182}
1bbd0b84 183#undef FUNC_NAME
0f2d19dd
JB
184
185
3b3b36dd 186SCM_DEFINE (scm_weak_vector_p, "weak-vector?", 1, 0, 0,
1e6808ea 187 (SCM obj),
5352393c
MG
188 "Return @code{#t} if @var{obj} is a weak vector. Note that all\n"
189 "weak hashes are also weak vectors.")
1bbd0b84 190#define FUNC_NAME s_scm_weak_vector_p
0f2d19dd 191{
6e708ef2 192 return scm_from_bool (SCM_I_WVECTP (obj) && !SCM_IS_WHVEC (obj));
0f2d19dd 193}
1bbd0b84 194#undef FUNC_NAME
0f2d19dd 195
0f2d19dd 196\f
3a2de079
LC
197/* Weak alist vectors, i.e., vectors of alists.
198
199 The alist vector themselves are _not_ weak. The `car' (or `cdr', or both)
200 of the pairs within it are weak. See `hashtab.c' for details. */
0f2d19dd 201
4650cdd2
LC
202
203/* FIXME: We used to have two implementations of weak hash tables: the one in
204 here and the one in `hashtab.c'. The difference is that weak alist
205 vectors could be used as vectors while (weak) hash tables can't. We need
206 to unify that. */
207
c35738c1 208SCM_DEFINE (scm_make_weak_key_alist_vector, "make-weak-key-alist-vector", 0, 1, 0,
1e6808ea 209 (SCM size),
c35738c1
MD
210 "@deffnx {Scheme Procedure} make-weak-value-alist-vector size\n"
211 "@deffnx {Scheme Procedure} make-doubly-weak-alist-vector size\n"
1e6808ea
MG
212 "Return a weak hash table with @var{size} buckets. As with any\n"
213 "hash table, choosing a good size for the table requires some\n"
214 "caution.\n"
215 "\n"
216 "You can modify weak hash tables in exactly the same way you\n"
217 "would modify regular hash tables. (@pxref{Hash Tables})")
c35738c1 218#define FUNC_NAME s_scm_make_weak_key_alist_vector
0f2d19dd 219{
4650cdd2 220 return scm_make_weak_key_hash_table (size);
0f2d19dd 221}
1bbd0b84 222#undef FUNC_NAME
0f2d19dd
JB
223
224
c35738c1 225SCM_DEFINE (scm_make_weak_value_alist_vector, "make-weak-value-alist-vector", 0, 1, 0,
1e6808ea 226 (SCM size),
e3239868
DH
227 "Return a hash table with weak values with @var{size} buckets.\n"
228 "(@pxref{Hash Tables})")
c35738c1 229#define FUNC_NAME s_scm_make_weak_value_alist_vector
0f2d19dd 230{
4650cdd2 231 return scm_make_weak_value_hash_table (size);
0f2d19dd 232}
1bbd0b84 233#undef FUNC_NAME
0f2d19dd
JB
234
235
c35738c1 236SCM_DEFINE (scm_make_doubly_weak_alist_vector, "make-doubly-weak-alist-vector", 1, 0, 0,
1e6808ea 237 (SCM size),
e3239868
DH
238 "Return a hash table with weak keys and values with @var{size}\n"
239 "buckets. (@pxref{Hash Tables})")
c35738c1 240#define FUNC_NAME s_scm_make_doubly_weak_alist_vector
0f2d19dd 241{
b6ed39c4 242 return scm_make_doubly_weak_hash_table (size);
0f2d19dd 243}
1bbd0b84 244#undef FUNC_NAME
0f2d19dd 245
592996c9 246
c35738c1 247SCM_DEFINE (scm_weak_key_alist_vector_p, "weak-key-alist-vector?", 1, 0, 0,
1e6808ea 248 (SCM obj),
c35738c1
MD
249 "@deffnx {Scheme Procedure} weak-value-alist-vector? obj\n"
250 "@deffnx {Scheme Procedure} doubly-weak-alist-vector? obj\n"
5352393c
MG
251 "Return @code{#t} if @var{obj} is the specified weak hash\n"
252 "table. Note that a doubly weak hash table is neither a weak key\n"
253 "nor a weak value hash table.")
c35738c1 254#define FUNC_NAME s_scm_weak_key_alist_vector_p
0f2d19dd 255{
6e708ef2 256 return scm_from_bool (SCM_I_WVECTP (obj) && SCM_IS_WHVEC (obj));
0f2d19dd 257}
1bbd0b84 258#undef FUNC_NAME
0f2d19dd
JB
259
260
c35738c1 261SCM_DEFINE (scm_weak_value_alist_vector_p, "weak-value-alist-vector?", 1, 0, 0,
1e6808ea
MG
262 (SCM obj),
263 "Return @code{#t} if @var{obj} is a weak value hash table.")
c35738c1 264#define FUNC_NAME s_scm_weak_value_alist_vector_p
0f2d19dd 265{
6e708ef2 266 return scm_from_bool (SCM_I_WVECTP (obj) && SCM_IS_WHVEC_V (obj));
0f2d19dd 267}
1bbd0b84 268#undef FUNC_NAME
0f2d19dd
JB
269
270
c35738c1 271SCM_DEFINE (scm_doubly_weak_alist_vector_p, "doubly-weak-alist-vector?", 1, 0, 0,
1e6808ea
MG
272 (SCM obj),
273 "Return @code{#t} if @var{obj} is a doubly weak hash table.")
c35738c1 274#define FUNC_NAME s_scm_doubly_weak_alist_vector_p
0f2d19dd 275{
6e708ef2 276 return scm_from_bool (SCM_I_WVECTP (obj) && SCM_IS_WHVEC_B (obj));
0f2d19dd 277}
1bbd0b84 278#undef FUNC_NAME
0f2d19dd 279
592996c9 280
592996c9 281
06c1d900 282\f
c35738c1
MD
283SCM
284scm_init_weaks_builtins ()
285{
286#include "libguile/weaks.x"
287 return SCM_UNSPECIFIED;
288}
289
986ec822
LC
290void
291scm_weaks_prehistory ()
292{
293 /* Initialize weak pairs. */
294 GC_word wcar_pair_bitmap[GC_BITMAP_SIZE (scm_t_cell)] = { 0 };
295 GC_word wcdr_pair_bitmap[GC_BITMAP_SIZE (scm_t_cell)] = { 0 };
296
297 /* In a weak-car pair, only the second word must be scanned for
298 pointers. */
299 GC_set_bit (wcar_pair_bitmap, GC_WORD_OFFSET (scm_t_cell, word_1));
300 wcar_pair_descr = GC_make_descriptor (wcar_pair_bitmap,
301 GC_WORD_LEN (scm_t_cell));
302
303 /* Conversely, in a weak-cdr pair, only the first word must be scanned for
304 pointers. */
305 GC_set_bit (wcdr_pair_bitmap, GC_WORD_OFFSET (scm_t_cell, word_0));
306 wcdr_pair_descr = GC_make_descriptor (wcdr_pair_bitmap,
307 GC_WORD_LEN (scm_t_cell));
308
309}
310
0f2d19dd
JB
311void
312scm_init_weaks ()
0f2d19dd 313{
c35738c1
MD
314 scm_c_define_gsubr ("%init-weaks-builtins", 0, 0, 0,
315 scm_init_weaks_builtins);
0f2d19dd
JB
316}
317
89e00824
ML
318
319/*
320 Local Variables:
321 c-file-style: "gnu"
322 End:
323*/