[gambit-list] ##thread-status proposal

Mikael mikael.rcv at gmail.com
Sun Jun 23 14:19:19 EDT 2013


(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
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mailman.iro.umontreal.ca/pipermail/gambit-list/attachments/20130623/6ec85130/attachment.htm>


More information about the Gambit-list mailing list