cl-threads

• Job pools
• Threads, locks and semaphores
• Thread rules
• Tests
• License

Threads and a job system for Common Lisp on SBCL: a pool of worker threads with a parallel for, job groups and storage per worker, and the threads, locks and semaphores it is built on. It is the job system of the Pyssel engine.

(asdf:load-system :cl-threads)

(defpackage #:example
  (:use #:cl)
  (:local-nicknames (#:th #:cl-threads)))
(in-package #:example)

(defvar *numbers* (make-array 1000000 :element-type 'double-float :initial-element 0.5d0))

(th:with-job-pool (pool)
  ;; A running total for each worker, so they never share one.
  (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 *numbers*)
                     (lambda (start end)
                       (let ((total (th:worker-local-value totals)))
                         (loop for index from start below end
                               do (incf (aref total 0) (aref *numbers* index))))))
    (reduce #'+ (th:worker-local-values totals) :key (lambda (total) (aref total 0)))))
;; => 500000.0d0

Job pools

make-job-pool starts a pool of worker threads, by default one for each processor beyond the two a game engine keeps for its main and render threads. cl-threads counts the processors on Linux and Windows; elsewhere the default is one worker, so give :workers there. destroy-job-pool finishes its jobs and stops it, and with-job-pool does both around a body. Once destroying starts, the pool takes no more jobs from other threads, but it runs every job already queued or running, and the jobs those queue, before its workers stop.

• (parallel-for pool start end function) calls function with the bounds of each chunk of the range, (function chunk-start chunk-end), on the workers. It returns when all chunks are done. Chunks are four per worker unless you give :chunk-size. Once the pool is warmed up, it allocates nothing, so it suits code that runs every frame.
• A job-group, from make-job-group, counts jobs submitted together. submit-job runs a function on a worker. submit-parallel-for runs a range in chunks, like parallel-for. Both return the group at once, so the caller carries on. Later, jobs-done-p says whether the jobs have finished without waiting, and wait-for-jobs waits for them. A group can be reused once its jobs are done, and then it allocates nothing.
• A worker that waits, in parallel-for or wait-for-jobs, runs the queued jobs of what it waits for meanwhile, and no others. Jobs can therefore use parallel-for themselves, even on a pool of one worker, and wait for any group, as long as no job waits for itself through others. Any other thread, such as the render thread, blocks until its jobs are done.
• Groups take turns: an idle worker runs a job of one group, then of the next, so a group of many jobs does not hold up the groups queued after it.
• A worker keeps nothing a job referred to alive once the job counts as finished: it lets go of the job before counting it, so once wait-for-jobs returns, what the jobs used can be collected, and a sleeping worker holds nothing. SBCL takes any word on a stack that looks like a pointer for a reference, so the worker also clears the stack the job used before counting it.
• make-worker-local holds a value for each worker, such as a scratch buffer or a command pool. worker-local-value returns the calling worker's value, and worker-index the worker's number.

Workers see the global values of special variables, not the bindings of the thread that made the pool. Pass :bindings for those they need. Their standard output, error output and trace output go where the maker's go.

Work you start and never wait for is the common case in a game engine: loading assets, rasterising glyphs, compiling shaders. Submit it to a group and carry on:

(let ((group (th:submit-job (th:make-job-group pool)
                            (lambda () (decode-texture file)))))
  ;; ...other work...
  (when (th:jobs-done-p group)
    (use-the-texture)))

When a job signals an error, the pool's :on-error decides what happens:

• :signal, the default: the job is skipped and the others run. If the job's group has an error handler, the handler gets the error at once, on the worker. Otherwise wait-for-jobs signals a job-error carrying it.
• :debug: the debugger opens in the worker, with the restarts retry-job and skip-job. This is for interactive development. Functions of the same names invoke them, from a handler for instance, as continue does its restart.

Give groups that nobody will wait for an error handler, or their errors go unseen. make-job-pool's :error-handler, such as a function that logs, is the default for the groups the pool makes. (make-job-group pool :error-handler nil) keeps errors for whoever waits instead. parallel-for always waits, so its errors always come to its caller.

Threads, locks and semaphores

(make-thread function :name "audio") starts a thread, and join-thread waits for it and returns what function returned:

(th:join-thread (th:make-thread (lambda () (+ 1 2)))) ; => 3

Any number of threads may join a thread, any number of times, and each gets the values. Joining the calling thread itself signals threads-error instead of waiting forever.

An error function does not handle goes to the debugger in the thread, as any error does, so that a thread nobody joins loses none. A thread whose maker waits for its result can hand its errors over instead: made with :on-error :signal, its error unwinds function, and join-thread signals a thread-error carrying it, in every thread that joins:

(handler-case (th:join-thread (th:make-thread (lambda () (error "Boom.")) :on-error :signal))
  (th:thread-error (c) (th:thread-error-condition c))) ; => the "Boom." error

In a Lisp whose debugger is disabled, as a batch run's is, an error in a thread made without it ends the whole Lisp.

A new thread sees the global values of special variables, not the bindings of the thread that made it. :bindings gives it some of its own for its whole life, as a list of (symbol value), as make-job-pool gives its workers:

(th:make-thread #'game-loop :name "game" :bindings `((*random-state* ,(make-random-state t))))

current-thread returns the calling thread, in any thread. A thread made by make-thread knows itself from its first instruction. Any other thread, such as the initial thread or a REPL's, gets a thread the first time it asks and the same one after; thread-name and thread-finished-p describe it, but join-thread does not take it, since cl-threads did not call its function and so has no values of it to return.

(interrupt-thread thread function) makes a thread call function in the middle of whatever it is doing, then go on where it was. It is for looking at a thread, or entering the debugger in it:

(th:interrupt-thread render-thread #'break) ; the debugger shows its stack

The function runs at once even when the thread is inside a foreign call, so never leave it by a non-local exit: that would unwind the thread through the foreign code and leave it unfinished, holding what it held, such as a lock every other thread then waits for forever. In the debugger, a person chooses a restart, seeing the stack.

make-lock and with-lock give mutual exclusion, and make-semaphore, signal-semaphore and wait-on-semaphore let threads wait for each other. (make-semaphore :count 3) starts with a count, and (signal-semaphore semaphore 3) raises it by more than one. (wait-on-semaphore semaphore :timeout 0.1) gives up after a tenth of a second and returns nil; a wait that gets the semaphore returns true.

Thread rules

Every object here may be shared between threads, except a job group, which one thread at a time waits for, and the values of a worker-local, each of which belongs to its worker. Any thread may interrupt any other. A job that waits for others may have one of them run on its own worker meanwhile, using the same value, so finish with a worker's value before waiting.

Inside a job, wait for other jobs with parallel-for and wait-for-jobs, not with a semaphore. A worker blocked on a semaphore runs nothing, so if every worker waits for a signal that only a queued job would give, the pool stops.

Tests

stift test

License

MIT. See LICENSE.