suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Handle SEGFAULT return

Browse Source
This commit is contained in:
Kevin Tew 2010-11-28 05:35:46 -07:00
parent 6df50ffe83
commit e1eb3cbfba
2 changed files with 35 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/setup/parallel-build.rkt
View File

@ -27,8 +27,11 @@
((collects-queue-append-error jobqueue) cc "making" null out err "output"))]) ((collects-queue-append-error jobqueue) cc "making" null out err "output"))])
(when last ((collects-queue-printer jobqueue) (current-output-port) "made" "~a" cc-name )))] (when last ((collects-queue-printer jobqueue) (current-output-port) "made" "~a" cc-name )))]
[else [else
(match work
[(list (list cc file last) message)
((collects-queue-append-error jobqueue) cc "making" null "" "" "error")
(eprintf "work-done match cc failed.\n") (eprintf "work-done match cc failed.\n")
(eprintf "trying to match:\n~a\n" (list work msg))])) (eprintf "trying to match:\n~a\n" (list work msg))])]))
;; assigns a collection to each worker to be compiled ;; assigns a collection to each worker to be compiled
;; when it runs out of collections, steals work from other workers collections ;; when it runs out of collections, steals work from other workers collections

31
collects/setup/parallel-do.rkt
View File

@ -2,10 +2,11 @@
(require racket/file (require racket/file
racket/future racket/future
scheme/fasl racket/port
scheme/match racket/fasl
racket/match
racket/path racket/path
scheme/serialize racket/serialize
unstable/generics unstable/generics
racket/stxparam racket/stxparam
(for-syntax syntax/parse (for-syntax syntax/parse
@ -96,17 +97,26 @@
[(list (and (? empty?) idle) (list) count error-count) (set! workers idle)] [(list (and (? empty?) idle) (list) count error-count) (set! workers idle)]
;; Wait for reply from worker ;; Wait for reply from worker
[(list idle inflight count error-count) [(list idle inflight count error-count)
(define (remove-dead-worker id node-worker)
(loop (cons (spawn id) idle)
(remove node-worker inflight)
count
(add1 error-count)))
(apply sync (map (λ (node-worker) (match node-worker (apply sync (map (λ (node-worker) (match node-worker
[(list node (and wrkr (worker id sh out in err))) [(list node (and wrkr (worker id sh out in err)))
(handle-evt out (λ (e) (handle-evt out (λ (e)
(let ([msg (with-handlers* ([exn:fail? (lambda (e) (let ([msg (with-handlers* ([exn:fail? (lambda (e)
(printf "MASTER READ ERROR - reading from worker: ~a\n" (exn-message e)) (printf "MASTER READ ERROR - reading from worker: ~a\n" (exn-message e))
(kill-worker wrkr) (kill-worker wrkr)
(loop (cons (spawn id) idle) (remove-dead-worker id node-worker))])
(remove node-worker inflight) (let ([read-msg (read out)])
count (if (pair? read-msg)
(add1 error-count)))]) read-msg
(read out))]) (begin
(work-done jobqueue node id (string-append read-msg (port->string out)))
(kill-worker wrkr)
(remove-dead-worker id node-worker)))))])
(work-done jobqueue node id msg) (work-done jobqueue node id msg)
(loop (cons wrkr idle) (loop (cons wrkr idle)
(remove node-worker inflight) (remove node-worker inflight)
@ -116,7 +126,10 @@
(eprintf "parallel-do-event-loop match node-worker failed.\n") (eprintf "parallel-do-event-loop match node-worker failed.\n")
(eprintf "trying to match:\n~a\n" node-worker)])) (eprintf "trying to match:\n~a\n" node-worker)]))
inflight))])]) inflight))]
[x
(eprintf "parallel-do-event-loop match-lambda* failed.\n")
(eprintf "trying to match:\n~a\n" x)])])
(loop workers null 0 0))) (loop workers null 0 0)))
(lambda () (lambda ()
(for ([p workers]) (with-handlers ([exn? void]) (send/msg (list 'DIE) (worker-in p)))) (for ([p workers]) (with-handlers ([exn? void]) (send/msg (list 'DIE) (worker-in p))))