Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
66 lines (57 sloc) 2.67 KB
(in-package #:eager-future2)
(defvar *task-queue-lock* (make-lock "Eager Future2 thread pool lock"))
(defvar *leader-notifier* (make-condition-variable :name "Eager Future2 leader notifier"))
(defvar *task-queue* ())
(defvar *free-threads* 0)
(defvar *thread-counter-lock* (make-recursive-lock "Eager Future2 thread pool total thread counter lock"))
(defvar *total-threads* 0)
(defun make-pool-thread ()
(lambda ()
(catch 'die
(let ((*debugger-hook* (lambda (c old-hook)
(declare (ignore c old-hook))
(throw 'continue nil))))
(loop (catch 'continue
(funcall (with-lock-held (*task-queue-lock*)
(incf *free-threads*)
(loop (if *task-queue*
(return (pop *task-queue*))
(condition-wait *leader-notifier* *task-queue-lock*)))
(decf *free-threads*))))))))
(with-recursive-lock-held (*thread-counter-lock*) (decf *total-threads*))))
:name "Eager Future2 Worker")
(with-recursive-lock-held (*thread-counter-lock*) (incf *total-threads*)))
(defun thread-pool-size ()
"Returns the current number of threads in the thread pool. This
number determines the maximum amount of speculative futures that can
be computed at the same time."
(with-recursive-lock-held (*thread-counter-lock*)
(defun advise-thread-pool-size (new-size)
"Attempts to set the amount of threads in the thread pool to given value."
(with-recursive-lock-held (*thread-counter-lock*)
(if (< *total-threads* new-size)
(loop repeat (- new-size *total-threads*) do (make-pool-thread))
(with-lock-held (*task-queue-lock*)
(loop repeat (- *total-threads* new-size) do
(push (lambda () (throw 'die nil)) *task-queue*)
(condition-notify *leader-notifier*))))))
(eval-when (:load-toplevel)
(advise-thread-pool-size 10))
(defun schedule-last (task)
(with-lock-held (*task-queue-lock*)
(setf *task-queue* (append *task-queue* (list task)))
(when (< 0 *free-threads*)
(condition-notify *leader-notifier*)))
(defun schedule-immediate (task)
(unless (with-lock-held (*task-queue-lock*)
(when (< 0 *free-threads*)
(setf *task-queue* (push task *task-queue*))
(condition-notify *leader-notifier*)
(make-thread task :name "Eager Future2 Temporary Worker"))