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