[racket] Problem with places and sync/timeout

Hello,

I have written a number of programs that attempt to "farm" work out
to a number of places... for example, the attached file which calculates
the square of *ALL THE NUMBERS* between 0 and 99 inclusive!

Intermittently, this pooling loop stops (usually at the last place)...
e.g.

9999999999999999cpu time: 320 real time: 492 gc time: 44
place finished work for 99

It sits waiting forever... and certainly longer than my 1s timeout.

In my defence of not paring the program down to its bare minimum; it
seems to fail more often with the kind of IO stress I'm putting it
under.

I ^\ core the program (stack trace below).

Linux XXXX 2.6.32-5-amd64 #1 SMP Mon Jan 16 16:22:28 UTC 2012 x86_64 GNU/Linux

racket version 5.2, but this happens on any (many) combination of
Windows amd64 (6 core)/Linux amd64 (4 core), racket, drracket, 5.2
and 5.2.1

First, is there anything wrong with my logic?
(Happy to accept that as an option)

Otherwise... what's up? Can I do owt to help?

tim-brown on #racket, ping me if you need to know more

Tim Brown


(gdb) where
#0  0x00007f78f77a90e3 in select () from /lib/libc.so.6
#1  0x00007f78f84d59dc in default_sleep (v=<value optimized out>,
      fds=0x7f78f8890008) at ./../src/port.c:9318
#2  0x00007f78f8575dc8 in check_sleep (need_activity=<value optimized out>,
      sleep_now=1) at ./../src/thread.c:3523
#3  0x00007f78f857da3d in scheme_thread_block (
      sleep_time=<value optimized out>) at ./../src/thread.c:4205
#4  0x00007f78f8580b2b in scheme_out_of_fuel () at ./../src/thread.c:3577
#5  0x00007f78f84c6291 in places_deep_copy_worker (so=0x7f78f284c058,
      ht=0x7fff75ad3448, mode=<value optimized out>,
      gcable=<value optimized out>, can_raise_exn=<value optimized out>)
      at ./../src/place.c:1657
#6  0x00007f78f84c63ad in do_places_deep_copy (so=0x7f78f284c058, mode=2,
      gcable=1) at ./../src/place.c:1058
#7  0x00007f78f84c6486 in scheme_places_deserialize (so=0x7f78f284c058,
      msg_memory=0x7f78e801fc60) at ./../src/place.c:2348
#8  0x00007f78f84c6603 in scheme_place_async_try_receive (ch=0x7f78efae6e98)
      at ./../src/place.c:2823
#9  0x00007f78f84c66af in place_channel_ready (so=0x7f78efad6438,
      sinfo=0x7fff75ad3670) at ./../src/place.c:2849
#10 0x00007f78f857e848 in syncing_ready (s=0x7f78f6494480,
      sinfo=0x7fff75ad37e0) at ./../src/thread.c:5644
#11 0x00007f78f857d839 in scheme_thread_block (
      sleep_time=<value optimized out>) at ./../src/thread.c:4266
#12 0x00007f78f857e47a in scheme_block_until (
      _f=0x7f78f857e670 <syncing_ready>,
      fdf=0x7f78f856fc10 <syncing_needs_wakeup>, data=0x7f78f6494480, delay=0)
      at ./../src/thread.c:4335
#13 0x00007f78f857fa70 in do_sync (name=0x7f78f85d93a6 "sync/timeout",
      argc=<value optimized out>, argv=0x7f78f6145ee0,
      with_break=<value optimized out>, with_timeout=1974287344,
      _tailok=<value optimized out>) at ./../src/thread.c:5961
#14 0x00007f78f8a7d727 in ?? ()
#15 0x00007f78f6145ef8 in ?? ()
#16 0x00007f78f6510e9f in ?? ()
#17 0x00007fff75ad3c10 in ?? ()
#18 0x00007f78f5195f88 in ?? ()
#19 0x0000000000000000 in ?? ()


-- 
Tim Brown <tim.brown at cityc.co.uk>  | City Computing Limited            |
T: +44 20 8770 2110                | City House, Sutton Park Road      |
F: +44 20 8770 2130                | Sutton, Surrey, SM1 2AE, GB       |
-----------------------------------------------------------------------|
BEAUTY:  What's in your eye when you have a bee in your hand           |
-----------------------------------------------------------------------'
City Computing Limited registered in London No. 1767817.
Registered Office: City House, Sutton Park Road, Sutton, Surrey, SM1 2AE
VAT number 372 8290 34.

-------------- next part --------------
#lang racket

(provide main)
(require racket/place)
(require (only-in srfi/1 delete))

#|
  Possibly the least efficient way I know of summing the squares of i=0 to 99!
  |#

(define places-hash (make-hash))

(define (spinny-worker i)
 (let ((p (place id
           (let ((i (place-channel-get id)))
           (printf "place started for ~a~%" i)
           (time (for ([n 100000]) (display (modulo i 10))))
           (printf "place finished work for ~a~%" i)
           (let ((release-msg (place-channel-put/get id (cons i (* i i)))))
           (printf "place ~a release with ~a~%" i release-msg))))))
  (hash-set! places-hash i p)
  (place-channel-put p i)
  i))

(define place-farm-size 3) ; > processors on computer
(define (main . cli-args)
 (let main-inr ((work-to-do (for/list ([i 100]) i))
                (plcs null)
                (acc 0))
  (printf "main-inr: ~s	" (list (length work-to-do) plcs acc))
  (cond [(and (pair? work-to-do) (< (length plcs) place-farm-size))
         (let* ((i (car work-to-do))
                (s (spinny-worker i)))
           (printf "work (~a) assigned to ~a~%" i s)
           (main-inr (cdr work-to-do) (cons s plcs) acc))]
         [(and (null? work-to-do) (null? plcs)) acc]
         [(apply sync/timeout
                 1 ; blocks
                 ; 120 ; terminates correctly
                 (map (lambda (id) (hash-ref places-hash id)) plcs)) =>
         (lambda (plc-id)
          (let* ((id (car plc-id))
                 (rv (cdr plc-id))
                 (plc (hash-ref places-hash id)) 
                 (new-plcs (delete id plcs))
                 (new-acc (+ acc rv)))
           (printf "message: plc-id:~a=~a -> ~a : acc:~a [new plcs: ~a]~%" 
            id plc rv new-acc new-plcs)
           (printf "shooing: ~a~%" plc)
           (place-channel-put plc 'shoo)
           (printf "waiting: ~a~%" plc)
           (place-wait plc)
           (hash-remove! places-hash plc-id)
           (main-inr work-to-do new-plcs new-acc)))]
         [else (printf "timeout...~%") (main-inr work-to-do plcs acc)])))

; vim: syntax=racket