42 lines
1.6 KiB
Common Lisp
42 lines
1.6 KiB
Common Lisp
#|
|
|
This file is a part of stoe project.
|
|
Copyright (c) 2014 Renaud Casenave-Péré (renaud@casenave-pere.fr)
|
|
|#
|
|
|
|
(uiop:define-package :stoe/core/thread
|
|
(:use :cl :alexandria)
|
|
(:recycle :bordeaux-threads)
|
|
(:export #:thread #:make-thread #:current-thread #:threadp #:thread-name
|
|
#:*default-special-bindings*
|
|
#:make-lock #:acquire-lock #:release-lock #:with-lock-held
|
|
#:make-recursive-lock #:acquire-recursive-lock
|
|
#:release-recursive-lock #:with-recursive-lock-held
|
|
#:make-condition-variable #:condition-wait #:condition-notify
|
|
#:with-timeout #:timeout
|
|
#:all-threads #:interrupt-thread #:destroy-thread #:thread-alive-p
|
|
#:join-thread #:thread-yield))
|
|
(in-package :stoe/core/thread)
|
|
|
|
(defmacro with-lock-held ((place &optional (waitp t)) &body body)
|
|
(once-only (place)
|
|
`(when (acquire-lock ,place ,waitp)
|
|
(unwind-protect
|
|
(progn
|
|
,@body)
|
|
(release-lock ,place)))))
|
|
|
|
;;; Functions not implemented by bordeaux-threads
|
|
|
|
;; (defun condition-broadcast (queue)
|
|
;; "Notify all threads waiting on `queue'."
|
|
;; #+(and sbcl sb-thread) (sb-thread:condition-broadcast queue)
|
|
;; #-(and sbcl sb-thread) (error-implementation-unsupported))
|
|
|
|
;; (defmacro atomic-set-flag (place flag)
|
|
;; "Set the variable pointed to by `place' to the value `flag' atomically."
|
|
;; #+ (and sbcl sb-thread)
|
|
;; `(flet ((set-flag (flag place)
|
|
;; (declare (ignore place))
|
|
;; flag))
|
|
;; (sb-ext:atomic-update ,place #'set-flag ,flag))
|
|
;; #- (and sbcl sb-thread) (error-implemntation-unsupported))
|