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

adjust background compilation log messages so they only appear

Browse Source 
when the PLTDRBACKGROUNDCOMPILELOG environment variable is set
(since things seem stable now)
This commit is contained in:
Robby Findler 2012-10-15 11:53:44 -05:00
parent fd6e2bd6c5
commit 0ec7f47339
2 changed files with 25 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
collects/drracket/private/expanding-place.rkt
View File

@ -16,6 +16,11 @@
(define old-registry-chan (make-channel)) (define old-registry-chan (make-channel))
(define log? (getenv "PLTDRBACKGROUNDCOMPILELOG"))
(define-syntax-rule
(maybe-log-info args ...)
(when log? (log-info args ...)))
(define (start p) (define (start p)
;; get the module-language-compile-lock in the initial message ;; get the module-language-compile-lock in the initial message
(set! module-language-parallel-lock-client (set! module-language-parallel-lock-client
@ -54,15 +59,15 @@
old-registry)])))))) old-registry)]))))))
(define (abort-job job) (define (abort-job job)
(when (log-level? (current-logger) 'info) (when (and log? (log-level? (current-logger) 'info))
(define stack (continuation-mark-set->context (define stack (continuation-mark-set->context
(continuation-marks (continuation-marks
(job-working-thd job)))) (job-working-thd job))))
(log-info (format "expanding-place.rkt: kill; worker-thd stack (size ~a) dead? ~a:" (maybe-log-info (format "expanding-place.rkt: kill; worker-thd stack (size ~a) dead? ~a:"
(length stack) (length stack)
(thread-dead? (job-working-thd job)))) (thread-dead? (job-working-thd job))))
(for ([x (in-list stack)]) (for ([x (in-list stack)])
(log-info (format " ~s" x)))) (maybe-log-info (format " ~s" x))))
(custodian-shutdown-all (job-cust job)) (custodian-shutdown-all (job-cust job))
(place-channel-put (job-response-pc job) #f)) (place-channel-put (job-response-pc job) #f))
@ -81,23 +86,23 @@
(parameterize ([current-custodian cust]) (parameterize ([current-custodian cust])
(thread (thread
(λ () (λ ()
(log-info "expanding-place.rkt: 01 starting thread") (maybe-log-info "expanding-place.rkt: 01 starting thread")
(define sema (make-semaphore 0)) (define sema (make-semaphore 0))
(log-info "expanding-place.rkt: 02 setting basic parameters") (maybe-log-info "expanding-place.rkt: 02 setting basic parameters")
(set-basic-parameters/no-gui) (set-basic-parameters/no-gui)
(log-info "expanding-place.rkt: 03 setting module language parameters") (maybe-log-info "expanding-place.rkt: 03 setting module language parameters")
(set-module-language-parameters settings (set-module-language-parameters settings
module-language-parallel-lock-client module-language-parallel-lock-client
#:use-use-current-security-guard? #t) #:use-use-current-security-guard? #t)
(log-info "expanding-place.rkt: 04 setting directories") (maybe-log-info "expanding-place.rkt: 04 setting directories")
(let ([init-dir (get-init-dir path)]) (let ([init-dir (get-init-dir path)])
(current-directory init-dir)) (current-directory init-dir))
(current-load-relative-directory #f) (current-load-relative-directory #f)
(define sp (open-input-string program-as-string)) (define sp (open-input-string program-as-string))
(port-count-lines! sp) (port-count-lines! sp)
(log-info "expanding-place.rkt: 05 installing security guard") (maybe-log-info "expanding-place.rkt: 05 installing security guard")
(install-security-guard) ;; must come after the call to set-module-language-parameters (install-security-guard) ;; must come after the call to set-module-language-parameters
(log-info "expanding-place.rkt: 06 setting uncaught-exception-handler") (maybe-log-info "expanding-place.rkt: 06 setting uncaught-exception-handler")
(uncaught-exception-handler (uncaught-exception-handler
(λ (exn) (λ (exn)
(parameterize ([current-custodian orig-cust]) (parameterize ([current-custodian orig-cust])
@ -108,18 +113,18 @@
(channel-put exn-chan exn)))) (channel-put exn-chan exn))))
(semaphore-wait sema) (semaphore-wait sema)
((error-escape-handler)))) ((error-escape-handler))))
(log-info "expanding-place.rkt: 07 starting read-syntax") (maybe-log-info "expanding-place.rkt: 07 starting read-syntax")
(define stx (define stx
(parameterize ([read-accept-reader #t]) (parameterize ([read-accept-reader #t])
(read-syntax the-source sp))) (read-syntax the-source sp)))
(log-info "expanding-place.rkt: 08 read") (maybe-log-info "expanding-place.rkt: 08 read")
(when (syntax? stx) ;; could be eof (when (syntax? stx) ;; could be eof
(define-values (name lang transformed-stx) (define-values (name lang transformed-stx)
(transform-module path (transform-module path
(namespace-syntax-introduce stx) (namespace-syntax-introduce stx)
raise-hopeless-syntax-error)) raise-hopeless-syntax-error))
(log-info "expanding-place.rkt: 09 starting expansion") (maybe-log-info "expanding-place.rkt: 09 starting expansion")
(define log-io? (log-level? (current-logger) 'warning)) (define log-io? (and log? (log-level? (current-logger) 'warning)))
(define-values (in out) (if log-io? (define-values (in out) (if log-io?
(make-pipe) (make-pipe)
(values #f (open-output-nowhere)))) (values #f (open-output-nowhere))))
@ -136,7 +141,7 @@
(channel-put old-registry-chan (channel-put old-registry-chan
(namespace-module-registry (current-namespace))) (namespace-module-registry (current-namespace)))
(place-channel-put pc-status-expanding-place (void)) (place-channel-put pc-status-expanding-place (void))
(log-info "expanding-place.rkt: 10 expanded") (maybe-log-info "expanding-place.rkt: 10 expanded")
(define handler-results (define handler-results
(for/list ([handler (in-list handlers)]) (for/list ([handler (in-list handlers)])
(list (handler-key handler) (list (handler-key handler)
@ -144,7 +149,7 @@
path path
the-source the-source
orig-cust)))) orig-cust))))
(log-info "expanding-place.rkt: 11 handlers finished") (maybe-log-info "expanding-place.rkt: 11 handlers finished")
(parameterize ([current-custodian orig-cust]) (parameterize ([current-custodian orig-cust])
(thread (thread
@ -153,7 +158,7 @@
(semaphore-post sema) (semaphore-post sema)
(channel-put result-chan handler-results)))) (channel-put result-chan handler-results))))
(semaphore-wait sema) (semaphore-wait sema)
(log-info "expanding-place.rkt: 12 finished")))))) (maybe-log-info "expanding-place.rkt: 12 finished"))))))
(thread (thread
(λ () (λ ()

4
collects/scribblings/drracket/extending.scrbl
View File

@ -176,6 +176,10 @@ Several environment variables can affect DrRacket's behavior:
set, DrRacket will print out that it is set, and will print set, DrRacket will print out that it is set, and will print
when the index is started loading and when it finishes loading.} when the index is started loading and when it finishes loading.}
@item{@indexed-envvar{PLTDRBACKGROUNDCOMPILELOG} : When this environment
variable is set, DrRacket adds logging messages that show the
status of its background expansion process.}
@item{@indexed-envvar{PLTDREASTERSECONDS} : When this environment variable @item{@indexed-envvar{PLTDREASTERSECONDS} : When this environment variable
is set, DrRacket pretends that the result of @racket[current-seconds] is set, DrRacket pretends that the result of @racket[current-seconds]
is actually this environment variable's value, for the purposes is actually this environment variable's value, for the purposes