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 log? (getenv "PLTDRBACKGROUNDCOMPILELOG"))
(define-syntax-rule
(maybe-log-info args ...)
(when log? (log-info args ...)))
(define (start p)
;; get the module-language-compile-lock in the initial message
(set! module-language-parallel-lock-client
@ -54,15 +59,15 @@
old-registry)]))))))
(define (abort-job job)
(when (log-level? (current-logger) 'info)
(when (and log? (log-level? (current-logger) 'info))
(define stack (continuation-mark-set->context
(continuation-marks
(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)
(thread-dead? (job-working-thd job))))
(for ([x (in-list stack)])
(log-info (format " ~s" x))))
(maybe-log-info (format " ~s" x))))
(custodian-shutdown-all (job-cust job))
(place-channel-put (job-response-pc job) #f))
@ -81,23 +86,23 @@
(parameterize ([current-custodian cust])
(thread
(λ ()
(log-info "expanding-place.rkt: 01 starting thread")
(maybe-log-info "expanding-place.rkt: 01 starting thread")
(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)
(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
module-language-parallel-lock-client
#: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)])
(current-directory init-dir))
(current-load-relative-directory #f)
(define sp (open-input-string program-as-string))
(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
(log-info "expanding-place.rkt: 06 setting uncaught-exception-handler")
(maybe-log-info "expanding-place.rkt: 06 setting uncaught-exception-handler")
(uncaught-exception-handler
(λ (exn)
(parameterize ([current-custodian orig-cust])
@ -108,18 +113,18 @@
(channel-put exn-chan exn))))
(semaphore-wait sema)
((error-escape-handler))))
(log-info "expanding-place.rkt: 07 starting read-syntax")
(maybe-log-info "expanding-place.rkt: 07 starting read-syntax")
(define stx
(parameterize ([read-accept-reader #t])
(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
(define-values (name lang transformed-stx)
(transform-module path
(namespace-syntax-introduce stx)
raise-hopeless-syntax-error))
(log-info "expanding-place.rkt: 09 starting expansion")
(define log-io? (log-level? (current-logger) 'warning))
(maybe-log-info "expanding-place.rkt: 09 starting expansion")
(define log-io? (and log? (log-level? (current-logger) 'warning)))
(define-values (in out) (if log-io?
(make-pipe)
(values #f (open-output-nowhere))))
@ -136,7 +141,7 @@
(channel-put old-registry-chan
(namespace-module-registry (current-namespace)))
(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
(for/list ([handler (in-list handlers)])
(list (handler-key handler)
@ -144,7 +149,7 @@
path
the-source
orig-cust))))
(log-info "expanding-place.rkt: 11 handlers finished")
(maybe-log-info "expanding-place.rkt: 11 handlers finished")
(parameterize ([current-custodian orig-cust])
(thread
@ -153,7 +158,7 @@
(semaphore-post sema)
(channel-put result-chan handler-results))))
(semaphore-wait sema)
(log-info "expanding-place.rkt: 12 finished"))))))
(maybe-log-info "expanding-place.rkt: 12 finished"))))))
(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
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
is set, DrRacket pretends that the result of @racket[current-seconds]
is actually this environment variable's value, for the purposes