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

Fix pr 12205 pass --disable-inline and --vv options through to parallel make

Browse Source
This commit is contained in:
Kevin Tew 2011-09-16 13:06:29 -06:00
parent a7c607a708
commit 099e89a297
2 changed files with 24 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/compiler/commands/make.rkt
View File

@ -91,4 +91,13 @@
(match type (match type
['done (when (verbose) (printf " Made ~a\n" work))] ['done (when (verbose) (printf " Made ~a\n" work))]
['output (printf " Output from: ~a\n~a~a" work out err)] ['output (printf " Output from: ~a\n~a~a" work out err)]
[else (printf " Error compiling ~a\n~a\n~a~a" work msg out err)])))]) [else (printf " Error compiling ~a\n~a\n~a~a" work msg out err)]))
#:options
(let ([cons-if-true (lambda (bool carv cdrv)
(if bool
(cons carv cdrv)
cdrv))])
(cons-if-true
(very-verbose)
'very-verbose
(cons-if-true (disable-inlining) 'disable-inlining null))))])

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

@ -54,7 +54,7 @@
(define collects-queue% (define collects-queue%
(class* object% (work-queue<%>) (class* object% (work-queue<%>)
(init-field cclst printer append-error) (init-field cclst printer append-error options)
(field (lock-mgr (new lock-manager%))) (field (lock-mgr (new lock-manager%)))
(field (hash (make-hash))) (field (hash (make-hash)))
(inspect #f) (inspect #f)
@ -105,7 +105,8 @@
(list cc file last) (list cc file last)
(list (->bytes (cc-name cc)) (list (->bytes (cc-name cc))
(->bytes (cc-path cc)) (->bytes (cc-path cc))
(->bytes file)))) (->bytes file)
options)))
(match cc (match cc
[(list) [(list)
(hash-remove! hash id) (retry)] (hash-remove! hash id) (retry)]
@ -172,7 +173,7 @@
(define file-list-queue% (define file-list-queue%
(class* object% (work-queue<%>) (class* object% (work-queue<%>)
(init-field filelist handler) (init-field filelist handler options)
(field (lock-mgr (new lock-manager%))) (field (lock-mgr (new lock-manager%)))
(inspect #f) (inspect #f)
@ -219,7 +220,7 @@
(define cmc (make-caching-managed-compile-zo)) (define cmc (make-caching-managed-compile-zo))
(match-message-loop (match-message-loop
[(list name _dir _file) [(list name _dir _file options)
(DEBUG_COMM (eprintf "COMPILING ~a ~a ~a ~a\n" worker-id name _file _dir)) (DEBUG_COMM (eprintf "COMPILING ~a ~a ~a ~a\n" worker-id name _file _dir))
(define dir (bytes->path _dir)) (define dir (bytes->path _dir))
(define file (bytes->path _file)) (define file (bytes->path _file))
@ -250,6 +251,11 @@
(with-handlers ([exn:fail? (lambda (x) (with-handlers ([exn:fail? (lambda (x)
(send/resp (list 'ERROR (exn-message x))))]) (send/resp (list 'ERROR (exn-message x))))])
(parameterize ([parallel-lock-client lock-client] (parameterize ([parallel-lock-client lock-client]
[compile-context-preservation-enabled (member 'disable-inlining options )]
[manager-trace-handler
(lambda (p)
(when (member 'very-verbose options)
(printf " ~a\n" p)))]
[current-namespace (make-base-empty-namespace)] [current-namespace (make-base-empty-namespace)]
[current-directory dir] [current-directory dir]
[current-load-relative-directory dir] [current-load-relative-directory dir]
@ -266,10 +272,11 @@
(define (parallel-compile-files list-of-files (define (parallel-compile-files list-of-files
#:worker-count [worker-count (processor-count)] #:worker-count [worker-count (processor-count)]
#:handler [handler void]) #:handler [handler void]
(parallel-build (make-object file-list-queue% list-of-files handler) worker-count)) #:options [options '()])
(parallel-build (make-object file-list-queue% list-of-files handler options) worker-count))
(define (parallel-compile worker-count setup-fprintf append-error collects-tree) (define (parallel-compile worker-count setup-fprintf append-error collects-tree)
(setup-fprintf (current-output-port) #f "--- parallel build using ~a processes ---" worker-count) (setup-fprintf (current-output-port) #f "--- parallel build using ~a processes ---" worker-count)
(define collects-queue (make-object collects-queue% collects-tree setup-fprintf append-error)) (define collects-queue (make-object collects-queue% collects-tree setup-fprintf append-error '()))
(parallel-build collects-queue worker-count)) (parallel-build collects-queue worker-count))