libguile/weaks.c

   1 /* Copyright (C) 1995,1996,1998,2000,2001, 2003, 2006 Free Software Foundation, Inc.
   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
  15  * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  16  * Boston, MA 02110-1301 USA
  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.
  40  * If you do not wish that, delete this exception notice.  */
  41
  42
  43 \f
  44
  45 #include <stdio.h>
  46
  47 #include "libguile/_scm.h"
  48 #include "libguile/vectors.h"
  49 #include "libguile/lang.h"
  50 #include "libguile/hashtab.h"
  51
  52 #include "libguile/validate.h"
  53 #include "libguile/weaks.h"
  54
  55 #include "libguile/boehm-gc.h"
  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
 141 \f
 142
 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
 153 /* {Weak Vectors}
 154  */
 155
 156
 157 SCM_DEFINE (scm_make_weak_vector, "make-weak-vector", 1, 1, 0,
 158             (SCM size, SCM fill),
 159             "Return a weak vector with @var{size} elements. If the optional\n"
 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.")
 163 #define FUNC_NAME s_scm_make_weak_vector
 164 {
 165   return scm_i_make_weak_vector (0, size, fill);
 166 }
 167 #undef FUNC_NAME
 168
 169
 170 SCM_REGISTER_PROC(s_list_to_weak_vector, "list->weak-vector", 1, 0, 0, scm_weak_vector);
 171
 172 SCM_DEFINE (scm_weak_vector, "weak-vector", 0, 0, 1,
 173            (SCM l),
 174             "@deffnx {Scheme Procedure} list->weak-vector l\n"
 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.")
 179 #define FUNC_NAME s_scm_weak_vector
 180 {
 181   return scm_i_make_weak_vector_from_list (0, l);
 182 }
 183 #undef FUNC_NAME
 184
 185
 186 SCM_DEFINE (scm_weak_vector_p, "weak-vector?", 1, 0, 0,
 187             (SCM obj),
 188             "Return @code{#t} if @var{obj} is a weak vector. Note that all\n"
 189             "weak hashes are also weak vectors.")
 190 #define FUNC_NAME s_scm_weak_vector_p
 191 {
 192   return scm_from_bool (SCM_I_WVECTP (obj) && !SCM_IS_WHVEC (obj));
 193 }
 194 #undef FUNC_NAME
 195
 196 \f
 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.  */
 201
 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
 208 SCM_DEFINE (scm_make_weak_key_alist_vector, "make-weak-key-alist-vector", 0, 1, 0,
 209             (SCM size),
 210             "@deffnx {Scheme Procedure} make-weak-value-alist-vector size\n"
 211             "@deffnx {Scheme Procedure} make-doubly-weak-alist-vector size\n"
 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})")
 218 #define FUNC_NAME s_scm_make_weak_key_alist_vector
 219 {
 220   return scm_make_weak_key_hash_table (size);
 221 }
 222 #undef FUNC_NAME
 223
 224
 225 SCM_DEFINE (scm_make_weak_value_alist_vector, "make-weak-value-alist-vector", 0, 1, 0,
 226             (SCM size),
 227             "Return a hash table with weak values with @var{size} buckets.\n"
 228             "(@pxref{Hash Tables})")
 229 #define FUNC_NAME s_scm_make_weak_value_alist_vector
 230 {
 231   return scm_make_weak_value_hash_table (size);
 232 }
 233 #undef FUNC_NAME
 234
 235
 236 SCM_DEFINE (scm_make_doubly_weak_alist_vector, "make-doubly-weak-alist-vector", 1, 0, 0,
 237             (SCM size),
 238             "Return a hash table with weak keys and values with @var{size}\n"
 239             "buckets.  (@pxref{Hash Tables})")
 240 #define FUNC_NAME s_scm_make_doubly_weak_alist_vector
 241 {
 242   return scm_make_doubly_weak_hash_table (size);
 243 }
 244 #undef FUNC_NAME
 245
 246
 247 SCM_DEFINE (scm_weak_key_alist_vector_p, "weak-key-alist-vector?", 1, 0, 0,
 248            (SCM obj),
 249             "@deffnx {Scheme Procedure} weak-value-alist-vector? obj\n"
 250             "@deffnx {Scheme Procedure} doubly-weak-alist-vector? obj\n"
 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.")
 254 #define FUNC_NAME s_scm_weak_key_alist_vector_p
 255 {
 256   return scm_from_bool (SCM_I_WVECTP (obj) && SCM_IS_WHVEC (obj));
 257 }
 258 #undef FUNC_NAME
 259
 260
 261 SCM_DEFINE (scm_weak_value_alist_vector_p, "weak-value-alist-vector?", 1, 0, 0,
 262             (SCM obj),
 263             "Return @code{#t} if @var{obj} is a weak value hash table.")
 264 #define FUNC_NAME s_scm_weak_value_alist_vector_p
 265 {
 266   return scm_from_bool (SCM_I_WVECTP (obj) && SCM_IS_WHVEC_V (obj));
 267 }
 268 #undef FUNC_NAME
 269
 270
 271 SCM_DEFINE (scm_doubly_weak_alist_vector_p, "doubly-weak-alist-vector?", 1, 0, 0,
 272             (SCM obj),
 273             "Return @code{#t} if @var{obj} is a doubly weak hash table.")
 274 #define FUNC_NAME s_scm_doubly_weak_alist_vector_p
 275 {
 276   return scm_from_bool (SCM_I_WVECTP (obj) && SCM_IS_WHVEC_B (obj));
 277 }
 278 #undef FUNC_NAME
 279
 280
 281
 282 \f
 283 SCM
 284 scm_init_weaks_builtins ()
 285 {
 286 #include "libguile/weaks.x"
 287   return SCM_UNSPECIFIED;
 288 }
 289
 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
 311 void
 312 scm_init_weaks ()
 313 {
 314   scm_c_define_gsubr ("%init-weaks-builtins", 0, 0, 0,
 315                       scm_init_weaks_builtins);
 316 }
 317
 318
 319 /*
 320   Local Variables:
 321   c-file-style: "gnu"
 322   End:
 323 */