start xdump-mode

[eow] / locked-queue.lisp

diff --git a/locked-queue.lisp b/locked-queue.lisp
index 66f435452abff46c4fc7fd1a514be45fe72d7c24..8fd9270e9769cbec8f1fbea29c6a7af3ff1a0799 100644 (file)
--- a/locked-queue.lisp
+++ b/locked-queue.lisp
@@ -13,13 +13,24 @@
 (defmethod dequeue ((q locked-queue))
   (with-slots (queue mutex waitq) q
     (with-mutex (mutex)
-      (if (or (null queue)
-             (null (first queue)))
-         (condition-wait waitq mutex))
+      (loop while (or (null queue)
+                     (null (first queue)))
+          do (condition-wait waitq mutex))
       (prog1 (first (car queue))
        (setf (car queue)
              (rest (car queue)))))))
 
+(defmethod dequeue-all ((q locked-queue))
+  (with-slots (queue mutex waitq) q
+    (with-mutex (mutex)
+      (if (or (null queue)
+             (null (first queue)))
+         (condition-wait waitq mutex))
+      (loop
+        until (null (car queue))
+        collect (car (car queue))
+        do (setf (car queue) (rest (car queue)))))))
+
 (defmethod enqueue ((q locked-queue) value)
   (with-slots (queue mutex waitq) q
     (with-mutex (mutex)
@@ -29,7 +40,6 @@
              (setf queue (cons last last))
              (condition-notify waitq))
            (progn
-             (setf (rest (cdr queue))
-                   last
+             (setf (rest (cdr queue)) last
                    (cdr queue) last)
              (cons (car queue) last)))))))