racing srfi-18 threads

[Tristan Colgate-2]

Hi All,

 I've been experimenting with guile-1.9 (latest git)  srfi-18 support.
I'm trying
to implement a race between threads. I've written a macro that take a
routine and a list of args, starts a thread for each arg and runs the
routine with that argument. The result  returned should be the return
result of the first thread to return. I was originally using some of
guile other thread primitives (monitor in particular), but have
stripped those out in order to try testing against other schemes.

 Chicken currently gives the "correct" result, but that uses
cooperative threading. Guile launches threads, I can see them with a
ps -efL,  but they never seem to start (even after the thread-start!).

 The code is as follows....

(require-extension (srfi 18))

(define-syntax race-each
 (syntax-rules ()
 ((_ func parargs)
  (let* ((result #f)
         (result-ready (make-condition-variable))
         (junktex (make-mutex))
         (junk    (mutex-lock! junktex))
         (resulttex (make-mutex))
         (dotask (lambda(arg)
                    (let ((thisresult (func arg)))
                      (with-exception-handler
                        (lambda(ev)
                          (thread-terminate! (current-thread)))
                        (lambda() (mutex-lock! resulttex)))
                      (set! result thisresult)
                      (condition-variable-signal! result-ready)
                      (thread-terminate! (current-thread)))))
         (threads (map (lambda(x)
                         (thread-start! (make-thread (lambda()
                                                        (dotask x)))))
parargs)))
     (mutex-unlock! junktex result-ready)
     (map (lambda(old-thread) (thread-terminate! old-thread)) threads)
     result))))

(display
 (race-each
   (lambda(value)
     (format #t "In thread~%")
     (thread-sleep! (seconds->time (+ (time->seconds (current-time)) value)))
     value)
   '(3 5 8 9 2)))


--
Tristan Colgate-McFarlane
----
  "You can get all your daily vitamins from 52 pints of guiness, and a
glass of milk"

[Tristan Colgate-2]

After some further investigation, this seems to be a compile/vm issue.

$ touch test-race
$ GUILE_AUTO_COMPILE=0 guile test-race

yields the correct result. But if I run without inhibiting the auto
compilation this
fail as before.Any subsequent runs, with or without GUILE_AUTO_COMPILE set
then fail.

A similar, though much simpler, test case exhibits the same problem.
I'll raise a bug. report and
include a log of the issue.

2009/11/6 Tristan Colgate <tcolgate@...>:

> Hi All,
>
>  I've been experimenting with guile-1.9 (latest git)  srfi-18 support.
> I'm trying
> to implement a race between threads. I've written a macro that take a
> routine and a list of args, starts a thread for each arg and runs the
> routine with that argument. The result  returned should be the return
> result of the first thread to return. I was originally using some of
> guile other thread primitives (monitor in particular), but have
> stripped those out in order to try testing against other schemes.
>
>  Chicken currently gives the "correct" result, but that uses
> cooperative threading. Guile launches threads, I can see them with a
> ps -efL,  but they never seem to start (even after the thread-start!).
>
>  The code is as follows....
>
> (require-extension (srfi 18))
>
> (define-syntax race-each
>  (syntax-rules ()
>  ((_ func parargs)
>  (let* ((result #f)
>         (result-ready (make-condition-variable))
>         (junktex (make-mutex))
>         (junk    (mutex-lock! junktex))
>         (resulttex (make-mutex))
>         (dotask (lambda(arg)
>                    (let ((thisresult (func arg)))
>                      (with-exception-handler
>                        (lambda(ev)
>                          (thread-terminate! (current-thread)))
>                        (lambda() (mutex-lock! resulttex)))
>                      (set! result thisresult)
>                      (condition-variable-signal! result-ready)
>                      (thread-terminate! (current-thread)))))
>         (threads (map (lambda(x)
>                         (thread-start! (make-thread (lambda()
>                                                        (dotask x)))))
> parargs)))
>     (mutex-unlock! junktex result-ready)
>     (map (lambda(old-thread) (thread-terminate! old-thread)) threads)
>     result))))
>
> (display
>  (race-each
>   (lambda(value)
>     (format #t "In thread~%")
>     (thread-sleep! (seconds->time (+ (time->seconds (current-time)) value)))
>     value)
>   '(3 5 8 9 2)))
>
>
> --
> Tristan Colgate-McFarlane
> ----
>  "You can get all your daily vitamins from 52 pints of guiness, and a
> glass of milk"
>

--
Tristan Colgate-McFarlane
----
  "You can get all your daily vitamins from 52 pints of guiness, and a
glass of milk"

[Neil Jerram]

Tristan Colgate <tcolgate@...> writes:

> A similar, though much simpler, test case exhibits the same problem.
> I'll raise a bug. report and
> include a log of the issue.

Hi Tristan,

Thanks for reporting this.  FWIW I've checked that it still happens
(exactly as you've described) with the current Git HEAD.  Not much clue
yet about the underlying problem or fix, but I'll keep looking.

      Neil

[Neil Jerram]

Neil Jerram <neil@...> writes:

> Tristan Colgate <tcolgate@...> writes:
>
>> A similar, though much simpler, test case exhibits the same problem.
>> I'll raise a bug. report and
>> include a log of the issue.
>
> Hi Tristan,
>
> Thanks for reporting this.  FWIW I've checked that it still happens
> (exactly as you've described) with the current Git HEAD.  Not much clue
> yet about the underlying problem or fix, but I'll keep looking.

What happens is that each of the spawned threads throws an exception
before it gets going.  If I run test-broken in the (srfi srfi-18)
module, with the following code added at the end:

(write threads)
(newline)
(for-each (lambda (t)
            (write (thread->exception t))
            (newline))
          threads)
(for-each thread-join! threads)

I see:

===============
build thread
build thread
build thread
build thread
build thread
build thread

(#<thread 3081010064 (8d308a0)> #<thread 3064224656 (8d305c0)> #<thread 3064224656 (8d30450)> #<thread 3064224656 (8d302e0)> #<thread 3064224656 (8d30170)> #<thread 3064224656 (8d30000)>)
((uncaught-exception) wrong-type-arg "with-exception-handler" "Wrong type argument: ~S" (#<program 8e13ac0>) ())
((uncaught-exception) wrong-type-arg "with-exception-handler" "Wrong type argument: ~S" (#<program 8e13a00>) ())
((uncaught-exception) wrong-type-arg "with-exception-handler" "Wrong type argument: ~S" (#<program 8e13940>) ())
((uncaught-exception) wrong-type-arg "with-exception-handler" "Wrong type argument: ~S" (#<program 8e13890>) ())
((uncaught-exception) wrong-type-arg "with-exception-handler" "Wrong type argument: ~S" (#<program 8e13800>) ())
((uncaught-exception) wrong-type-arg "with-exception-handler" "Wrong type argument: ~S" (#<program 8e13740>) ())
===============

This is apparently because of srfi-18.scm's `with-exception-handler'
including

    (check-arg-type thunk? thunk "with-exception-handler")

It seems that when run under the VM, (thunk? thunk) => #f.

scm_thunk_p depends on scm_i_program_arity, which depends on
scm_program_arities, and adding this -

       (write ((@ (system vm program) program-arities) thunk))
       (newline)
       (write (procedure-property thunk 'arity))
       (newline)

- into srfi-18's make-thread code, I get

#f
#f

every time.

So I think this is a good point to report and ask if this makes sense.
Andy / Ludo, can it be correct for (program-arities PROGRAM) to be #f ?
If not, any idea what is the root cause of this?

Another question here is why the thread-join! doesn't cause the uncaught
thread exceptions to be raised on the main thread.  I'll look further
into that.

Thanks,
        Neil

[Andy Wingo]

On Mon 16 Nov 2009 23:16, Neil Jerram <neil@...> writes:

> It seems that when run under the VM, (thunk? thunk) => #f.

Ugly. Thanks for debugging this, Neil.

> Andy / Ludo, can it be correct for (program-arities PROGRAM) to be #f
> ?

Well... no, I don't think so. Looks like a bug to me.

> Thanks,

Thank you!

Andy
--
http://wingolog.org/

[Neil Jerram]

Andy Wingo <wingo@...> writes:

> On Mon 16 Nov 2009 23:16, Neil Jerram <neil@...> writes:
>
>> It seems that when run under the VM, (thunk? thunk) => #f.
>
> Ugly. Thanks for debugging this, Neil.

I now have it down to this: a program compiled inside the RHS of a
define-syntax form apparently has no meta; whereas the same program
compiled outside a define-syntax form does have meta:

(use-modules (system vm program))

(define-syntax race
  (syntax-rules ()
    ((_ n)
     (begin
       (write (cons 'race (program-meta (lambda () n))))
       (newline)))))

(race 3)

(begin
  (write (cons 'race (program-meta (lambda () n))))
  (newline))

|=

(race . #f)
(race . #<program 944ccf0>)

I'll keep following this through, but if you have any idea where the
root problem is, please say.

       Neil

[Neil Jerram]

Neil Jerram <neil@...> writes:

> I now have it down to this: a program compiled inside the RHS of a
> define-syntax form apparently has no meta; whereas the same program
> compiled outside a define-syntax form does have meta:

Apologies for taking so long to follow up on this!

I've been trying to remedy my lack of detailed understanding about how
compilation works, and that has led me to wondering whether and how we
will provide similar debugging facilities for compiled code as we have
in 1.8.x for interpreted code.

One option would be not to take the 1.8.x approach at all (i.e. using
special hooks from the core of the evaluator/VM) but instead rely on
instrumenting code at runtime.  I had a quick play with this and it
seems quite simple and promising.  For example, here's a way of tracing
when a procedure is called, and its return values:

(define-macro (trace proc)
  `(let ((proc ,proc))
     (set! ,proc
           (lambda args
             (display ";TRACE: ")
             (display ',proc)
             (display " ")
             (write args)
             (newline)
             (call-with-values
                 (lambda ()
                   (apply proc args))
               (lambda results
                 (for-each (lambda (result)
                             (display ";TRACE: ")
                             (display ',proc)
                             (display " => ")
                             (write result)
                             (newline))
                           results)
                 (apply values results)))))))

Yes, I know I should write that with define-syntax instead. :-)

Then, with that in my .guile:

neil@arudy:~/SW/Guile/git$ meta/uninstalled-env guile
Guile Scheme interpreter 0.5 on Guile 1.9.5
Copyright (C) 2001-2008 Free Software Foundation, Inc.

Enter `,help' for help.
scheme@(guile-user)> (trace (@@ (system base compile) compile-fold))
;;; note: source file /home/neil/SW/Guile/git/module/language/glil/compile-assembly.scm
;;;       newer than compiled /home/neil/SW/Guile/git/module/language/glil/compile-assembly.go
;;; found fresh local cache at /home/neil/SW/Guile/git/cache/guile/ccache/1.9-0.L-LE-4/home/neil/SW/Guile/git/module/language/glil/compile-assembly.scm.go
scheme@(guile-user)> (trace (@@ (language glil compile-assembly) compile-assembly))
;TRACE: (@@ (system base compile) compile-fold) ((#<program compile-tree-il (x e opts)> #<program compile-glil (x e opts)> #<program compile-asm (x e opts)> #<program compile-bytecode (assembly env . opts)> #<program compile-objcode (x e opts)>) (trace (@@ (language glil compile-assembly) compile-assembly)) #<directory (guile-user) 9947b98> (()))
;TRACE: (@@ (system base compile) compile-fold) => #<objcode 9b9f800>
;TRACE: (@@ (system base compile) compile-fold) => #<directory (guile-user) 9947b98>
;TRACE: (@@ (system base compile) compile-fold) => #<directory (guile-user) 9947b98>
scheme@(guile-user)> (+ 3 4 5)
;TRACE: (@@ (system base compile) compile-fold) ((#<program compile-tree-il (x e opts)> #<program compile-glil (x e opts)> #<program compile-asm (x e opts)> #<program compile-bytecode (assembly env . opts)> #<program compile-objcode (x e opts)>) (+ 3 4 5) #<directory (guile-user) 9947b98> (()))
;TRACE: (@@ (language glil compile-assembly) compile-assembly) (#<glil (program () (source ((breakpoint . #f) (line . 2) (column . 0) (filename . #f))) (std-prelude 0 0 #f) (label :LCASE113) (const 3) (const 4) (const 5) (call add 2) (source ((breakpoint . #f) (line . 2) (column . 0) (filename . #f))) (call add 2) (source ((breakpoint . #f) (line . 2) (column . 0) (filename . #f))) (call return 1))>)
;TRACE: (@@ (language glil compile-assembly) compile-assembly) (#<glil (program () (const (() ((0 2 . 0)) ((6 15 0)))) (call return 1))>)
;TRACE: (@@ (language glil compile-assembly) compile-assembly) => (load-program () 25 #f (make-eol) (make-int8:0) (make-int8 2) (make-int8:0) (cons) (cons) (list 0 1) (make-int8 6) (make-int8 15) (make-int8:0) (list 0 3) (list 0 1) (list 0 3) (return))
;TRACE: (@@ (language glil compile-assembly) compile-assembly) => (load-program ((:LCASE113 . 6)) 16 (load-program () 25 #f (make-eol) (make-int8:0) (make-int8 2) (make-int8:0) (cons) (cons) (list 0 1) (make-int8 6) (make-int8 15) (make-int8:0) (list 0 3) (list 0 1) (list 0 3) (return)) (assert-nargs-ee 0 0) (reserve-locals 0 0) (make-int8 3) (make-int8 4) (make-int8 5) (add) (add) (return) (nop))
;TRACE: (@@ (system base compile) compile-fold) => #<objcode 9bd3f40>
;TRACE: (@@ (system base compile) compile-fold) => #<directory (guile-user) 9947b98>
;TRACE: (@@ (system base compile) compile-fold) => #<directory (guile-user) 9947b98>
12
scheme@(guile-user)>

That seems quite nice and useful.

(SLIB has stuff like this too.  I wonder if it would just work.)

We should be able to do breakpoints like this too, using either the
command line or the GDS debugger - although I'm not sure how much of the
stack inspection facilities will immediately work.  I'll try that next.

I don't see how single-stepping could easily be implemented this way,
though.  I think that may require hooks in the VM.  But then again,
would single stepping through VM operations be useful and comprehensible
anyway?

All thoughts welcome, as ever...

      Neil