libguile/weaks.c

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