Handle SEGFAULT return

collects/setup/parallel-build.rkt

@@ -27,8 +27,11 @@
                   ((collects-queue-append-error jobqueue) cc "making" null out err "output"))])
             (when last ((collects-queue-printer jobqueue) (current-output-port) "made" "~a" cc-name )))]
         [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 "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
     ;; when it runs out of collections, steals work from other workers collections

collects/setup/parallel-do.rkt

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