diff --git a/bordeaux-threads.asd b/bordeaux-threads.asd index e31c7e5..157d338 100644 --- a/bordeaux-threads.asd +++ b/bordeaux-threads.asd @@ -49,7 +49,7 @@ Distributed under the MIT license (see LICENSE file) #+(and thread-support scl) "impl-scl") #+(and thread-support lispworks (not lispworks6)) (:file "impl-lispworks-condition-variables") - #+(and thread-support (or armedbear digitool)) + #+(and thread-support digitool) (:file "condition-variables") (:file "default-implementations")))) :in-order-to ((asdf:test-op (asdf:load-op bordeaux-threads-test))) diff --git a/src/impl-abcl.lisp b/src/impl-abcl.lisp index 8a2495e..55816c0 100644 --- a/src/impl-abcl.lisp +++ b/src/impl-abcl.lisp @@ -12,7 +12,7 @@ Distributed under the MIT license (see LICENSE file) ;;; src/org/armedbear/lisp/LispThread.java (deftype thread () - 'ext:thread) + 'threads:thread) ;;; Thread Creation @@ -32,22 +32,43 @@ Distributed under the MIT license (see LICENSE file) (defun make-lock (&optional name) (declare (ignore name)) - (threads:make-thread-lock)) + (threads:make-mutex)) (defun acquire-lock (lock &optional (wait-p t)) (declare (ignore wait-p)) - (threads:thread-lock lock)) + (threads:get-mutex lock)) (defun release-lock (lock) - (threads:thread-unlock lock)) + (threads:release-mutex lock)) (defmacro with-lock-held ((place) &body body) - `(threads:with-thread-lock (,place) ,@body)) + `(threads:with-mutex (,place) ,@body)) ;;; Resource contention: condition variables +(defstruct condition-variable + name + lock + active) + +(defun condition-wait (condition lock) + (check-type condition condition-variable) + (setf (condition-variable-active condition) nil) + (release-lock lock) + (do () + ((when (condition-variable-active condition) + (acquire-lock lock) + t)) + (thread-yield))) + +(defun condition-notify (condition) + (check-type condition condition-variable) + (with-lock-held ((condition-variable-lock condition)) + (setf (condition-variable-active condition) t))) + + (defun thread-yield () - (sleep 0)) + (sleep 0.01)) ;;; Introspection/debugging