X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-concurrency%2Fqueue.lisp;h=bf0bc9887714427c2097eee48bab0a9e3a103831;hb=f057566fe993f008a9b34dc87b026e7c8ef2611d;hp=a902785cbdfd9f90edb65d5b8a020afae5c31080;hpb=713bb89f472457ec6654732b6b248b17b971f0ff;p=sbcl.git

diff --git a/contrib/sb-concurrency/queue.lisp b/contrib/sb-concurrency/queue.lisp
index a902785..bf0bc98 100644
--- a/contrib/sb-concurrency/queue.lisp
+++ b/contrib/sb-concurrency/queue.lisp
@@ -25,7 +25,9 @@
 (defstruct (queue (:constructor %make-queue (head tail name))
                   (:copier nil)
                   (:predicate queuep))
-  "Lock-free thread safe queue."
+  "Lock-free thread safe FIFO queue.
+
+Use ENQUEUE to add objects to the queue, and DEQUEUE to remove them."
   (head (error "No HEAD.") :type node)
   (tail (error "No TAIL.") :type node)
   (name nil))
@@ -80,11 +82,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)))
@@ -109,7 +119,8 @@ and secondary value."
 
 (defun list-queue-contents (queue)
   "Returns the contents of QUEUE as a list without removing them from the
-QUEUE. Mainly useful for manual examination of queue state."
+QUEUE. Mainly useful for manual examination of queue state, as the list
+may be out of date by the time it is returned."
   (let (all)
     (labels ((walk (node)
                ;; Since NEXT pointers are always right, traversing from tail
@@ -126,7 +137,7 @@ QUEUE. Mainly useful for manual examination of queue state."
 (defun queue-count (queue)
   "Returns the number of objects in QUEUE. Mainly useful for manual
 examination of queue state, and in PRINT-OBJECT methods: inefficient as it
-walks the entire queue."
+must walk the entire queue."
   (let ((n 0))
     (declare (unsigned-byte n))
     (labels ((walk (node)