diff --git a/pkgs/racket-doc/scribblings/raco/setup.scrbl b/pkgs/racket-doc/scribblings/raco/setup.scrbl index aabf3b3a74..ea804a7703 100644 --- a/pkgs/racket-doc/scribblings/raco/setup.scrbl +++ b/pkgs/racket-doc/scribblings/raco/setup.scrbl @@ -350,6 +350,32 @@ as @exec{raco make}. Specifically, if @envvar{PLT_COMPILED_FILE_CHECK} is set to @litchar{exists}, then @exec{raco make} does not attempt to update a compiled file's timestamp if the file is not recompiled. +Some additional environment variables are useful for performance +debugging: + +@itemlist[ + + @item{@indexed-envvar{PLT_SETUP_DMS_ARGS} triggers a call to + @racket[dump-memory-stats] after each collection is compiled, + where the environment variable's value is parsed with + @racket[read] to obtain a list of arguments to + @racket[dump-memory-stats].} + + @item{@indexed-envvar{PLT_SETUP_LIMIT_CACHE} (set to anything) avoids + caching compiled-file information across different collections, + which is useful to reduce noise when looking for memory leaks.} + + @item{@indexed-envvar{PLT_SETUP_NO_FORCE_GC} (set to anything) + suppresses a call to @racket[collect-garbage] that is issued by + default for non-parallel builds after each collection is + compiled and after each document is run or rendered.} + + @item{@indexed-envvar{PLT_SETUP_SHOW_TIMESTAMPS} (set to anything) + appends the current process time after @litchar[" @ "] for each + status message printed by @exec{raco setup}.} + +] + @history[#:changed "6.1" @elem{Added the @DFlag{pkgs}, @DFlag{check-pkg-deps}, and @DFlag{fail-fast} flags.} @@ -358,7 +384,9 @@ update a compiled file's timestamp if the file is not recompiled. #:changed "6.6.0.3" @elem{Added support for @envvar{PLT_COMPILED_FILE_CHECK}.} #:changed "7.0.0.19" @elem{Added @DFlag{places} and @DFlag{processes}.} #:changed "7.2.0.7" @elem{Added @DFlag{error-in} and @DFlag{error-out}.} - #:changed "7.2.0.8" @elem{Added @DFlag{recompile-only}.}] + #:changed "7.2.0.8" @elem{Added @DFlag{recompile-only}.} + #:changed "7.9.0.3" @elem{Added @envvar{PLT_SETUP_NO_FORCE_GC} and + @envvar{PLT_SETUP_SHOW_TIMESTAMPS}.}] @; ------------------------------------------------------------------------ diff --git a/pkgs/racket-index/setup/scribble.rkt b/pkgs/racket-index/setup/scribble.rkt index d8bb21a380..c06a901d57 100644 --- a/pkgs/racket-index/setup/scribble.rkt +++ b/pkgs/racket-index/setup/scribble.rkt @@ -147,7 +147,8 @@ tidy? ; clean up, even beyond `only-dirs' avoid-main? ; avoid main collection, even for `tidy?' with-record-error ; catch & record exceptions - setup-printf) + setup-printf + gc-after-each-sequential?) (unless (doc-db-available?) (error 'setup "install SQLite to build documentation")) (when latex-dest @@ -319,7 +320,7 @@ auto-main? auto-user? main-doc-exists? with-record-error setup-printf #f only-fast? force-out-of-date? - no-lock)) + no-lock (if gc-after-each-sequential? gc-point void))) (define num-sequential (let loop ([docs docs]) (cond [(null? docs) 0] @@ -360,7 +361,9 @@ (printf "~a" errstr) (deserialize (fasl->s-exp r))) (lambda (work errmsg outstr errstr) - (parallel-do-error-handler with-record-error work errmsg outstr errstr))) + (parallel-do-error-handler with-record-error work errmsg outstr errstr)) + (lambda (args) + (apply setup-printf args))) (define-worker (get-doc-info-worker workerid program-name verbosev only-dirs latex-dest auto-main? auto-user? main-doc-exists? force-out-of-date? lock-ch) @@ -369,12 +372,8 @@ force-out-of-date? lock send/report) doc) - (define (setup-printf subpart formatstr . rest) - (let ([task (if subpart - (format "~a: " subpart) - "")]) - (send/report - (format "~a: ~a~a\n" program-name task (apply format formatstr rest))))) + (define (setup-printf . args) + (send/report args)) (define (with-record-error cc go fail-k) (with-handlers ([exn:fail? (lambda (exn) @@ -385,7 +384,7 @@ ((get-doc-info only-dirs latex-dest auto-main? auto-user? main-doc-exists? with-record-error setup-printf workerid - #f force-out-of-date? lock) + #f force-out-of-date? lock void) (deserialize (fasl->s-exp doc)))))) (verbose verbosev) @@ -663,7 +662,8 @@ (for ([i (in-list need-rerun)]) (say-rendering i #f) (prep-info! i) - (update-info! i (build-again! latex-dest i with-record-error no-lock + (update-info! i (build-again! latex-dest i with-record-error + no-lock (if gc-after-each-sequential? gc-point void) main-doc-exists?))) (parallel-do #:use-places? use-places? @@ -706,7 +706,7 @@ (s-exp->fasl (serialize (build-again! latex-dest (deserialize (fasl->s-exp info)) with-record-error - (lock-via-channel lock-ch) + (lock-via-channel lock-ch) void main-doc-exists?))))]))))) ;; If we only build 1, then it reaches it own fixpoint ;; even if the info doesn't seem to converge immediately. @@ -991,7 +991,7 @@ (define ((get-doc-info only-dirs latex-dest auto-main? auto-user? main-doc-exists? with-record-error setup-printf workerid - only-fast? force-out-of-date? lock) + only-fast? force-out-of-date? lock gc-point) doc) ;; First, move pre-rendered documentation, if any, into place @@ -1117,7 +1117,7 @@ ((get-doc-info only-dirs latex-dest auto-main? auto-user? main-doc-exists? with-record-error setup-printf workerid - #f #f lock) + #f #f lock gc-point) doc))]) (let ([v-in (load-sxref info-in-file)]) (unless (equal? (car v-in) (list vers (doc-flags doc))) @@ -1406,7 +1406,8 @@ searches scis))])])) -(define (build-again! latex-dest info-or-list with-record-error lock +(define (build-again! latex-dest info-or-list with-record-error + lock gc-point main-doc-exists?) ;; If `info-or-list' is a list, then we're in a parallel build, and ;; it provides just enough of `info' from the main place to re-build diff --git a/racket/collects/setup/parallel-do.rkt b/racket/collects/setup/parallel-do.rkt index 37d6880908..986605221d 100644 --- a/racket/collects/setup/parallel-do.rkt +++ b/racket/collects/setup/parallel-do.rkt @@ -350,8 +350,8 @@ (define/public (jobs-cnt) (length queue)) (super-new))) -(define (list-queue list-of-work create-job-thunk job-success-thunk job-failure-thunk) - (make-object list-queue% list-of-work create-job-thunk job-success-thunk job-failure-thunk)) +(define (list-queue list-of-work create-job-thunk job-success-thunk job-failure-thunk [report-proc display]) + (make-object list-queue% list-of-work create-job-thunk job-success-thunk job-failure-thunk report-proc)) (define-syntax-rule (define-parallel-keyword-error d x) (d x (lambda (stx) (raise-syntax-error 'x "only allowed inside parallel worker definition" stx)))) diff --git a/racket/collects/setup/setup-core.rkt b/racket/collects/setup/setup-core.rkt index 8c7dee31b1..a480747691 100755 --- a/racket/collects/setup/setup-core.rkt +++ b/racket/collects/setup/setup-core.rkt @@ -105,7 +105,13 @@ (define (setup-fprintf p task s . args) (let ([task (if task (string-append task ": ") "")]) - (apply fprintf p (string-append name-str ": " task s "\n") args) + (apply fprintf p + (string-append name-str ": " task s + (if timestamp-output? + (format " @ ~a" (current-process-milliseconds)) + "") + "\n") + args) (flush-output p))) (define (setup-printf task s . args) @@ -160,6 +166,16 @@ (define limit-cross-collection-cache? (getenv "PLT_SETUP_LIMIT_CACHE")) + ;; In non-parallel mode, forcing a GC after each collection or + ;; document is a relatively good time-to-space tradeoff, so do that + ;; unless `PLT_SETUP_NO_FORCE_GC` is set: + (define gc-after-each-sequential? + (not (getenv "PLT_SETUP_NO_FORCE_GC"))) + + ;; Option to show CPU time since startup on each status line: + (define timestamp-output? + (and (getenv "PLT_SETUP_SHOW_TIMESTAMPS") #t)) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Errors ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1086,7 +1102,9 @@ (setup-printf "making" "~a" (cc-name cc)) (control-io (lambda (p where) - (set! gcs 2) + (when gc-after-each-sequential? + ;; trigger `(collect-garbage)` afterward, and again after next collection: + (set! gcs 2)) (setup-fprintf p #f " in ~a" (path->relative-string/setup (path->complete-path where (cc-path cc)) @@ -1416,7 +1434,8 @@ latex-dest auto-start-doc? (make-user) (force-user-docs) (make-tidy) (avoid-main-installation) (lambda (what go alt) (record-error what "building docs" go alt)) - setup-printf)) + setup-printf + gc-after-each-sequential?)) (define (make-docs-step) (setup-printf #f (add-time "--- building documentation ---"))