libguile/weaks.c

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