git.pond.sub.org Git - eow/blob - locked-queue.lisp

   1 (in-package :locked-queue)
   2
   3 (declaim (optimize (space 0) (speed 0) (safety 3) (debug 3)))
   4
   5 (defclass locked-queue ()
   6   ((queue :initform nil)
   7    (mutex :initform (sb-thread:make-mutex :name "queue lock"))
   8    (waitq :initform (make-waitqueue))))
   9
  10 (defun create ()
  11   (make-instance 'locked-queue))
  12
  13 (defmethod dequeue ((q locked-queue))
  14   (with-slots (queue mutex waitq) q
  15     (with-mutex (mutex)
  16       (if (or (null queue)
  17               (null (first queue)))
  18           (condition-wait waitq mutex))
  19       (prog1 (first (car queue))
  20         (setf (car queue)
  21               (rest (car queue)))))))
  22
  23 (defmethod enqueue ((q locked-queue) value)
  24   (with-slots (queue mutex waitq) q
  25     (with-mutex (mutex)
  26       (let ((last (list value)))
  27         (if (null (first queue))
  28             (progn
  29               (setf queue (cons last last))
  30               (condition-notify waitq))
  31             (progn
  32               (setf (rest (cdr queue))
  33                     last
  34                     (cdr queue) last)
  35               (cons (car queue) last)))))))