Lock to allow n times to acquire
(defpackage #:lock-pool | |
(:use #:cl) | |
(:import-from #:bordeaux-threads) | |
(:import-from #:alexandria | |
#:once-only) | |
(:export #:lock-pool | |
#:make-lock-pool | |
#:acquire-lock-in-pool | |
#:release-lock-in-pool | |
#:with-lock-pool-held)) | |
(in-package #:lock-pool) | |
(defstruct (lock-pool (:constructor %make-lock-pool)) | |
(size 0) | |
(limit 0) | |
(lock (bt:make-recursive-lock)) | |
(condvar (bt:make-condition-variable))) | |
(defun make-lock-pool (size) | |
(%make-lock-pool :size size)) | |
(defun acquire-lock-in-pool (pool) | |
(with-slots (size limit lock condvar) pool | |
(bt:with-recursive-lock-held (lock) | |
(if (= size limit) | |
(progn | |
(bt:condition-wait condvar lock) | |
(acquire-lock-in-pool pool)) | |
(incf limit))))) | |
(defun release-lock-in-pool (pool) | |
(with-slots (size limit lock condvar) pool | |
(when (= limit 0) | |
(return-from release-lock-in-pool nil)) | |
(bt:with-recursive-lock-held (lock) | |
(let ((should-notify (= limit size))) | |
(decf limit) | |
(when should-notify | |
(bt:condition-notify condvar)) | |
t)))) | |
(defmacro with-lock-pool-held ((pool) &body body) | |
(once-only (pool) | |
`(progn | |
(acquire-lock-in-pool ,pool) | |
(unwind-protect (progn ,@body) | |
(release-lock-in-pool ,pool))))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment