[gambit-list] ##thread-status proposal

Mikael mikael.rcv at gmail.com
Fri Jul 12 06:00:10 EDT 2013


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
>>
>>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://webmail.iro.umontreal.ca/pipermail/gambit-list/attachments/20130712/91b69961/attachment-0001.html 


More information about the Gambit-list mailing list