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

a first attempt to use the parallel compilation stuff in drracket's startup

Browse Source
This commit is contained in:
Robby Findler 2011-02-08 09:54:57 -06:00 committed by Robby Findler
parent dce1d0ad47
commit a509fc28fe
1 changed files with 71 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

117
collects/drracket/drracket.rkt
View File

@ -4,12 +4,14 @@
(define debugging? (getenv "PLTDRDEBUG"))
(define profiling? (getenv "PLTDRPROFILE"))
(define first-parallel? (getenv "PLTDRPAR"))
(define install-cm? (and (not debugging?)
(getenv "PLTDRCM")))
(define cm-trace? (or (equal? (getenv "PLTDRCM") "trace")
(equal? (getenv "PLTDRDEBUG") "trace")))
(equal? (getenv "PLTDRDEBUG") "trace")
(equal? (getenv "PLTDRPAR") "trace")))
;; the flush is only here to ensure that the output is
;; appears when running in cygwin under windows.
@ -17,51 +19,74 @@
(apply printf fmt args)
(flush-output))
(when debugging?
(flprintf "PLTDRDEBUG: installing CM to load/create errortrace zos\n")
(let-values ([(zo-compile
make-compilation-manager-load/use-compiled-handler
manager-trace-handler)
(parameterize ([current-namespace (make-base-empty-namespace)]
[use-compiled-file-paths '()])
(values
(dynamic-require 'errortrace/zo-compile 'zo-compile)
(dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)
(dynamic-require 'compiler/cm 'manager-trace-handler)))])
(current-compile zo-compile)
(use-compiled-file-paths (list (build-path "compiled" "errortrace")))
(current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))
(error-display-handler (dynamic-require 'errortrace/errortrace-lib
'errortrace-error-display-handler))
(when cm-trace?
(flprintf "PLTDRDEBUG: enabling CM tracing\n")
(manager-trace-handler
(λ (x)
(when (regexp-match #rx"compiling:|end compile:" x)
(display "1: ") (display x) (newline) (flush-output)))))))
(define (run-trace-thread)
(let ([evt (make-log-receiver (current-logger) 'info)])
(void
(thread
(λ ()
(let loop ()
(define vec (sync evt))
(define str (vector-ref vec 1))
(when (regexp-match #rx"^cm: *compil(ing|ed)" str)
(display str)
(newline))
(loop)))))))
(when install-cm?
(flprintf "PLTDRCM: installing compilation manager\n")
(let-values ([(make-compilation-manager-load/use-compiled-handler
manager-trace-handler)
(parameterize ([current-namespace (make-base-empty-namespace)])
(values
(dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)
(dynamic-require 'compiler/cm 'manager-trace-handler)))])
(current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))
(when cm-trace?
(flprintf "PLTDRCM: enabling CM tracing\n")
(let ([evt (make-log-receiver (current-logger) 'info)])
(void
(thread
(λ ()
(let loop ()
(define vec (sync evt))
(define str (vector-ref vec 1))
(when (regexp-match #rx"^cm: *compil(ing|ed)" str)
(display str)
(newline))
(loop)))))))))
(cond
[debugging?
(flprintf "PLTDRDEBUG: loading CM to load/create errortrace zos\n")
(let-values ([(zo-compile
make-compilation-manager-load/use-compiled-handler
manager-trace-handler)
(parameterize ([current-namespace (make-base-empty-namespace)]
[use-compiled-file-paths '()])
(values
(dynamic-require 'errortrace/zo-compile 'zo-compile)
(dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)
(dynamic-require 'compiler/cm 'manager-trace-handler)))])
(flprintf "PLTDRDEBUG: installing CM to load/create errortrace zos\n")
(current-compile zo-compile)
(use-compiled-file-paths (list (build-path "compiled" "errortrace")))
(current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))
(error-display-handler (dynamic-require 'errortrace/errortrace-lib
'errortrace-error-display-handler))
(when cm-trace?
(flprintf "PLTDRDEBUG: enabling CM tracing\n")
(run-trace-thread)))]
[install-cm?
(flprintf "PLTDRCM: loading compilation manager\n")
(let-values ([(make-compilation-manager-load/use-compiled-handler
manager-trace-handler)
(parameterize ([current-namespace (make-base-empty-namespace)])
(values
(dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)
(dynamic-require 'compiler/cm 'manager-trace-handler)))])
(flprintf "PLTDRCM: installing compilation manager\n")
(current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))
(when cm-trace?
(flprintf "PLTDRCM: enabling CM tracing\n")
(run-trace-thread)))]
[first-parallel?
(flprintf "PLTDRPAR: loading compilation manager\n")
(define (files-in-coll coll)
(define dir (collection-path coll))
(map (λ (x) (build-path dir x)) (directory-list dir)))
(define-values (make-compilation-manager-load/use-compiled-handler manager-trace-handler)
(parameterize ([current-namespace (make-base-empty-namespace)])
(values
(dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)
(dynamic-require 'compiler/cm 'manager-trace-handler))))
(when cm-trace?
(flprintf "PLTDRPAR: enabling CM tracing\n")
(run-trace-thread))
(flprintf "PLTDRPAR: loading setup/parallel-build\n")
(define parallel-compile-files
(parameterize ([current-load/use-compiled (make-compilation-manager-load/use-compiled-handler)])
(dynamic-require 'setup/parallel-build 'parallel-compile-files)))
(flprintf "PLTDRPAR: parallel compile of framework & drracket\n")
(parallel-compile-files (append (files-in-coll "drracket") (files-in-coll "framework")))
(flprintf "PLTDRPAR: installing compilation manager\n")
(current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))])
(when profiling?
(flprintf "PLTDRPROFILE: installing profiler\n")