Add dequeue-all method
authorGerd Flaig <gefla@pond.sub.org>
Sun, 26 Apr 2009 13:25:34 +0000 (15:25 +0200)
committerGerd Flaig <gefla@pond.sub.org>
Sun, 26 Apr 2009 13:25:34 +0000 (15:25 +0200)
locked-queue.lisp
package.lisp

index 66f435452abff46c4fc7fd1a514be45fe72d7c24..d225faccc7e7242eb998dcfe897802e70efe3da8 100644 (file)
        (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)))))))
index 5ba1030c80e277d95f858f7df7f32e1d2f252e6c..f7a01797d141f1e53670dfea8507ba9f0385a4f5 100644 (file)
@@ -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))