From: Gerd Flaig <gefla@pond.sub.org>
Date: Sun, 26 Apr 2009 13:25:34 +0000 (+0200)
Subject: Add dequeue-all method
X-Git-Url: http://git.pond.sub.org/?p=eow;a=commitdiff_plain;h=e0b3c3178cfd2a720f98655f8c3bc91400f1b6ee;hp=da68168514dece00971f1e317b3cb63ebc2daa73

Add dequeue-all method
---

diff --git a/locked-queue.lisp b/locked-queue.lisp
index 66f4354..d225fac 100644
--- a/locked-queue.lisp
+++ b/locked-queue.lisp
@@ -20,6 +20,17 @@
 	(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)))))))
diff --git a/package.lisp b/package.lisp
index 5ba1030..f7a0179 100644
--- a/package.lisp
+++ b/package.lisp
@@ -14,7 +14,7 @@
 	     :command))
   (defpackage :locked-queue
     (:use :cl :sb-thread)
-    (:export :create :enqueue :dequeue))
+    (:export :create :enqueue :dequeue :dequeue-all))
   (defpackage :empire-web
     (:use :cl)
     (:export :start :send :prompt :data))