Send updates in chunks
[eow] / 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 dequeue-all ((q locked-queue))
24   (with-slots (queue mutex waitq) q
25     (with-mutex (mutex)
26       (if (or (null queue)
27               (null (first queue)))
28           (condition-wait waitq mutex))
29       (loop
30          until (null (car queue))
31          collect (car (car queue))
32          do (setf (car queue) (rest (car queue)))))))
33
34 (defmethod enqueue ((q locked-queue) value)
35   (with-slots (queue mutex waitq) q
36     (with-mutex (mutex)
37       (let ((last (list value)))
38         (if (null (first queue))
39             (progn
40               (setf queue (cons last last))
41               (condition-notify waitq))
42             (progn
43               (setf (rest (cdr queue)) last
44                     (cdr queue) last)
45               (cons (car queue) last)))))))