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

adjust logger to use a name instead of an environment variable

Browse Source
This commit is contained in:
Robby Findler 2012-10-15 13:24:25 -05:00
parent 0ec7f47339
commit 7ffe9f2612
2 changed files with 25 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -16,10 +16,16 @@
(define old-registry-chan (make-channel))
(define log? (getenv "PLTDRBACKGROUNDCOMPILELOG"))
(define expanding-place-logger (make-logger
'drracket-background-compilation
(current-logger)))
(define-syntax-rule
(maybe-log-info args ...)
(when log? (log-info args ...)))
(ep-log-info expr)
(when (log-level? expanding-place-logger 'info)
(log-message expanding-place-logger
'info
expr
(current-continuation-marks))))
(define (start p)
;; get the module-language-compile-lock in the initial message
@ -59,15 +65,15 @@
old-registry)]))))))
(define (abort-job job)
(when (and log? (log-level? (current-logger) 'info))
(when (log-level? expanding-place-logger 'info)
(define stack (continuation-mark-set->context
(continuation-marks
(job-working-thd job))))
(maybe-log-info (format "expanding-place.rkt: kill; worker-thd stack (size ~a) dead? ~a:"
(ep-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)])
(maybe-log-info (format " ~s" x))))
(ep-log-info (format " ~s" x))))
(custodian-shutdown-all (job-cust job))
(place-channel-put (job-response-pc job) #f))
@ -86,23 +92,23 @@
(parameterize ([current-custodian cust])
(thread
(λ ()
(maybe-log-info "expanding-place.rkt: 01 starting thread")
(ep-log-info "expanding-place.rkt: 01 starting thread")
(define sema (make-semaphore 0))
(maybe-log-info "expanding-place.rkt: 02 setting basic parameters")
(ep-log-info "expanding-place.rkt: 02 setting basic parameters")
(set-basic-parameters/no-gui)
(maybe-log-info "expanding-place.rkt: 03 setting module language parameters")
(ep-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)
(maybe-log-info "expanding-place.rkt: 04 setting directories")
(ep-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)
(maybe-log-info "expanding-place.rkt: 05 installing security guard")
(ep-log-info "expanding-place.rkt: 05 installing security guard")
(install-security-guard) ;; must come after the call to set-module-language-parameters
(maybe-log-info "expanding-place.rkt: 06 setting uncaught-exception-handler")
(ep-log-info "expanding-place.rkt: 06 setting uncaught-exception-handler")
(uncaught-exception-handler
(λ (exn)
(parameterize ([current-custodian orig-cust])
@ -113,18 +119,18 @@
(channel-put exn-chan exn))))
(semaphore-wait sema)
((error-escape-handler))))
(maybe-log-info "expanding-place.rkt: 07 starting read-syntax")
(ep-log-info "expanding-place.rkt: 07 starting read-syntax")
(define stx
(parameterize ([read-accept-reader #t])
(read-syntax the-source sp)))
(maybe-log-info "expanding-place.rkt: 08 read")
(ep-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))
(maybe-log-info "expanding-place.rkt: 09 starting expansion")
(define log-io? (and log? (log-level? (current-logger) 'warning)))
(ep-log-info "expanding-place.rkt: 09 starting expansion")
(define log-io? (log-level? expanding-place-logger 'warning))
(define-values (in out) (if log-io?
(make-pipe)
(values #f (open-output-nowhere))))
@ -141,7 +147,7 @@
(channel-put old-registry-chan
(namespace-module-registry (current-namespace)))
(place-channel-put pc-status-expanding-place (void))
(maybe-log-info "expanding-place.rkt: 10 expanded")
(ep-log-info "expanding-place.rkt: 10 expanded")
(define handler-results
(for/list ([handler (in-list handlers)])
(list (handler-key handler)
@ -149,7 +155,7 @@
path
the-source
orig-cust))))
(maybe-log-info "expanding-place.rkt: 11 handlers finished")
(ep-log-info "expanding-place.rkt: 11 handlers finished")
(parameterize ([current-custodian orig-cust])
(thread
@ -158,7 +164,7 @@
(semaphore-post sema)
(channel-put result-chan handler-results))))
(semaphore-wait sema)
(maybe-log-info "expanding-place.rkt: 12 finished"))))))
(ep-log-info "expanding-place.rkt: 12 finished"))))))
(thread
(λ ()

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

@ -176,10 +176,6 @@ 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