Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
57 lines (49 sloc) 1.66 KB
(defpackage "MPSC-QUEUE"
(:use "CL" "SB-EXT")
(:shadow cl:get)
(:export "QUEUE" "P" "MAKE" "PUT" "GET" "P"))
(in-package "MPSC-QUEUE")
(defstruct (queue
(:constructor %make-queue (head)))
(head nil :type list)
(tail nil :type list))
(declaim (inline p))
(defun p (x)
(queue-p x))
(defun slow-get (queue)
(declare (type queue queue))
(let ((head (queue-head queue)))
(when head (return-from slow-get head)))
(let ((tail (loop ; stupid. It's just an xchg
(let ((tail (queue-tail queue)))
(when (eql (cas (queue-tail queue) tail nil)
(return tail))))))
(setf (queue-head queue) (reverse tail))))
(declaim (inline get put))
(defun get (queue &optional default)
(declare (type queue queue))
(let ((head (queue-head queue)))
(cond ((or head
(setf head (slow-get queue)))
(destructuring-bind (value . next) head
(setf (queue-head queue) next
(car head) nil
(cdr head) nil)
(values value t)))
(values default nil)))))
(defun put (queue value)
(declare (type queue queue))
(let ((cons (list value)))
(let ((tail (queue-tail queue)))
(setf (cdr cons) tail)
(when (eql tail (cas (queue-tail queue) tail cons))
(return value))))))
(declaim (notinline get put))
(defun make (&optional initial-contents constructor &rest args)
(let ((contents (coerce initial-contents 'list)))
(if constructor
(apply constructor :head contents :tail nil args)
(%make-queue initial-contents))))
Jump to Line
Something went wrong with that request. Please try again.