[Guile-commits] GNU Guile branch, master, updated. release_1-9-4-84-g6322990

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=632299050a9063c6894c82ba31faa6b5fc03de59

The branch, master has been updated
       via  632299050a9063c6894c82ba31faa6b5fc03de59 (commit)
       via  f4767979987530bb9d88dde6ebe61cdac6f756b9 (commit)
      from  440ae5103545726b31985b9a7d0d7dc3931c240d (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 632299050a9063c6894c82ba31faa6b5fc03de59
Author: Ludovic Courtès <address@hidden>
Date:   Fri Oct 30 11:31:51 2009 +0100

    Hold the GC lock when traversing weak hash table buckets.
    
    * libguile/hashtab.c (scm_fixup_weak_alist): Clarify comment.
      (struct t_assoc_args): New.
      (do_weak_bucket_assoc, weak_bucket_assoc): New.
      (START_WEAK_BUCKET_FIXUP, END_WEAK_BUCKET_FIXUP): Remove.
      (scm_hash_fn_get_handle, scm_hash_fn_create_handle_x,
      scm_hash_fn_remove_x): Use `weak_bucket_assoc ()' instead of
      `START_WEAK_BUCKET_FIXUP'/`END_WEAK_BUCKET_FIXUP'.

commit f4767979987530bb9d88dde6ebe61cdac6f756b9
Author: Ludovic Courtès <address@hidden>
Date:   Thu Nov 5 23:06:45 2009 +0100

    Fix snarfing of `SCM_DEFINE' with static allocation.
    
    * libguile/snarf.h (SCM_DEFINE)[SCM_SUPPORT_STATIC_ALLOCATION]: Provide
      a declaration for FNAME since the last argument to
      `SCM_IMMUTABLE_SUBR ()' refers to it.

-----------------------------------------------------------------------

Summary of changes:
 libguile/hashtab.c |  167 ++++++++++++++++++++++++++++++++--------------------
 libguile/snarf.h   |    5 +-
 2 files changed, 105 insertions(+), 67 deletions(-)

diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index 4ba2ef9..b76d3af 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -23,6 +23,7 @@
 #endif
 
 #include <stdio.h>
+#include <assert.h>
 
 #include "libguile/_scm.h"
 #include "libguile/alist.h"
@@ -94,9 +95,8 @@ static char *s_hashtable = "hashtable";
    buckets and remove them.  */
 
 
-/* Return a ``usable'' version of ALIST, an alist of weak pairs.  By
-   ``usable'', we mean that it contains only valid Scheme objects.  On
-   return, REMOVED_ITEMS is set to the number of pairs that have been
+/* Remove nullified weak pairs from ALIST such that the result contains only
+   valid pairs.  Set REMOVED_ITEMS to the number of pairs that have been
    deleted.  */
 static SCM
 scm_fixup_weak_alist (SCM alist, size_t *removed_items)
@@ -132,8 +132,6 @@ scm_fixup_weak_alist (SCM alist, size_t *removed_items)
 }
 
 
-/* Helper macros.  */
-
 /* Return true if OBJ is either a weak hash table or a weak alist vector (as
    defined in `weaks.[ch]').
    FIXME: We should eventually keep only weah hash tables.  Actually, the
@@ -144,36 +142,88 @@ scm_fixup_weak_alist (SCM alist, size_t *removed_items)
    || (SCM_I_IS_VECTOR (table)))
 
 
+/* Packed arguments for `do_weak_bucket_assoc ()'.  */
+struct t_assoc_args
+{
+  /* Input arguments.  */
+  SCM object;
+  SCM buckets;
+  size_t bucket_index;
+  scm_t_assoc_fn assoc_fn;
+  void *closure;
+
+  /* Output arguments.  */
+  SCM result;
+  size_t removed_items;
+};
+
+static void *
+do_weak_bucket_assoc (void *data)
+{
+  struct t_assoc_args *args;
+  size_t removed;
+  SCM bucket, result;
+
+  args = (struct t_assoc_args *) data;
 
-/* Fixup BUCKET, an alist part of weak hash table OBJ.  BUCKETS is the full
-   bucket vector for OBJ and IDX is the index of BUCKET within this
-   vector.  See also `scm_internal_hash_fold ()'.  */
-#define START_WEAK_BUCKET_FIXUP(_obj, _buckets, _idx, _bucket, _hashfn)        
     \
-do                                                                          \
-  {                                                                         \
-    size_t _removed;                                                        \
-                                                                            \
-    /* Disable the GC so that BUCKET remains valid until ASSOC_FN has       \
-       returned.  */                                                        \
-    /* FIXME: We could maybe trigger a rehash here depending on whether        
     \
-       `scm_fixup_weak_alist ()' noticed some change.  */                   \
-    GC_disable ();                                                          \
-    (_bucket) = scm_fixup_weak_alist ((_bucket), &_removed);                \
-    SCM_SIMPLE_VECTOR_SET ((_buckets), (_idx), (_bucket));                  \
-                                                                            \
-    if ((_removed) && (SCM_HASHTABLE_P (_obj)))                                
     \
-      {                                                                        
     \
-       SCM_SET_HASHTABLE_N_ITEMS ((_obj),                                   \
-                                  SCM_HASHTABLE_N_ITEMS (_obj) - _removed); \
-       scm_i_rehash ((_obj), (_hashfn),                                     \
-                     NULL, "START_WEAK_BUCKET_FIXUP");                      \
-      }                                                                        
     \
-  }                                                                         \
-while (0)
-
-/* Terminate a weak bucket fixup phase.  */
-#define END_WEAK_BUCKET_FIXUP(_obj, _buckets, _idx, _bucket, _hashfn)  \
-  do { GC_enable (); } while (0)
+  bucket = SCM_SIMPLE_VECTOR_REF (args->buckets, args->bucket_index);
+  bucket = scm_fixup_weak_alist (bucket, &removed);
+
+  SCM_SIMPLE_VECTOR_SET (args->buckets, args->bucket_index, bucket);
+
+  /* Run ASSOC_FN on the now clean BUCKET.  */
+  result = args->assoc_fn (args->object, bucket, args->closure);
+
+  args->result = result;
+  args->removed_items = removed;
+
+  return args;
+}
+
+/* Lookup OBJECT in weak hash table TABLE using ASSOC.  OBJECT is searched
+   for in the alist that is the BUCKET_INDEXth element of BUCKETS.
+   Optionally update TABLE and rehash it.  */
+static SCM
+weak_bucket_assoc (SCM table, SCM buckets, size_t bucket_index,
+                  scm_t_hash_fn hash_fn,
+                  scm_t_assoc_fn assoc, SCM object, void *closure)
+{
+  SCM result;
+  struct t_assoc_args args;
+
+  args.object = object;
+  args.buckets = buckets;
+  args.bucket_index = bucket_index;
+  args.assoc_fn = assoc;
+  args.closure = closure;
+
+  /* Fixup the bucket and pass the clean bucket to ASSOC.  Do that with the
+     allocation lock held to avoid seeing disappearing links pointing to
+     objects that have already been reclaimed (this happens when the
+     disappearing links that point to it haven't yet been cleared.)
+     Thus, ASSOC must not take long, and it must not make any non-local
+     exit.  */
+  GC_call_with_alloc_lock (do_weak_bucket_assoc, &args);
+
+  result = args.result;
+  assert (!scm_is_pair (result) ||
+         !SCM_WEAK_PAIR_DELETED_P (GC_is_visible (result)));
+
+  if (args.removed_items > 0 && SCM_HASHTABLE_P (table))
+    {
+      /* Update TABLE's item count and optionally trigger a rehash.  */
+      size_t remaining;
+
+      assert (SCM_HASHTABLE_N_ITEMS (table) >= args.removed_items);
+
+      remaining = SCM_HASHTABLE_N_ITEMS (table) - args.removed_items;
+      SCM_SET_HASHTABLE_N_ITEMS (table, remaining);
+
+      scm_i_rehash (table, hash_fn, closure, "weak_bucket_assoc");
+    }
+
+  return result;
+}
 
 
 
@@ -438,9 +488,8 @@ scm_hash_fn_get_handle (SCM table, SCM obj,
                        void * closure)
 #define FUNC_NAME "scm_hash_fn_get_handle"
 {
-  int weak = 0;
   unsigned long k;
-  SCM buckets, alist, h;
+  SCM buckets, h;
 
   if (SCM_HASHTABLE_P (table))
     buckets = SCM_HASHTABLE_VECTOR (table);
@@ -456,15 +505,11 @@ scm_hash_fn_get_handle (SCM table, SCM obj,
   if (k >= SCM_SIMPLE_VECTOR_LENGTH (buckets))
     scm_out_of_range ("hash_fn_get_handle", scm_from_ulong (k));
 
-  weak = IS_WEAK_THING (table);
-  alist = SCM_SIMPLE_VECTOR_REF (buckets, k);
-
-  if (weak)
-    START_WEAK_BUCKET_FIXUP (table, buckets, k, alist, hash_fn);
-
-  h = assoc_fn (obj, alist, closure);
-  if (weak)
-    END_WEAK_BUCKET_FIXUP (table, buckets, k, alist, hash_fn);
+  if (IS_WEAK_THING (table))
+    h = weak_bucket_assoc (table, buckets, k, hash_fn,
+                          assoc_fn, obj, closure);
+  else
+    h = assoc_fn (obj, SCM_SIMPLE_VECTOR_REF (buckets, k), closure);
 
   return h;
 }
@@ -477,9 +522,8 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init,
                              void * closure)
 #define FUNC_NAME "scm_hash_fn_create_handle_x"
 {
-  int weak = 0;
   unsigned long k;
-  SCM buckets, alist, it;
+  SCM buckets, it;
 
   if (SCM_HASHTABLE_P (table))
     buckets = SCM_HASHTABLE_VECTOR (table);
@@ -496,14 +540,11 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init,
   if (k >= SCM_SIMPLE_VECTOR_LENGTH (buckets))
     scm_out_of_range ("hash_fn_create_handle_x", scm_from_ulong (k));
 
-  weak = IS_WEAK_THING (table);
-  alist = SCM_SIMPLE_VECTOR_REF (buckets, k);
-  if (weak)
-    START_WEAK_BUCKET_FIXUP (table, buckets, k, alist, hash_fn);
-
-  it = assoc_fn (obj, alist, closure);
-  if (weak)
-    END_WEAK_BUCKET_FIXUP (table, buckets, k, alist, hash_fn);
+  if (IS_WEAK_THING (table))
+    it = weak_bucket_assoc (table, buckets, k, hash_fn,
+                           assoc_fn, obj, closure);
+  else
+    it = assoc_fn (obj, SCM_SIMPLE_VECTOR_REF (buckets, k), closure);
 
   if (scm_is_pair (it))
     return it;
@@ -598,9 +639,8 @@ scm_hash_fn_remove_x (SCM table, SCM obj,
                      scm_t_assoc_fn assoc_fn,
                       void *closure)
 {
-  int weak = 0;
   unsigned long k;
-  SCM buckets, alist, h;
+  SCM buckets, h;
 
   if (SCM_HASHTABLE_P (table))
     buckets = SCM_HASHTABLE_VECTOR (table);
@@ -617,14 +657,11 @@ scm_hash_fn_remove_x (SCM table, SCM obj,
   if (k >= SCM_SIMPLE_VECTOR_LENGTH (buckets))
     scm_out_of_range ("hash_fn_remove_x", scm_from_ulong (k));
 
-  weak = IS_WEAK_THING (table);
-  alist = SCM_SIMPLE_VECTOR_REF (buckets, k);
-  if (weak)
-    START_WEAK_BUCKET_FIXUP (table, buckets, k, alist, hash_fn);
-
-  h = assoc_fn (obj, alist, closure);
-  if (weak)
-    END_WEAK_BUCKET_FIXUP (table, buckets, k, alist, hash_fn);
+  if (IS_WEAK_THING (table))
+    h = weak_bucket_assoc (table, buckets, k, hash_fn,
+                          assoc_fn, obj, closure);
+  else
+    h = assoc_fn (obj, SCM_SIMPLE_VECTOR_REF (buckets, k), closure);
 
   if (scm_is_true (h))
     {
diff --git a/libguile/snarf.h b/libguile/snarf.h
index 9eaccf6..720cff5 100644
--- a/libguile/snarf.h
+++ b/libguile/snarf.h
@@ -101,14 +101,15 @@ SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, 
OPT, VAR, DOCSTRING)
 /* Static subr allocation.  */
 #define SCM_DEFINE(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
 SCM_SYMBOL (scm_i_paste (FNAME, __name), PRIMNAME);                    \
-SCM_SNARF_HERE(                                                                
\
+SCM_SNARF_HERE(                                                        \
   static const char scm_i_paste (s_, FNAME) [] = PRIMNAME;             \
+  SCM_API SCM FNAME ARGLIST;                                           \
   SCM_IMMUTABLE_SUBR (scm_i_paste (FNAME, __subr),                     \
                      scm_i_paste (FNAME, __name),                      \
                      REQ, OPT, VAR, &FNAME);                           \
   SCM FNAME ARGLIST                                                    \
 )                                                                      \
-SCM_SNARF_INIT(                                                                
\
+SCM_SNARF_INIT(                                                        \
   /* Initialize the procedure name (an interned symbol).  */           \
   scm_i_paste (FNAME, __subr_meta_info)[0] = scm_i_paste (FNAME, __name); \
                                                                        \


hooks/post-receive
-- 
GNU Guile