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

Add event logging to caching-managed-compile and parallel compile.

Browse Source 
This allows for understanding where time is spend during a compile.
This commit is contained in:
Eric Dobson 2014-11-01 12:02:12 -07:00
parent 517e22eee8
commit 8f238fe9e2
4 changed files with 96 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
pkgs/racket-pkgs/racket-doc/scribblings/raco/make.scrbl
View File

@ -267,6 +267,20 @@ referenced by not-yet-loaded modules. References to already-loaded
modules may produce compiled files with inconsistent timestamps and/or
@filepath{.dep} files with incorrect information.}
The handler logs messages to the topic @racket['compiler/cm] at the level
@racket['info]. These messages are instances of a @racket[compile-event] prefab
structure:
@racketblock[
(struct compile-event (timestamp path type) #:prefab)
]
The @racket[timestamp] field is the time at which the event occured in
milliseconds since the epoch. The @racket[path] field is the path of a file
being compiled for which the event is about. The @racket[type] field is a symbol
which describes the action the event corresponds to. The currently logged values
are @racket['locking], @racket['start-compile], @racket['finish-compile], and
@racket['already-done].
@defproc[(managed-compile-zo [file path-string?]
[read-src-syntax (any/c input-port? . -> . syntax?) read-syntax]
@ -293,7 +307,6 @@ the files are created is used (not the security guard at the point
@racket[managed-compile-zo] is called).
}
@defboolparam[trust-existing-zos trust?]{
A parameter that is intended for use by @exec{setup-plt} when
@ -467,7 +480,7 @@ functionality of @exec{raco setup} and @exec{raco make}.}
void])
(or/c void? #f)]{
The @racket[parallel-compile] utility function is used by @exec{raco make} to
The @racket[parallel-compile-files] utility function is used by @exec{raco make} to
compile a list of paths in parallel. The optional
@racket[#:worker-count] argument specifies the number of compile workers to spawn during
parallel compilation. The callback, @racket[handler], is called with the symbol
@ -517,6 +530,19 @@ datastructure containing an in-memory tree representation of the collects
directory.
}
Both @racket[parallel-compile-files] and @racket[parallel-compile] log messages
to the topic @racket['setup/parallel-build] at the level @racket['info]. These
messages are instances of a @racket[parallel-compile-event] prefab structure:
@racketblock[
(struct parallel-compile-event (worker event) #:prefab)
].
The worker field is the index of the worker that the created the event. The event
field is a @racket[compile-event] as document in
@racket[make-compilation-manager-load/use-compiled-handler].
@; ----------------------------------------------------------------------
@section{Compilation Manager Hook for Syntax Transformers}

10
racket/collects/compiler/cm.rkt
View File

@ -34,6 +34,12 @@
(when (log-level? cm-logger 'debug)
(log-message cm-logger 'debug str (current-inexact-milliseconds))))
(struct compile-event (timestamp path action) #:prefab)
(define (log-compile-event path action)
(when (log-level? cm-logger 'info 'compiler/cm)
(log-message cm-logger 'info (format "~a: ~a" action path)
(compile-event (current-inexact-milliseconds) path action))))
(define manager-compile-notify-handler (make-parameter void))
(define manager-trace-handler (make-parameter default-manager-trace-handler))
(define indent (make-parameter ""))
@ -505,12 +511,14 @@
((if sha1-only? values (lambda (build) (build) #f))
(lambda ()
(let* ([lc (parallel-lock-client)]
[_ (when lc (log-compile-event path 'locking))]
[locked? (and lc (lc 'lock zo-name))]
[ok-to-compile? (or (not lc) locked?)])
(dynamic-wind
(lambda () (void))
(lambda ()
(when ok-to-compile?
(log-compile-event path 'start-compile)
(when zo-exists? (try-delete-file zo-name #f))
(log-info (format "cm: ~acompiling ~a"
(build-string
@ -532,6 +540,8 @@
(λ (x) (if (= 2 (modulo x 3)) #\| #\space)))
actual-path))))
(lambda ()
(when lc
(log-compile-event path (if locked? 'finish-compile 'already-done)))
(when locked?
(lc 'unlock zo-name))))))))))))
(unless sha1-only?

55
racket/collects/setup/parallel-build.rkt
View File

@ -24,6 +24,11 @@
; (begin a ...)
)
(struct parallel-compile-event (worker value) #:prefab)
;; Logger that joins the events of the compiler/cm logger of the different places.
;; The attached values are (parallel-compile-event <worker-id> <original-data>).
(define pb-logger (make-logger 'setup/parallel-build (current-logger)))
(define lock-manager%
(class object%
(field (locks (make-hash)))
@ -80,6 +85,7 @@
(inspect #f)
(define/public (work-done work wrkr msg)
(define id (send wrkr get-id))
(match (list work msg)
[(list (list cc file last) (list result-type out err))
(begin0
@ -89,6 +95,10 @@
#t]
[(list 'LOCK fn) (lm/lock lock-mgr fn wrkr) #f]
[(list 'UNLOCK fn) (lm/unlock lock-mgr fn) #f]
[(list 'LOG level msg data)
(when (log-level? pb-logger level)
(log-message pb-logger level msg (parallel-compile-event id data)))
#f]
['DONE
(define (string-!empty? s) (not (zero? (string-length s))))
(when (ormap string-!empty? (list out err))
@ -215,6 +225,10 @@
[(list 'ERROR msg) (handler id 'error work msg out err)
(set! results #f)
#t]
[(list 'LOG level msg data)
(when (log-level? pb-logger level)
(log-message pb-logger level msg (parallel-compile-event id data)))
#f]
['DONE
(define (string-!empty? s) (not (zero? (string-length s))))
(if (ormap string-!empty? (list out err))
@ -243,11 +257,12 @@
(super-new)))
(define (parallel-build work-queue worker-count)
(define do-log-forwarding (log-level? pb-logger 'info 'setup/parallel-build))
(parallel-do
worker-count
(lambda (workerid) (list workerid))
worker-count
(lambda (workerid) (list workerid do-log-forwarding))
work-queue
(define-worker (parallel-compile-worker worker-id)
(define-worker (parallel-compile-worker worker-id do-log-forwarding)
(DEBUG_COMM (eprintf "WORKER ~a\n" worker-id))
(define prev-uncaught-exception-handler (uncaught-exception-handler))
(uncaught-exception-handler
@ -307,11 +322,17 @@
)
;; Watch for module-prefetch events, and queue jobs in response
(define t (start-prefetch-thread send/add))
(define prefetch-thread (start-prefetch-thread send/add))
;; Watch for logging events, and send log messages to parent
(define stop-logging-thread
(if do-log-forwarding
(start-logging-thread send/log)
void))
(cmc (build-path dir file))
(kill-thread t))
(kill-thread prefetch-thread)
(stop-logging-thread))
(send/resp 'DONE))]
[x (send/error (format "DIDNT MATCH A ~v\n" x))]
[else (send/error (format "DIDNT MATCH A\n"))]))))
@ -362,3 +383,27 @@
(send/add path)))
p])))
(loop))))))
;; This thread is run in the worker's place. For every compiler event in the worker, this sends a
;; message back to the original place, which will be turned into a log event in `pb-logger`.
(define (start-logging-thread send/log)
(define log-rec (make-log-receiver (current-logger) 'info 'compiler/cm))
(define sema (make-semaphore))
(define t
(thread
(lambda ()
(define (handle-msg v)
(send/log (vector-ref v 0) (vector-ref v 1) (vector-ref v 2)))
(define (drain)
(sync/timeout 0 (handle-evt log-rec (λ (v) (handle-msg v) (drain)))))
(let loop ()
(sync
(handle-evt log-rec
(λ (v) (handle-msg v) (loop)))
(handle-evt sema
(λ (_) (drain))))))))
(lambda ()
(semaphore-post sema)
(sync t)))

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

@ -20,6 +20,7 @@
send/error
send/report
send/msg
send/log
recv/req
worker/die
work-queue<%>
@ -351,6 +352,7 @@
(define-syntax-parameter-error send/success)
(define-syntax-parameter-error send/error)
(define-syntax-parameter-error send/report)
(define-syntax-parameter-error send/log)
(define-syntax-parameter-error recv/req)
(define-syntax-parameter-error worker/die)
@ -373,10 +375,11 @@
[recv/req (make-rename-transformer #'recv/reqp)]
[worker/die (make-rename-transformer #'die-k)])
;; message handler:
(lambda (msg send/successp send/errorp send/reportp)
(lambda (msg send/successp send/errorp send/reportp send/logp)
(syntax-parameterize ([send/success (make-rename-transformer #'send/successp)]
[send/error (make-rename-transformer #'send/errorp)]
[send/report (make-rename-transformer #'send/reportp)])
[send/report (make-rename-transformer #'send/reportp)]
[send/log (make-rename-transformer #'send/logp)])
(match msg
[work work-body ...]
...))))))])))))
@ -429,6 +432,8 @@
(send/resp (list 'ERROR message)))
(define (send/reportp message)
(send/resp (list 'REPORT message)))
(define (send/logp level message data)
(send/resp (list 'LOG level message data)))
((with-handlers* ([exn:fail? (lambda (x)
(define sp (open-output-string))
(parameterize ([current-error-port sp])
@ -440,7 +445,7 @@
(let ([msg (pdo-recv)])
(match msg
[(list 'DIE) void]
[_ (msg-proc msg send/successp send/errorp send/reportp)
[_ (msg-proc msg send/successp send/errorp send/reportp send/logp)
(lambda () (loop (add1 i)))]))))))))))))
(define-syntax (lambda-worker stx)