<font face="courier new, monospace">(dump-threads)</font> uses <font face="courier new, monospace">##thread-continuation-capture</font> to get the current continuation of a target thread.<div><br></div><div>This presumes that the target thread has been started, if it has not <font face="courier new, monospace">##thread-continuation-capture</font> causes SIGSEGV.</div>

<div><br></div><div>Checking for if it has been started requires access to thread object fields that are not exported currently, and thus to do this right now you need to make a hack consisting of copying out the thread structure's definition into your code and doing the check there - this is not version safe.</div>

<div><br></div><div>I propose the introduction in Gambit of a procedure</div><div><br></div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div><font face="courier new, monospace">(##thread-status thread)</font></div>

<div><font face="courier new, monospace">=> </font><span style="font-family:'courier new',monospace">list ('created) = The thread has not yet been started</span></div><div><font face="courier new, monospace">   list ('starting) = The thread has been started but execution has not yet begun</font></div>

<div><font face="courier new, monospace">   list ('running) = The thread is running</font></div><div><font face="courier new, monospace">   list ('ended result) = The thread terminated ordinarily, with the return value result</font></div>

<div><font face="courier new, monospace">   list ('ended/exception exception) = The thread terminated with the exception exception</font></div></blockquote><div><br></div><div>as the definition is quite short and its presence enables the programmer to without hacks reliably dump threads, which is like a core thing for debug.</div>

<div><br></div><div>Here follows a definition for inclusion into Gambit, based on an email Marc sent 2011-12-16, quoted below:</div><div><br></div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div><font face="courier new, monospace">(define (##thread-status thread #!optional capture-continuation-if-running?)</font></div>

<div><font face="courier new, monospace">  </font></div><div><font face="courier new, monospace">  (let loop ()</font></div><div><font face="courier new, monospace">  </font></div><div><font face="courier new, monospace">    ; Make snapshot of thread state</font></div>

<div><font face="courier new, monospace">    ; Quantum manipulation just to ensure get a consistent snapshot</font></div><div><font face="courier new, monospace">    (define quantum-pre (thread-quantum (current-thread)))</font></div>

<div><font face="courier new, monospace">    (thread-quantum-set! (current-thread) +inf.0)</font></div><div><font face="courier new, monospace">    (let* ((end-condvar (macro-thread-end-condvar thread))</font></div><div>
<font face="courier new, monospace">           (exception?  (macro-thread-exception?  thread))</font></div>
<div><font face="courier new, monospace">           (result      (macro-thread-result      thread)))</font></div><div><font face="courier new, monospace">      (thread-quantum-set! (current-thread) quantum-pre)</font></div>

<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">      ; Generate return value</font></div><div><font face="courier new, monospace">      (cond ((not end-condvar)</font></div>

<div><font face="courier new, monospace">             ;; Thread has terminated</font></div><div><font face="courier new, monospace">             (if exception?</font></div><div><font face="courier new, monospace">                 ;; Thread has terminated with exception</font></div>

<div><font face="courier new, monospace">                 (list 'ended/exception result)</font></div><div><font face="courier new, monospace">                 ;; Thread has terminated with result</font></div><div><font face="courier new, monospace">                 (list 'ended result)))</font></div>

<div><font face="courier new, monospace">            (exception?</font></div><div><font face="courier new, monospace">             ;; Thread has never run and is not terminated</font></div><div><font face="courier new, monospace">             (if (not result)</font></div>

<div><font face="courier new, monospace">                 ;; Thread is not yet started</font></div><div><font face="courier new, monospace">                 (list 'created)</font></div><div><font face="courier new, monospace">                 ;; Thread is started but has not yet run</font></div>

<div><font face="courier new, monospace">                 (list 'starting)))</font></div><div><font face="courier new, monospace">            (else</font></div><div><font face="courier new, monospace">             (if </font><span style="font-family:'courier new',monospace">capture-continuation-if-running?</span></div>

<div><font face="courier new, monospace">                 (let ((continuation</font></div><div><font face="courier new, monospace">                        (with-exception-catcher</font></div><div><font face="courier new, monospace">                         (lambda (e) (loop))</font></div>

<div><font face="courier new, monospace">                         (lambda () (capture-continuation-if-running? thread)))))</font></div><div><font face="courier new, monospace">                   (list 'running continuation)</font></div>

<div><font face="courier new, monospace">                   (list 'running))))))))</font></div></blockquote><div><br></div><div><div>Use would look something like:</div><div><br></div><div><blockquote style="margin:0px 0px 0px 40px;border:none;padding:0px">

<font face="courier new, monospace">> (define t (make-thread (lambda () (thread-sleep! 5))))<br>> (##thread-status t)<br>(created)<br>> (thread-start! t)<br>> (##thread-status t)<br>(running)<br>> (thread-sleep! 5)<br>

> (##thread-status t)<br>(ended #!void)</font></blockquote></div><div><br></div></div><div>With such a definition, a (dump-threads) could be defined as easy as:</div><div><br></div><div><blockquote style="margin:0 0 0 40px;border:none;padding:0px">

<div><div><font face="courier new, monospace">(define (dump-threads #!key threads thread-group thread #!rest display-continuation-backtrace-args)</font></div><div><font face="courier new, monospace">  (map (lambda (thread)</font></div>

<div><font face="courier new, monospace">         (let loop ()</font></div><div><font face="courier new, monospace">           (let ((status (##thread-status thread #t)))</font></div><div><font face="courier new, monospace">             (if (eq? (car status) 'running)</font></div>

<div><font face="courier new, monospace">                 (list 'running (call-with-output-string</font></div><div><font face="courier new, monospace">                                 '()</font></div><div><font face="courier new, monospace">                                 (lambda (port) (apply display-continuation-backtrace</font></div>

<div><font face="courier new, monospace">                                                       `(,(cadr status) ; = continuation</font></div><div><font face="courier new, monospace">                                                         ,port</font></div>

<div><font face="courier new, monospace">                                                         .,display-continuation-backtrace-args)))))</font></div><div><font face="courier new, monospace">                 status))))</font></div>

<div><font face="courier new, monospace">       (or threads (thread-group->thread-list (or thread-group (thread-thread-group (or thread (current-thread))))))))</font></div></div></blockquote></div><div><br></div><div>
Please feel free to provide feedback.</div>
<div><br></div><div>Brgds, Mikael<br><br><div class="gmail_quote">2011/12/16 Marc Feeley<br><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left-width:1px;border-left-color:rgb(204,204,204);border-left-style:solid;padding-left:1ex">

<div class="im"><br>On 2011-12-15, at 6:22 PM, Mikael wrote:<br><br></div></blockquote><div>[..] </div><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left-width:1px;border-left-color:rgb(204,204,204);border-left-style:solid;padding-left:1ex">

<div class="im">> Aha, that is good to be aware of - before running ##thread-continuation-capture on a thread, how can i check it's started (as to safeguard from this)?<br><br></div>The attached code checks for all possible states of a thread.  Please try to dump the state of your threads with it to see if the segmentation fault goes away.<br>

<br>(##include "~~lib/_gambit#.scm")<br><br>(define (dump-thread thread)<br><br>  (write thread)<br><br>  (let* ((end-condvar (macro-thread-end-condvar thread))<br>         (exception? (macro-thread-exception? thread))<br>

         (result (macro-thread-result thread)))<br>    (cond ((not end-condvar)<br>           ;; thread has terminated<br>           (if exception?<br>               (begin<br>                 ;; thread has terminated with exception<br>

                 (display " is terminated with exception:\n")<br>                 (display-exception result))<br>               (begin<br>                 ;; thread has terminated with result<br>                 (display " is terminated with result:\n")<br>

                 (pretty-print result))))<br>          (exception?<br>           ;; thread has never run and is not terminated<br>           (if (not result)<br>               (begin<br>                 ;; thread is not yet started<br>

                 (display " is not yet started\n"))<br>               (begin<br>                 ;; thread is started but has not yet run<br>                 (display " is started but has not yet run\n"))))<br>

          (else<br>           ;; thread is started and has run<br>           (let ((c (##thread-continuation-capture thread)))<br>             (display " is running with continuation:\n")<br>             (display-continuation-backtrace c)))))<br>

<br>  (newline))<br><br>(define t2 (make-thread (lambda () 222)))<br>(define t3 (make-thread (lambda () 333)))<br>(define t4 (make-thread (lambda () (/ 1 0))))<br>(define t5 (make-thread (lambda () 555)))<br><br>(thread-start! t3)<br>

(thread-start! t4)<br><br>(thread-sleep! 0.01)<br><br>(dump-thread (current-thread))<br>(dump-thread t2)<br>(dump-thread t3)<br>(dump-thread t4)<br>(thread-start! t5)<br>(dump-thread t5)<br><br>;; % gsi dump-thread.scm<br>

;; #<thread #1 primordial> is running with continuation:<br>;; 0  dump-thread             "dump-thread.scm"@32:21 (##thread-continuation...<br>;; 1  (interaction)           "dump-thread.scm"@48:1  (dump-thread (current-...<br>

;; 2  ##load<br>;; 3  ##load<br>;; 4  ##main<br>;;<br>;; #<thread #2> is not yet started<br>;;<br>;; #<thread #3> is terminated with result:<br>;; 333<br>;;<br>;; #<thread #4> is terminated with exception:<br>

;; Divide by zero<br>;; (/ 1 0)<br>;;<br>;; #<thread #5> is started but has not yet run<br><br></blockquote></div></div>