X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-concurrency%2Fqueue.lisp;h=5fa70075ad6a9ba20fa712bfe75b260bc6dc74f0;hb=7254da92a1ba1bf8bc5a2e78a29d993f272d526e;hp=fec6d0fe818d2e073b2c2842edb64d9b576a0fb1;hpb=ea0735f0b8bab352d6c9797abec19e8c63563cf6;p=sbcl.git

diff --git a/contrib/sb-concurrency/queue.lisp b/contrib/sb-concurrency/queue.lisp
index fec6d0f..5fa7007 100644
--- a/contrib/sb-concurrency/queue.lisp
+++ b/contrib/sb-concurrency/queue.lisp
@@ -66,6 +66,7 @@ and secondary value."
             (tail (queue-tail queue))
             (first-node-prev (node-prev head))
             (val (node-value head)))
+       (barrier (:read))
        (when (eq head (queue-head queue))
          (cond ((not (eq val +dummy+))
                 (if (eq tail head)
@@ -79,11 +80,19 @@ and secondary value."
                       (go :continue)))
                 (when (eq head (sb-ext:compare-and-swap (queue-head queue)
                                                         head first-node-prev))
-                  ;; This assignment is not present in the paper, but is
-                  ;; equivalent to the free(head.ptr) call there: it unlinks
-                  ;; the HEAD from the queue -- the code in the paper leaves
-                  ;; the dangling pointer in place.
-                  (setf (node-next first-node-prev) nil)
+                  ;; These assignment is not present in the paper, but are
+                  ;; equivalent to the free(head.ptr) call there.
+                  ;;
+                  ;; First we unlink the HEAD from the queue -- the code in
+                  ;; the paper leaves the dangling pointer in place.
+                  ;;
+                  ;; Then we NIL out the slots in HEAD to help the GC,
+                  ;; otherwise conservativism might lead to massive chains of
+                  ;; nodes being retained.
+                  (setf (node-next first-node-prev) nil
+                        (node-prev head) nil
+                        (node-next head) nil
+                        (node-value head) nil)
                   (return-from dequeue (values val t))))
                ((eq tail head)
                 (return-from dequeue (values nil nil)))