Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
lock-free queue
(defpackage lock-free-queue
(:use :common-lisp)
(:export queue
make
enq
deq
empty-p
element-count
to-list))
(in-package :lock-free-queue)
;; compare-and-swap: 成功した場合はTを、失敗した場合はNILを返す
(defmacro compare-and-swap (place old new)
`(eq (sb-ext:compare-and-swap ,place ,old ,new) ,old))
;; キュー構造体
(defstruct queue
(head nil :type list)
(tail nil :type list))
;; リストへ変換/空判定/要素数取得
(defun to-list (que) (copy-seq (cdr (queue-head que))))
(defun empty-p (que) (endp (cdr (queue-head que))))
(defun element-count (que) (length (cdr (queue-head que))))
(defmethod print-object ((o queue) stream)
(print-unreadable-object (o stream :type t)
(format stream "~s ~s" :count (element-count o))))
;; キューを生成
(defun make (&optional initial-contents)
(let ((contents (cons :initial-head initial-contents)))
(make-queue :head contents
:tail (last contents))))
;; キューの末尾に要素を追加する
;; => queue
(defun enq (x que)
(loop WITH new-elem = (list x)
FOR tail = (queue-tail que)
DO
(cond ((cdr tail)
(compare-and-swap (queue-tail que) tail (cdr tail))) ; tailの位置を調整
((compare-and-swap (cdr tail) nil new-elem)
(return que))))) ; 追加成功
;; キューの先頭から要素を取り出す
;; => (or (values 先頭要素 T) ; キューに要素がある場合
;; (values NIL NIL)) ; キューが空の場合
(defun deq (que)
(let* ((head (queue-head que))
(next (cdr head)))
(cond ((null next)
(values nil nil)) ;
((compare-and-swap (queue-head que) head next)
(values (car next) t)) ; 取得成功
(t
(deq que))))) ; 他スレッドと競合(リトライ)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment