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>