Add dequeue-all method

diff --git a/locked-queue.lisp b/locked-queue.lisp
index 66f435452abff46c4fc7fd1a514be45fe72d7c24..d225faccc7e7242eb998dcfe897802e70efe3da8 100644 (file)
--- a/locked-queue.lisp
+++ b/locked-queue.lisp
@@ -20,6 +20,17 @@
        (setf (car queue)
              (rest (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)
 (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 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)))))))
                    (cdr queue) last)
              (cons (car queue) last)))))))

diff --git a/package.lisp b/package.lisp
index 5ba1030c80e277d95f858f7df7f32e1d2f252e6c..f7a01797d141f1e53670dfea8507ba9f0385a4f5 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -14,7 +14,7 @@
             :command))
   (defpackage :locked-queue
     (:use :cl :sb-thread)
             :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))
   (defpackage :empire-web
     (:use :cl)
     (:export :start :send :prompt :data))