called via @code{with-continuation-barrier}. When @var{handler} is specified, then @var{thunk} is called from within a @code{catch} with tag @code{#t} that has @var{handler} as its handler. This catch is established inside the continuation barrier. Once @var{thunk} or @var{handler} returns, the return value is made the @emph{exit value} of the thread and the thread is terminated." (let ((cv (make-condition-variable)) (mutex (make-mutex)) (thunk (if handler (lambda () (catch #t thunk handler)) thunk)) (thread #f)) (define (call-with-backtrace thunk) (let ((err (current-error-port))) (catch #t (lambda () (%start-stack 'thread thunk)) (lambda _ (values)) (lambda (key . args) ;; Narrow by three: the dispatch-exception, ;; this thunk, and make-stack. (let ((stack (make-stack #t 3))) (false-if-exception (begin (when stack (display-backtrace stack err)) (let ((frame (and stack (stack-ref stack 0)))) (print-exception err frame key args))))))))) (with-mutex mutex (%call-with-new-thread (lambda () (call-with-values (lambda () (call-with-prompt cancel-tag (lambda () (lock-mutex mutex) (set! thread (current-thread)) ;; Rather than use the 'set!' syntax here, we use the ;; underlying 'setter' generic function to set the ;; 'thread-join-data' property on 'thread'. This is ;; because 'set!' will try to resolve 'setter' in the ;; '(guile)' module, which means acquiring the ;; 'autoload' mutex. If the calling thread is ;; already holding that mutex, this will result in ;; deadlock. See . ((setter thread-join-data) thread (cons cv mutex)) (signal-condition-variable cv) (unlock-mutex mutex) (call-with-unblocked-asyncs (lambda () (call-with-backtrace thunk)))) (lambda (k . args) (apply values args)))) (lambda vals (lock-mutex mutex) ;; Probably now you're wondering why we are going to use ;; the cond variable as the key into the thread results ;; object property. It's because there is a possibility ;; that the thread object itself ends up as part of the ;; result, and if that happens we create a cycle whereby ;; the strong reference to a thread in the value of the ;; weak-key hash table used by the object property prevents ;; the thread from ever being collected. So instead we use ;; the cv as the key. Weak-key hash tables, amirite? (set! (%thread-results cv) vals) (broadcast-condition-variable cv) (unlock-mutex mutex) (apply values vals))))) (let lp () (unless thread (wait-condition-variable cv mutex) (lp)))) thread)) (define* (join-thread thread #:optional timeout timeoutval) "Suspend execution of the calling thread until the target @var{thread} terminates, unless the target @var{thread} has already terminated." (match (thread-join-data thread) (#f (error "foreign thread cannot be joined" thread)) ((cv . mutex) (lock-mutex mutex) (let lp () (cond ((%thread-results cv) => (lambda (results) (unlock-mutex mutex) (apply values results))) ((if timeout (wait-condition-variable cv mutex timeout) (wait-condition-variable cv mutex)) (lp)) (else (unlock-mutex mutex) timeoutval)))))) (define* (try-mutex mutex) "Try to lock @var{mutex}. If the mutex is already locked, return @code{#f}. Otherwise lock the mutex and return @code{#t}." (lock-mutex mutex 0))