Commit | Line | Data |
---|---|---|
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. */ | |
71 | static GC_descr wcar_pair_descr, wcdr_pair_descr; | |
72 | ||
73 | ||
74 | SCM | |
75 | scm_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 | ||
95 | SCM | |
96 | scm_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 | ||
116 | SCM | |
117 | scm_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 | 157 | SCM_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 | 170 | SCM_REGISTER_PROC(s_list_to_weak_vector, "list->weak-vector", 1, 0, 0, scm_weak_vector); |
1cc91f1b | 171 | |
3b3b36dd | 172 | SCM_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 | 186 | SCM_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 | 208 | SCM_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 | 225 | SCM_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 | 236 | SCM_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 | 247 | SCM_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 | 261 | SCM_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 | 271 | SCM_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 |
283 | SCM |
284 | scm_init_weaks_builtins () | |
285 | { | |
286 | #include "libguile/weaks.x" | |
287 | return SCM_UNSPECIFIED; | |
288 | } | |
289 | ||
986ec822 LC |
290 | void |
291 | scm_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 |
311 | void |
312 | scm_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 | */ |