Dear Marc,
I suppose the code
(let* ((end-condvar (macro-thread-end-condvar thread)) (exception? (macro-thread-exception? thread)) (result (macro-thread-result thread))) (cond ((not end-condvar) ;; thread has terminated (if exception? (begin ;; thread has terminated with exception (display "Terminated with exception:\n") (display-exception result)) (begin ;; thread has terminated with result (display "Terminated with result:\n") (pretty-print result)))) (exception? ;; thread has never run and is not terminated (if (not result) (begin ;; thread is not yet started (display "Not yet started\n")) (begin ;; thread is started but has not yet run (display "Started but has not yet run\n")))) (else (let ((c (##thread-continuation-capture thread))) ; See note above (cond ((and max-head max-tail) (display-continuation-backtrace c (current-output-port) #f display-environment max-head max-tail)) (max-head (display-continuation-backtrace c (current-output-port) #f display-environment max-head)) (else (display-continuation-backtrace c (current-output-port) #f display-environment))) ))))
is not threadsafe, as if the thread terminates between the macro-* calls and ##thread-continuation-capture, a "Thread is not active" exception is thrown by the latter.
As a means to solve this, I suppose that putting the macro-* and ##thread-continuation-capture calls closer to each other and making that block (declare (not enable-interrupts)) or alike would be useless as the last call requires the thread system to iterate.
Therefore I'd suppose the best way to make it threadsafe would be the one below, would you agree with this?
(let loop ()
; Quantum manipulation just to ensure get a consistent snapshot
(define quantum-pre (thread-quantum (current-thread)))
(thread-quantum-set! (current-thread) +inf.0)
(let* ((end-condvar (macro-thread-end-condvar thread))
(exception? (macro-thread-exception? thread))
(result (macro-thread-result thread)))
(thread-quantum-set! (current-thread) quantum-pre)
(cond ((not end-condvar)
;; thread has terminated
(if exception?
(begin
;; thread has terminated with exception
(display "Terminated with exception:\n")
(display-exception result))
(begin
;; thread has terminated with result
(display "Terminated with result:\n")
(pretty-print result))))
(exception?
;; thread has never run and is not terminated
(if (not result)
(begin
;; thread is not yet started
(display "Not yet started\n"))
(begin
;; thread is started but has not yet run
(display "Started but has not yet run\n"))))
(else
(let ((c (with-exception-catcher
(lambda (e) (loop))
(lambda () (##thread-continuation-capture thread))))) ; See note above
(cond ((and max-head max-tail)
(display-continuation-backtrace c (current-output-port) #f display-environment max-head max-tail))
(max-head
(display-continuation-backtrace c (current-output-port) #f display-environment max-head))
(else
(display-continuation-backtrace c (current-output-port) #f display-environment)))
)))))
Secondarily, could the thread quantum manipulation safely be replaced with declare /not/ interrupts-enabled, i.e., could the record accessors cause thread interrupt?
Kind regards,
Mikael