From a509fc28fe271ebc3f6d8105c586fdbd846c26c1 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Tue, 8 Feb 2011 09:54:57 -0600 Subject: [PATCH] a first attempt to use the parallel compilation stuff in drracket's startup --- collects/drracket/drracket.rkt | 117 ++++++++++++++++++++------------- 1 file changed, 71 insertions(+), 46 deletions(-) diff --git a/collects/drracket/drracket.rkt b/collects/drracket/drracket.rkt index c42efec3b1..22c195b306 100644 --- a/collects/drracket/drracket.rkt +++ b/collects/drracket/drracket.rkt @@ -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")