Newer
Older
Greg Pfeil
committed
Copyright 2006, 2007 Greg Pfeil
Distributed under the MIT license (see LICENSE file)
|#
(in-package #:bordeaux-threads)
;;; documentation on the LispWorks Multiprocessing interface can be found at
;;; http://www.lispworks.com/documentation/lw445/LWUG/html/lwuser-156.htm
(defun start-multiprocessing ()
(mp:initialize-multiprocessing))
(defun %make-thread (function name)
(mp:process-run-function
name nil
(lambda ()
(let ((return-values
(multiple-value-list (funcall function))))
(setf (mp:process-private-property 'return-values (current-thread))
return-values)
(values-list return-values)))))
Greg Pfeil
committed
(defun current-thread ()
#-#.(cl:if (cl:find-symbol (cl:string '#:get-current-process) :mp) '(and) '(or))
mp:*current-process*
;; introduced in LispWorks 5.1
#+#.(cl:if (cl:find-symbol (cl:string '#:get-current-process) :mp) '(and) '(or))
(mp:get-current-process))
Greg Pfeil
committed
(defun threadp (object)
Greg Pfeil
committed
(defun thread-name (thread)
(mp:process-name thread))
;;; Resource contention: locks and recursive locks
(defun make-lock (&optional name)
(mp:make-lock :name (or name "Anonymous lock")
#-(or lispworks4 lispworks5) :recursivep
#-(or lispworks4 lispworks5) nil))
Greg Pfeil
committed
(defun acquire-lock (lock &optional (wait-p t))
(mp:process-lock lock nil
(cond ((null wait-p) 0)
((numberp wait-p) wait-p)
(t nil))))
Greg Pfeil
committed
(defun release-lock (lock)
(defmacro with-lock-held ((place) &body body)
`(mp:with-lock (,place) ,@body))
(defun make-recursive-lock (&optional name)
(mp:make-lock :name (or name "Anonymous recursive lock")
#-(or lispworks4 lispworks5) :recursivep
#-(or lispworks4 lispworks5) t))
(defun acquire-recursive-lock (lock &optional (wait-p t))
(acquire-lock lock wait-p))
(defun release-recursive-lock (lock)
(release-lock lock))
(defmacro with-recursive-lock-held ((place) &body body)
`(mp:with-lock (,place) ,@body))
;;; Resource contention: condition variables
#+(or lispworks6)
(defun make-condition-variable (&key name)
(mp:make-condition-variable :name (or name "Anonymous condition variable")))
#+(or lispworks6)
(defun condition-wait (condition-variable lock)
(mp:condition-variable-wait condition-variable lock))
#+(or lispworks6)
(defun condition-notify (condition-variable)
(mp:condition-variable-signal condition-variable))
(defun thread-yield ()
(mp:process-allow-scheduling))
;;; Introspection/debugging
Greg Pfeil
committed
(defun all-threads ()
Stelian Ionescu
committed
(defun interrupt-thread (thread function &rest args)
(apply #'mp:process-interrupt thread function args))
Greg Pfeil
committed
(defun destroy-thread (thread)
(signal-error-if-current-thread thread)
(mp:process-kill thread))
Greg Pfeil
committed
(defun thread-alive-p (thread)
(declaim (inline %join-thread))
(defun %join-thread (thread)
#-#.(cl:if (cl:find-symbol (cl:string '#:process-join) :mp) '(and) '(or))
(mp:process-wait (format nil "Waiting for thread ~A to complete" thread)
thread)
#+#.(cl:if (cl:find-symbol (cl:string '#:process-join) :mp) '(and) '(or))
(mp:process-join thread))
(defun join-thread (thread)
(%join-thread thread)
(let ((return-values
(mp:process-private-property 'return-values thread)))
(values-list return-values)))