guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-12-192-ge


From: Ludovic Courtès
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-12-192-ge9bac3b
Date: Mon, 11 Oct 2010 17:00:54 +0000

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=e9bac3be613f549b932d58913307ae18c89b9ffe

The branch, master has been updated
       via  e9bac3be613f549b932d58913307ae18c89b9ffe (commit)
       via  dff58577d80f6c65b15534cef749f5ff8ccd28ed (commit)
      from  08002eae4d8a9c0d36c2c4b53d4ec37c2d24a951 (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 e9bac3be613f549b932d58913307ae18c89b9ffe
Author: Ludovic Courtès <address@hidden>
Date:   Mon Oct 11 15:38:06 2010 +0200

    Allow arbitrary code in ASSOC procedures for weak hash tables (bug #29616).
    
    * libguile/hashtab.c (struct t_assoc_args, do_weak_bucket_assoc):
      Remove.
      (struct t_fixup_args): New type.
      (do_weak_bucket_fixup): New function.
      (weak_bucket_assoc): Use it.  Keep strong references to BUCKET's
      entries in STRONG_REFS.  Call ASSOC once the alloc lock has been
      released.  This fixes bug #29616.
    
    * test-suite/tests/weaks.test ("assoc can do anything"): New test.

commit dff58577d80f6c65b15534cef749f5ff8ccd28ed
Author: Ludovic Courtès <address@hidden>
Date:   Mon Oct 11 15:14:55 2010 +0200

    Fix a bug in weak hash table bucket fixup.
    
    * libguile/hashtab.c (scm_fixup_weak_alist): Keep the value of PREV
      unchanged after a nullified pair is deleted; this fixes a bug whereby
      if several successive nullified pairs were encountered, not all of them
      would be removed, and the assertion in `weak_bucket_assoc' would be
      hit.  In addition, remove the `scm_is_pair (pair)' test.

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

Summary of changes:
 libguile/hashtab.c          |  117 +++++++++++++++++++++++--------------------
 test-suite/tests/weaks.test |   39 ++++++++++++++-
 2 files changed, 100 insertions(+), 56 deletions(-)

diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index 78a265d..069da97 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -102,25 +102,25 @@ scm_fixup_weak_alist (SCM alist, size_t *removed_items)
   *removed_items = 0;
   for (result = alist;
        scm_is_pair (alist);
-       prev = alist, alist = SCM_CDR (alist))
+       alist = SCM_CDR (alist))
     {
       SCM pair = SCM_CAR (alist);
 
-      if (scm_is_pair (pair))
+      if (SCM_WEAK_PAIR_DELETED_P (pair))
        {
-         if (SCM_WEAK_PAIR_DELETED_P (pair))
-           {
-             /* Remove from ALIST weak pair PAIR whose car/cdr has been
-                nullified by the GC.  */
-             if (prev == SCM_EOL)
-               result = SCM_CDR (alist);
-             else
-               SCM_SETCDR (prev, SCM_CDR (alist));
-
-             (*removed_items)++;
-             continue;
-           }
+         /* Remove from ALIST weak pair PAIR whose car/cdr has been
+            nullified by the GC.  */
+         if (prev == SCM_EOL)
+           result = SCM_CDR (alist);
+         else
+           SCM_SETCDR (prev, SCM_CDR (alist));
+
+         (*removed_items)++;
+
+         /* Leave PREV unchanged.  */
        }
+      else
+       prev = alist;
     }
 
   return result;
@@ -137,40 +137,35 @@ 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
+/* Packed arguments for `do_weak_bucket_fixup'.  */
+struct t_fixup_args
 {
-  /* Input arguments.  */
-  SCM object;
-  SCM buckets;
-  size_t bucket_index;
-  scm_t_assoc_fn assoc_fn;
-  void *closure;
-
-  /* Output arguments.  */
-  SCM result;
+  SCM bucket;
+  SCM *bucket_copy;
   size_t removed_items;
 };
 
 static void *
-do_weak_bucket_assoc (void *data)
+do_weak_bucket_fixup (void *data)
 {
-  struct t_assoc_args *args;
-  size_t removed;
-  SCM bucket, result;
-
-  args = (struct t_assoc_args *) data;
+  struct t_fixup_args *args;
+  SCM pair, *copy;
 
-  bucket = SCM_SIMPLE_VECTOR_REF (args->buckets, args->bucket_index);
-  bucket = scm_fixup_weak_alist (bucket, &removed);
+  args = (struct t_fixup_args *) data;
 
-  SCM_SIMPLE_VECTOR_SET (args->buckets, args->bucket_index, bucket);
+  args->bucket = scm_fixup_weak_alist (args->bucket, &args->removed_items);
 
-  /* Run ASSOC_FN on the now clean BUCKET.  */
-  result = args->assoc_fn (args->object, bucket, args->closure);
+  for (pair = args->bucket, copy = args->bucket_copy;
+       scm_is_pair (pair);
+       pair = SCM_CDR (pair), copy += 2)
+    {
+      /* At this point, all weak pairs have been removed.  */
+      assert (!SCM_WEAK_PAIR_DELETED_P (SCM_CAR (pair)));
 
-  args->result = result;
-  args->removed_items = removed;
+      /* Copy the key and value.  */
+      copy[0] = SCM_CAAR (pair);
+      copy[1] = SCM_CDAR (pair);
+    }
 
   return args;
 }
@@ -184,26 +179,38 @@ weak_bucket_assoc (SCM table, SCM buckets, size_t 
bucket_index,
                   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;
+  SCM bucket, *strong_refs;
+  struct t_fixup_args args;
+
+  bucket = SCM_SIMPLE_VECTOR_REF (buckets, bucket_index);
+
+  /* Prepare STRONG_REFS as an array large enough to hold all the keys
+     and values in BUCKET.  */
+  strong_refs = alloca (scm_ilength (bucket) * 2 * sizeof (SCM));
+
+  args.bucket = bucket;
+  args.bucket_copy = strong_refs;
+
+  /* Fixup BUCKET.  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.)
+
+     The `do_weak_bucket_fixup' call populates STRONG_REFS with a copy
+     of BUCKET's entries after it's been fixed up.  Thus, all the
+     entries kept in BUCKET are still reachable when ASSOC sees
+     them.  */
+  GC_call_with_alloc_lock (do_weak_bucket_fixup, &args);
+
+  bucket = args.bucket;
+  SCM_SIMPLE_VECTOR_SET (buckets, bucket_index, bucket);
+
+  result = assoc (object, bucket, closure);
   assert (!scm_is_pair (result) ||
          !SCM_WEAK_PAIR_DELETED_P (GC_is_visible (result)));
 
+  scm_remember_upto_here_1 (strong_refs);
+
   if (args.removed_items > 0 && SCM_HASHTABLE_P (table))
     {
       /* Update TABLE's item count and optionally trigger a rehash.  */
diff --git a/test-suite/tests/weaks.test b/test-suite/tests/weaks.test
index 0c1ebee..3c9a290 100644
--- a/test-suite/tests/weaks.test
+++ b/test-suite/tests/weaks.test
@@ -206,4 +206,41 @@
                             '("is" "test" "the" "weak" "hash system"))
                      (any not values)
                      (hash-ref z test-key)
-                     #t))))))
+                     #t))))
+
+   (pass-if "assoc can do anything"
+            ;; Until 1.9.12, as hash table's custom ASSOC procedure was
+            ;; called with the GC lock alloc held, which imposed severe
+            ;; restrictions on what it could do (bug #29616).  This test
+            ;; makes sure this is no longer the case.
+            (let ((h (make-doubly-weak-hash-table 2))
+                  (c 123)
+                  (k "GNU"))
+
+              (define (assoc-ci key bucket)
+                (make-list 123) ;; this should be possible
+                (gc)            ;; this too
+                (find (lambda (p)
+                        (string-ci=? key (car p)))
+                      bucket))
+
+              (hashx-set! string-hash-ci assoc-ci h
+                          (string-copy "hello") (string-copy "world"))
+              (hashx-set! string-hash-ci assoc-ci h
+                          k "Guile")
+
+              (and (every (cut valid? <> "Guile")
+                          (unfold (cut >= <> c)
+                                  (lambda (_)
+                                    (hashx-ref string-hash-ci assoc-ci
+                                               h "gnu"))
+                                  1+
+                                  0))
+                   (every (cut valid? <> "world")
+                          (unfold (cut >= <> c)
+                                  (lambda (_)
+                                    (hashx-ref string-hash-ci assoc-ci
+                                               h "HELLO"))
+                                  1+
+                                  0))
+                   #t)))))


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]