On 2013-07-12, at 6:00 AM, Mikael <
mikael.rcv@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@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
>
>