Recipes
Patterns for the work a game engine does with threads. Each uses only the public API, and takes the program's pool, made once, as an argument. Its error handler logs the errors of jobs nobody waits for:
(th:make-job-pool :error-handler (lambda (condition)
(format *error-output* "~&Background job failed: ~A~%"
condition)))
The state of the work, such as a frame's bodies or a thread to stop, lives in objects the program makes and passes, not in global variables: everything in the image shares those. See Getting Started.
Updating many things every frame
Split the update across the workers. Make the chunk function and the job group once, with an object that holds what each frame gives them, so the frame allocates nothing:
(defstruct (physics (:constructor make-physics-without-chunk (group)))
"Bodies integrated each frame on a pool's workers: GROUP runs the chunks,
CHUNK integrates one, and BODIES and DT are the frame's."
(group nil :type th:job-group :read-only t)
(chunk nil :type (or null function))
(bodies #() :type simple-vector)
(dt 0.0 :type single-float))
(defun make-physics (pool)
"Return a PHYSICS that integrates on POOL's workers."
(let ((physics (make-physics-without-chunk
(th:make-job-group pool :error-handler nil))))
(setf (physics-chunk physics)
(lambda (start end)
(let ((bodies (physics-bodies physics))
(dt (physics-dt physics)))
(loop for i from start below end
do (integrate (aref bodies i) dt)))))
physics))
(defun start-physics (physics bodies dt)
"Start integrating BODIES for DT seconds on the workers, and return at once."
(setf (physics-bodies physics) bodies
(physics-dt physics) dt)
(th:submit-parallel-for (physics-group physics) 0 (length bodies) (physics-chunk physics)))
(defun finish-physics (physics)
"Wait until the work START-PHYSICS started is done."
(th:wait-for-jobs (physics-group physics))) ; signals JOB-ERROR if a chunk failed
Make the physics once, at start-up, with the program's pool. The workers read its slots, which start-physics sets before the chunks are handed out. Its group is made with :error-handler nil, so a chunk's error comes to finish-physics rather than to the pool's logging handler, and reusing the group allocates nothing.
Overlapping work with the main thread
Start the parallel part, do something else on this thread, then wait:
(defun frame (physics bodies dt)
(start-physics physics bodies dt)
(update-animations dt) ; on this thread, meanwhile
(finish-physics physics)
(draw))
Loading in the background
Submit loading jobs, keep drawing, and use the results when they are ready:
(defstruct asset
(file "" :type string)
(data nil)
(group nil))
(defun load-asset-async (pool file)
"Start loading FILE on POOL's workers, and return an ASSET whose data
arrives later."
(let ((asset (make-asset :file file)))
(setf (asset-group asset)
(th:submit-job (th:make-job-group pool)
(lambda () (setf (asset-data asset) (read-file file)))))
asset))
(defun asset-ready-p (asset)
(th:jobs-done-p (asset-group asset)))
;; In the frame, with CASTLE an asset the scene keeps:
(if (asset-ready-p castle)
(draw-model (asset-data castle))
(draw-placeholder))
Once jobs-done-p is true, the job's writes are visible to the thread that asked. The group uses the pool's error handler, so a file that fails to load is logged and the asset's data stays nil.
Loading many things, then continuing
Put all the jobs in one group and wait once:
(defun load-level (pool files)
(let ((group (th:make-job-group pool :error-handler nil))
(results (make-array (length files))))
(loop for file in files
for i from 0
do (let ((file file) (i i))
(th:submit-job group (lambda () (setf (aref results i) (read-file file))))))
(th:wait-for-jobs group) ; a JOB-ERROR here names the first failure
results))
Each job writes its own element, so they need no lock.
Reducing with per-worker accumulators
Give each worker its own accumulator, then combine them:
(defun parallel-sum (pool vector)
(let ((totals (th:make-worker-local pool (lambda (index)
(declare (ignore index))
(make-array 1 :element-type 'double-float)))))
(th:parallel-for pool 0 (length vector)
(lambda (start end)
(let ((total (th:worker-local-value totals)))
(loop for i from start below end
do (incf (aref total 0) (aref vector i))))))
(reduce #'+ (th:worker-local-values totals) :key (lambda (total) (aref total 0)))))
For a reduction run every frame, make the worker-local once and zero its values before each run.
A queue between threads
A lock guards the items, and a semaphore counts them, so a consumer sleeps until there is something to take:
(defstruct (mailbox (:constructor make-mailbox ()))
(items '())
(lock (th:make-lock "mailbox"))
(available (th:make-semaphore)))
(defun post (mailbox item)
(th:with-lock ((mailbox-lock mailbox))
(setf (mailbox-items mailbox) (append (mailbox-items mailbox) (list item))))
(th:signal-semaphore (mailbox-available mailbox)))
(defun receive (mailbox &key timeout)
"Return the oldest item, or NIL if none arrives within TIMEOUT seconds."
(when (th:wait-on-semaphore (mailbox-available mailbox) :timeout timeout)
(th:with-lock ((mailbox-lock mailbox))
(pop (mailbox-items mailbox)))))
;; A consumer thread that stops on :STOP, or after a second with nothing to do:
(let* ((mailbox (make-mailbox))
(consumer (th:make-thread
(lambda ()
(loop for item = (receive mailbox :timeout 1)
until (or (null item) (eq item :stop))
do (handle item)))
:name "consumer")))
(dolist (item '(1 2 3 :stop)) (post mailbox item))
(th:join-thread consumer))
A render thread that receives draw commands, or an audio thread that receives sound events, works this way. For a queue used every frame, replace the list with a ring buffer so posting allocates nothing.
A thread of your own with a clean shutdown
A long-lived thread that runs until told to stop, kept in an object with the semaphore that tells it:
(defstruct (audio (:constructor make-audio (stop thread)))
"A thread that mixes audio, and the semaphore that tells it to stop."
(stop nil :read-only t)
(thread nil :read-only t))
(defun start-audio ()
"Start a thread that mixes audio until STOP-AUDIO, and return its AUDIO."
(let ((stop (th:make-semaphore)))
(make-audio stop (th:make-thread (lambda ()
(loop until (th:wait-on-semaphore stop :timeout 0)
do (mix-audio-block)))
:name "audio"))))
(defun stop-audio (audio)
"Tell AUDIO's thread to stop, and wait until it has."
(th:signal-semaphore (audio-stop audio))
(th:join-thread (audio-thread audio)))
Polling the semaphore with a timeout of 0 never waits and allocates nothing. join-thread returns once the loop has finished its last block.