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

restore non-places parallel build

Browse Source 
The build protocol had evolved to include paths in messages passed
between places/processes, and that doesn't work with processes.
This commit is contained in:
Matthew Flatt 2014-12-05 10:12:47 -07:00
parent 2d95c39051
commit b7039106e6
1 changed files with 31 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
racket/collects/setup/parallel-do.rkt
View File

@ -90,14 +90,22 @@
id (exn-message x))
(exit 1))])
(DEBUG_COMM (eprintf "CSENDING ~v ~v\n" id msg))
(write msg in) (flush-output in)))
(write (convert-paths msg) in)
(flush-output in)))
(define/public (recv/msg)
(with-handlers ([exn:fail?
(lambda (x)
(eprintf "While receiving message from parallel-do worker ~a ~a\n"
id (exn-message x))
(eprintf (string-append
"While receiving message from parallel-do worker ~a ~a\n"
" input continues: ~s\n")
id (exn-message x)
(let ([bstr (make-bytes 32)])
(define n (peek-bytes-avail!* bstr 0 #f out))
(if (number? n)
(subbytes bstr 0 n)
n)))
(exit 1))])
(define r (read out))
(define r (deconvert-paths (read out)))
(DEBUG_COMM (eprintf "CRECEIVNG ~v ~v\n" id r))
r))
(define/public (read-all) (port->string out))
@ -391,12 +399,12 @@
(define (raw-send msg)
(cond
[ch (place-channel-put ch msg)]
[else (write msg orig-out)
[else (write (convert-paths msg) orig-out)
(flush-output orig-out)]))
(define (raw-recv)
(cond
[ch (place-channel-get ch)]
[else (read orig-in)]))
[else (deconvert-paths (read orig-in))]))
(define (pdo-send msg)
(with-handlers ([exn:fail?
(lambda (x)
@ -468,3 +476,20 @@
(define module-path (path->string (resolved-module-path-name (variable-reference->resolved-module-path (#%variable-reference)))))
(parallel-do-event-loop module-path 'name initalmsg wq worker-count)
(queue/results wq)))]))
(struct path-wrapper (bstr) #:prefab)
(define (convert-paths msg)
(cond
[(path? msg) (path-wrapper (path->bytes msg))]
[(pair? msg) (cons (convert-paths (car msg))
(convert-paths (cdr msg)))]
[else msg]))
(define (deconvert-paths msg)
(cond
[(path-wrapper? msg) (bytes->path (path-wrapper-bstr msg))]
[(pair? msg) (cons (deconvert-paths (car msg))
(deconvert-paths (cdr msg)))]
[else msg]))