X-Git-Url: http://git.pond.sub.org/?p=eow;a=blobdiff_plain;f=locked-queue.lisp;h=8fd9270e9769cbec8f1fbea29c6a7af3ff1a0799;hp=66f435452abff46c4fc7fd1a514be45fe72d7c24;hb=76d8da840dbd8194aa41106fc7545d1661b1ae36;hpb=bf4c8fd00a49cef4ce907a341722347e640ff83b

diff --git a/locked-queue.lisp b/locked-queue.lisp
index 66f4354..8fd9270 100644
--- 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)))))))