Dear Marc,<br><br>I suppose the code<br><pre>(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)))
))))<br><br><font style="font-family:arial,helvetica,sans-serif" size="2">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.<br>
<br>As a means to solve this, I suppose that </font><font style="font-family:arial,helvetica,sans-serif" size="2">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.<br>
<br>Therefore I'd suppose the best way to make it threadsafe would be the one below, would you agree with this?<br></font><font style="font-family:arial,helvetica,sans-serif" size="2"><font size="1"><br style="font-family:courier new,monospace">
<span style="font-family:courier new,monospace">(let loop ()</span><br style="font-family:courier new,monospace"><span style="font-family:courier new,monospace"> ; Quantum manipulation just to ensure get a consistent snapshot<br>
(define quantum-pre (thread-quantum (current-thread)))</span><br style="font-family:courier new,monospace"><span style="font-family:courier new,monospace"> (thread-quantum-set! (current-thread) +inf.0)</span><br style="font-family:courier new,monospace">
<span style="font-family:courier new,monospace"> (let* ((end-condvar (macro-thread-end-condvar thread))</span><br style="font-family:courier new,monospace"><span style="font-family:courier new,monospace"> (exception? (macro-thread-exception? thread))</span><br style="font-family:courier new,monospace">
<span style="font-family:courier new,monospace"> (result (macro-thread-result thread)))</span><br style="font-family:courier new,monospace"><span style="font-family:courier new,monospace"> (thread-quantum-set! (current-thread) quantum-pre)</span><br style="font-family:courier new,monospace">
<span style="font-family:courier new,monospace"> (cond ((not end-condvar)</span><br style="font-family:courier new,monospace"><span style="font-family:courier new,monospace"> ;; thread has terminated</span><br style="font-family:courier new,monospace">
<span style="font-family:courier new,monospace"> (if exception?</span><br style="font-family:courier new,monospace"><span style="font-family:courier new,monospace"> (begin</span><br style="font-family:courier new,monospace">
<span style="font-family:courier new,monospace"> ;; thread has terminated with exception</span><br style="font-family:courier new,monospace"><span style="font-family:courier new,monospace"> (display "Terminated with exception:\n")</span><br style="font-family:courier new,monospace">
<span style="font-family:courier new,monospace"> (display-exception result))</span><br style="font-family:courier new,monospace"><span style="font-family:courier new,monospace"> (begin</span><br style="font-family:courier new,monospace">
<span style="font-family:courier new,monospace"> ;; thread has terminated with result</span><br style="font-family:courier new,monospace"><span style="font-family:courier new,monospace"> (display "Terminated with result:\n")</span><br style="font-family:courier new,monospace">
<span style="font-family:courier new,monospace"> (pretty-print result))))</span><br style="font-family:courier new,monospace"><span style="font-family:courier new,monospace"> (exception?</span><br style="font-family:courier new,monospace">
<span style="font-family:courier new,monospace"> ;; thread has never run and is not terminated</span><br style="font-family:courier new,monospace"><span style="font-family:courier new,monospace"> (if (not result)</span><br style="font-family:courier new,monospace">
<span style="font-family:courier new,monospace"> (begin</span><br style="font-family:courier new,monospace"><span style="font-family:courier new,monospace"> ;; thread is not yet started</span><br style="font-family:courier new,monospace">
<span style="font-family:courier new,monospace"> (display "Not yet started\n"))</span><br style="font-family:courier new,monospace"><span style="font-family:courier new,monospace"> (begin</span><br style="font-family:courier new,monospace">
<span style="font-family:courier new,monospace"> ;; thread is started but has not yet run</span><br style="font-family:courier new,monospace"><span style="font-family:courier new,monospace"> (display "Started but has not yet run\n"))))</span><br style="font-family:courier new,monospace">
<span style="font-family:courier new,monospace"> (else</span><br style="font-family:courier new,monospace"><span style="font-family:courier new,monospace"> (let ((c <span style="background-color:rgb(255,255,153)">(with-exception-catcher</span></span><br style="font-family:courier new,monospace;background-color:rgb(255,255,153)">
<span style="font-family:courier new,monospace;background-color:rgb(255,255,153)"> (lambda (e) (loop))</span><br style="font-family:courier new,monospace;background-color:rgb(255,255,153)"><span style="font-family:courier new,monospace"><span style="background-color:rgb(255,255,153)"> (lambda () (##thread-continuation-capture thread)))))</span> ; See note above</span><br style="font-family:courier new,monospace">
<span style="font-family:courier new,monospace"></span><span style="font-family:courier new,monospace"> (cond ((and max-head max-tail)</span><br style="font-family:courier new,monospace"><span style="font-family:courier new,monospace"> (display-continuation-backtrace c (current-output-port) #f display-environment max-head max-tail))</span><br style="font-family:courier new,monospace">
<span style="font-family:courier new,monospace"> (max-head</span><br style="font-family:courier new,monospace"><span style="font-family:courier new,monospace"> (display-continuation-backtrace c (current-output-port) #f display-environment max-head))</span><br style="font-family:courier new,monospace">
<span style="font-family:courier new,monospace"> (else</span><br style="font-family:courier new,monospace"><span style="font-family:courier new,monospace"> (display-continuation-backtrace c (current-output-port) #f display-environment)))</span><br style="font-family:courier new,monospace">
<span style="font-family:courier new,monospace"> )))))</span></font><br><br>Secondarily, could the thread quantum manipulation safely be replaced with declare /not/ interrupts-enabled, i.e., could the record accessors cause thread interrupt?<br>
<br>Kind regards,<br>Mikael<br></font><br></pre>