*** empty log message ***
[bpt/guile.git] / libguile / weaks.c
index 90b5731..a39b587 100644 (file)
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,2000,2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001, 2003 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
 #include "libguile/_scm.h"
 #include "libguile/vectors.h"
 #include "libguile/lang.h"
+#include "libguile/hashtab.h"
 
 #include "libguile/validate.h"
 #include "libguile/weaks.h"
 
 \f
 
+/* 1. The current hash table implementation in hashtab.c uses weak alist
+ *    vectors (formerly called weak hash tables) internally.
+ *
+ * 2. All hash table operations still work on alist vectors.
+ *
+ * 3. The weak vector and alist vector Scheme API is accessed through
+ *    the module (ice-9 weak-vector).
+ */
+
+
 /* {Weak Vectors}
  */
 
@@ -60,8 +71,8 @@
  * elements which are initialized with the 'fill' object, or, if 'fill' is
  * undefined, with an unspecified object.
  */
-static SCM
-allocate_weak_vector (scm_t_bits type, SCM size, SCM fill, const char* caller)
+SCM
+scm_i_allocate_weak_vector (scm_t_bits type, SCM size, SCM fill, const char* caller)
 #define FUNC_NAME caller
 {
   if (SCM_INUMP (size))
@@ -107,7 +118,6 @@ allocate_weak_vector (scm_t_bits type, SCM size, SCM fill, const char* caller)
 }
 #undef FUNC_NAME
 
-
 SCM_DEFINE (scm_make_weak_vector, "make-weak-vector", 1, 1, 0,
            (SCM size, SCM fill),
            "Return a weak vector with @var{size} elements. If the optional\n"
@@ -116,7 +126,7 @@ SCM_DEFINE (scm_make_weak_vector, "make-weak-vector", 1, 1, 0,
            "empty list.")
 #define FUNC_NAME s_scm_make_weak_vector
 {
-  return allocate_weak_vector (0, size, fill, FUNC_NAME);
+  return scm_i_allocate_weak_vector (0, size, fill, FUNC_NAME);
 }
 #undef FUNC_NAME
 
@@ -169,73 +179,76 @@ SCM_DEFINE (scm_weak_vector_p, "weak-vector?", 1, 0, 0,
 
 \f
 
-SCM_DEFINE (scm_make_weak_key_hash_table, "make-weak-key-hash-table", 1, 0, 0, 
+SCM_DEFINE (scm_make_weak_key_alist_vector, "make-weak-key-alist-vector", 0, 1, 0, 
            (SCM size),
-           "@deffnx {Scheme Procedure} make-weak-value-hash-table size\n"
-           "@deffnx {Scheme Procedure} make-doubly-weak-hash-table size\n"
+           "@deffnx {Scheme Procedure} make-weak-value-alist-vector size\n"
+           "@deffnx {Scheme Procedure} make-doubly-weak-alist-vector size\n"
            "Return a weak hash table with @var{size} buckets. As with any\n"
            "hash table, choosing a good size for the table requires some\n"
            "caution.\n"
            "\n"
            "You can modify weak hash tables in exactly the same way you\n"
            "would modify regular hash tables. (@pxref{Hash Tables})")
-#define FUNC_NAME s_scm_make_weak_key_hash_table
+#define FUNC_NAME s_scm_make_weak_key_alist_vector
 {
-  return allocate_weak_vector (1, size, SCM_EOL, FUNC_NAME);
+  return scm_i_allocate_weak_vector
+    (1, SCM_UNBNDP (size) ? SCM_MAKINUM (31) : size, SCM_EOL, FUNC_NAME);
 }
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_make_weak_value_hash_table, "make-weak-value-hash-table", 1, 0, 0, 
+SCM_DEFINE (scm_make_weak_value_alist_vector, "make-weak-value-alist-vector", 0, 1, 0, 
             (SCM size),
            "Return a hash table with weak values with @var{size} buckets.\n"
            "(@pxref{Hash Tables})")
-#define FUNC_NAME s_scm_make_weak_value_hash_table
+#define FUNC_NAME s_scm_make_weak_value_alist_vector
 {
-  return allocate_weak_vector (2, size, SCM_EOL, FUNC_NAME);
+  return scm_i_allocate_weak_vector
+    (2, SCM_UNBNDP (size) ? SCM_MAKINUM (31) : size, SCM_EOL, FUNC_NAME);
 }
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_make_doubly_weak_hash_table, "make-doubly-weak-hash-table", 1, 0, 0, 
+SCM_DEFINE (scm_make_doubly_weak_alist_vector, "make-doubly-weak-alist-vector", 1, 0, 0, 
             (SCM size),
            "Return a hash table with weak keys and values with @var{size}\n"
            "buckets.  (@pxref{Hash Tables})")
-#define FUNC_NAME s_scm_make_doubly_weak_hash_table
+#define FUNC_NAME s_scm_make_doubly_weak_alist_vector
 {
-  return allocate_weak_vector (3, size, SCM_EOL, FUNC_NAME);
+  return scm_i_allocate_weak_vector
+    (3, SCM_UNBNDP (size) ? SCM_MAKINUM (31) : size, SCM_EOL, FUNC_NAME);
 }
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_weak_key_hash_table_p, "weak-key-hash-table?", 1, 0, 0, 
+SCM_DEFINE (scm_weak_key_alist_vector_p, "weak-key-alist-vector?", 1, 0, 0, 
            (SCM obj),
-           "@deffnx {Scheme Procedure} weak-value-hash-table? obj\n"
-           "@deffnx {Scheme Procedure} doubly-weak-hash-table? obj\n"
+           "@deffnx {Scheme Procedure} weak-value-alist-vector? obj\n"
+           "@deffnx {Scheme Procedure} doubly-weak-alist-vector? obj\n"
            "Return @code{#t} if @var{obj} is the specified weak hash\n"
            "table. Note that a doubly weak hash table is neither a weak key\n"
            "nor a weak value hash table.")
-#define FUNC_NAME s_scm_weak_key_hash_table_p
+#define FUNC_NAME s_scm_weak_key_alist_vector_p
 {
   return SCM_BOOL (SCM_WVECTP (obj) && SCM_IS_WHVEC (obj));
 }
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_weak_value_hash_table_p, "weak-value-hash-table?", 1, 0, 0, 
+SCM_DEFINE (scm_weak_value_alist_vector_p, "weak-value-alist-vector?", 1, 0, 0, 
             (SCM obj),
            "Return @code{#t} if @var{obj} is a weak value hash table.")
-#define FUNC_NAME s_scm_weak_value_hash_table_p
+#define FUNC_NAME s_scm_weak_value_alist_vector_p
 {
   return SCM_BOOL (SCM_WVECTP (obj) && SCM_IS_WHVEC_V (obj));
 }
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_doubly_weak_hash_table_p, "doubly-weak-hash-table?", 1, 0, 0, 
+SCM_DEFINE (scm_doubly_weak_alist_vector_p, "doubly-weak-alist-vector?", 1, 0, 0, 
             (SCM obj),
            "Return @code{#t} if @var{obj} is a doubly weak hash table.")
-#define FUNC_NAME s_scm_doubly_weak_hash_table_p
+#define FUNC_NAME s_scm_doubly_weak_alist_vector_p
 {
   return SCM_BOOL (SCM_WVECTP (obj) && SCM_IS_WHVEC_B (obj));
 }
@@ -278,11 +291,11 @@ scm_mark_weak_vector_spines (void *dummy1 SCM_UNUSED,
 
              alist = ptr[j];
              while (   SCM_CONSP (alist)
-                    && !SCM_GCMARKP (alist)
+                    && !SCM_GC_MARK_P (alist)
                     && SCM_CONSP  (SCM_CAR (alist)))
                {
-                 SCM_SETGCMARK (alist);
-                 SCM_SETGCMARK (SCM_CAR (alist));
+                 SCM_SET_GC_MARK (alist);
+                 SCM_SET_GC_MARK (SCM_CAR (alist));
                  alist = SCM_CDR (alist);
                }
            }
@@ -292,6 +305,7 @@ scm_mark_weak_vector_spines (void *dummy1 SCM_UNUSED,
   return 0;
 }
 
+#define UNMARKED_CELL_P(x) (SCM_NIMP(x) && !SCM_GC_MARK_P (x))
 
 static void *
 scm_scan_weak_vectors (void *dummy1 SCM_UNUSED,
@@ -308,10 +322,12 @@ scm_scan_weak_vectors (void *dummy1 SCM_UNUSED,
          ptr = SCM_GC_WRITABLE_VELTS (w);
          n = SCM_VECTOR_LENGTH (w);
          for (j = 0; j < n; ++j)
-           if (SCM_FREE_CELL_P (ptr[j]))
+           if (UNMARKED_CELL_P (ptr[j]))
              ptr[j] = SCM_BOOL_F;
        }
-      else /* if (SCM_IS_WHVEC_ANY (scm_weak_vectors[i])) */
+      /* check if we should scan the alist vector here (hashtables
+        have their own scan function in hashtab.c). */
+      else if (!SCM_WVECT_NOSCAN_P (w))
        {
          SCM obj = w;
          register long n = SCM_VECTOR_LENGTH (w);
@@ -329,16 +345,16 @@ scm_scan_weak_vectors (void *dummy1 SCM_UNUSED,
              fixup = ptr + j;
              alist = *fixup;
 
-             while (   SCM_CONSP (alist)
-                       && SCM_CONSP (SCM_CAR (alist)))
+             while (SCM_CONSP (alist)
+                    && SCM_CONSP (SCM_CAR (alist)))
                {
                  SCM key;
                  SCM value;
 
                  key = SCM_CAAR (alist);
                  value = SCM_CDAR (alist);
-                 if (   (weak_keys && SCM_FREE_CELL_P (key))
-                        || (weak_values && SCM_FREE_CELL_P (value)))
+                 if (   (weak_keys && UNMARKED_CELL_P (key))
+                        || (weak_values && UNMARKED_CELL_P (value)))
                    {
                      *fixup = SCM_CDR (alist);
                    }
@@ -364,10 +380,18 @@ scm_weaks_prehistory ()
 }
 
 
+SCM
+scm_init_weaks_builtins ()
+{
+#include "libguile/weaks.x"
+  return SCM_UNSPECIFIED;
+}
+
 void
 scm_init_weaks ()
 {
-#include "libguile/weaks.x"
+  scm_c_define_gsubr ("%init-weaks-builtins", 0, 0, 0,
+                     scm_init_weaks_builtins);
 }