[gambit-list] ##thread-status proposal

Marc Feeley feeley at iro.umontreal.ca
Wed Jul 31 11:14:13 EDT 2013


There is already a thread-state procedure with similar functionality.  Can you explain what is lacking in that procedure and extend it with the functionality you need?

Marc

On 2013-07-12, at 6:00 AM, Mikael <mikael.rcv at gmail.com> wrote:

> Three fixes to code from previous post.
> 
> Sent a pull request for it for inclusion of this procedure, https://github.com/feeley/gambit/pull/38 .
> 
> Test:
> 
> > (define t (make-thread (lambda () (thread-sleep! 10) 'over)))
> > (##thread-status t)
> (created)
> > (begin (thread-start! t) (##thread-status t))
> (starting)
> > (##thread-status t)
> (running)
> > (##thread-status t #t)
> (running #<continuation #2>)
> > (##thread-status t)
> (ended over)
> > (define t (thread-start! (make-thread (lambda () (raise "error")))))
> > (##thread-status t)
> (ended/exception "error")
> 
> To it included in your Gambit binary until Marc recompiles the C files in the next Gambit release, you need to do:
> 
> ./configure
> make
> cd lib
> ../gsc/gsc -:~~bin=../bin,~~lib=../lib,~~include=../include -c  _thread.scm
> ../gsc/gsc -:~~bin=../bin,~~lib=../lib,~~include=../include -f -link -flat -o _gambc.c _kernel.c _system.c _num.c _std.c _eval.c _io.c _nonstd.c _thread.c _repl.c
> cd ..
> make
> 
> ; (##thread-status thread #!optional capture-continuation-if-running?)
> ; => list ('created) = The thread has not yet been started
> ;    list ('starting) = The thread has been started but execution has not yet begun
> ;    list ('running [continuation-object]) = The thread is running
> ;    list ('ended result) = The thread terminated ordinarily, with the return value result
> ;    list ('ended/exception exception) = The thread terminated with the exception exception
> (define (##thread-status thread #!optional capture-continuation-if-running?)
> 
>   (let loop ()
> 
>     ; Make snapshot of thread state
>     ; 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)
> 
>       ; Generate return value
>       (cond ((not end-condvar)
>              ;; Thread has terminated
>              (if exception?
>                  ;; Thread has terminated with exception
>                  (list 'ended/exception result)
>                  ;; Thread has terminated with result
>                  (list 'ended result)))
>             (exception?
>              ;; Thread has never run and is not terminated
>              (if (not result)
>                  ;; Thread is not yet started
>                  (list 'created)
>                  ;; Thread is started but has not yet run
>                  (list 'starting)))
>             (else
>              (if capture-continuation-if-running?
>                  ; continuation = #f here indicates that the thread state changed during the course
>                  ;                of execution of this procedure, in such a way that the thread no
>                  ;                longer has a continuation. Thisis the case if the thread ended.
>                  (let ((continuation
>                         (with-exception-catcher
>                          (lambda (e) #f)
>                          (lambda () (##thread-continuation-capture thread)))))
>                    (if continuation
>                        (list 'running continuation)
>                        (loop)))
>                  (list 'running)))))))
> 
> 
> 2013/6/23 Mikael <mikael.rcv at gmail.com>
> (dump-threads) uses ##thread-continuation-capture to get the current continuation of a target thread.
> 
> This presumes that the target thread has been started, if it has not ##thread-continuation-capture causes SIGSEGV.
> 
> 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.
> 
> I propose the introduction in Gambit of a procedure
> 
> (##thread-status thread)
> => list ('created) = The thread has not yet been started
>    list ('starting) = The thread has been started but execution has not yet begun
>    list ('running) = The thread is running
>    list ('ended result) = The thread terminated ordinarily, with the return value result
>    list ('ended/exception exception) = The thread terminated with the exception exception
> 
> 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.
> 
> Here follows a definition for inclusion into Gambit, based on an email Marc sent 2011-12-16, quoted below:
> 
> (define (##thread-status thread #!optional capture-continuation-if-running?)
>   
>   (let loop ()
>   
>     ; Make snapshot of thread state
>     ; 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)
> 
>       ; Generate return value
>       (cond ((not end-condvar)
>              ;; Thread has terminated
>              (if exception?
>                  ;; Thread has terminated with exception
>                  (list 'ended/exception result)
>                  ;; Thread has terminated with result
>                  (list 'ended result)))
>             (exception?
>              ;; Thread has never run and is not terminated
>              (if (not result)
>                  ;; Thread is not yet started
>                  (list 'created)
>                  ;; Thread is started but has not yet run
>                  (list 'starting)))
>             (else
>              (if capture-continuation-if-running?
>                  (let ((continuation
>                         (with-exception-catcher
>                          (lambda (e) (loop))
>                          (lambda () (capture-continuation-if-running? thread)))))
>                    (list 'running continuation)
>                    (list 'running))))))))
> 
> Use would look something like:
> 
> > (define t (make-thread (lambda () (thread-sleep! 5))))
> > (##thread-status t)
> (created)
> > (thread-start! t)
> > (##thread-status t)
> (running)
> > (thread-sleep! 5)
> > (##thread-status t)
> (ended #!void)
> 
> With such a definition, a (dump-threads) could be defined as easy as:
> 
> (define (dump-threads #!key threads thread-group thread #!rest display-continuation-backtrace-args)
>   (map (lambda (thread)
>          (let loop ()
>            (let ((status (##thread-status thread #t)))
>              (if (eq? (car status) 'running)
>                  (list 'running (call-with-output-string
>                                  '()
>                                  (lambda (port) (apply display-continuation-backtrace
>                                                        `(,(cadr status) ; = continuation
>                                                          ,port
>                                                          .,display-continuation-backtrace-args)))))
>                  status))))
>        (or threads (thread-group->thread-list (or thread-group (thread-thread-group (or thread (current-thread))))))))
> 
> Please feel free to provide feedback.
> 
> Brgds, Mikael
> 
> 2011/12/16 Marc Feeley
> 
> On 2011-12-15, at 6:22 PM, Mikael wrote:
> 
> [..] 
> > 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)?
> 
> 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.
> 
> (##include "~~lib/_gambit#.scm")
> 
> (define (dump-thread thread)
> 
>   (write thread)
> 
>   (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 " is terminated with exception:\n")
>                  (display-exception result))
>                (begin
>                  ;; thread has terminated with result
>                  (display " is 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 " is not yet started\n"))
>                (begin
>                  ;; thread is started but has not yet run
>                  (display " is started but has not yet run\n"))))
>           (else
>            ;; thread is started and has run
>            (let ((c (##thread-continuation-capture thread)))
>              (display " is running with continuation:\n")
>              (display-continuation-backtrace c)))))
> 
>   (newline))
> 
> (define t2 (make-thread (lambda () 222)))
> (define t3 (make-thread (lambda () 333)))
> (define t4 (make-thread (lambda () (/ 1 0))))
> (define t5 (make-thread (lambda () 555)))
> 
> (thread-start! t3)
> (thread-start! t4)
> 
> (thread-sleep! 0.01)
> 
> (dump-thread (current-thread))
> (dump-thread t2)
> (dump-thread t3)
> (dump-thread t4)
> (thread-start! t5)
> (dump-thread t5)
> 
> ;; % gsi dump-thread.scm
> ;; #<thread #1 primordial> is running with continuation:
> ;; 0  dump-thread             "dump-thread.scm"@32:21 (##thread-continuation...
> ;; 1  (interaction)           "dump-thread.scm"@48:1  (dump-thread (current-...
> ;; 2  ##load
> ;; 3  ##load
> ;; 4  ##main
> ;;
> ;; #<thread #2> is not yet started
> ;;
> ;; #<thread #3> is terminated with result:
> ;; 333
> ;;
> ;; #<thread #4> is terminated with exception:
> ;; Divide by zero
> ;; (/ 1 0)
> ;;
> ;; #<thread #5> is started but has not yet run
> 
> 
> _______________________________________________
> Gambit-list mailing list
> Gambit-list at iro.umontreal.ca
> https://webmail.iro.umontreal.ca/mailman/listinfo/gambit-list



More information about the Gambit-list mailing list