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

fix great awlful memory leak in scribble's collect phase (which was exposed most clearly by the web-server tutorial); change in.sxref to be use fasl (bytecode) format

Browse Source 
svn: r11989
This commit is contained in:
Matthew Flatt 2008-10-11 14:50:22 +00:00
parent 489f4b623c
commit 95fa65b7b3
2 changed files with 59 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/scribble/manual.ss
View File

@ -376,19 +376,16 @@
(hash-ref (hash-ref
checkers lib checkers lib
(lambda () (lambda ()
(let ([ns (make-base-empty-namespace)]) (let ([ns-id
(parameterize ([current-namespace ns]) (let ([ns (make-base-empty-namespace)])
(namespace-require `(for-label ,lib))) (parameterize ([current-namespace ns])
(namespace-require `(for-label ,lib))
(namespace-syntax-introduce (datum->syntax #f 'x))))])
(let ([checker (let ([checker
(lambda (id) (lambda (id)
(parameterize ([current-namespace (free-label-identifier=?
ns]) (datum->syntax ns-id (syntax-e id))
(free-label-identifier=? id))])
(namespace-syntax-introduce
(datum->syntax
#f
(syntax-e id)))
id)))])
(hash-set! checkers lib checker) (hash-set! checkers lib checker)
checker))))]) checker))))])
(and (checker id) lib))) (and (checker id) lib)))

100
collects/setup/scribble.ss
View File

@ -330,12 +330,9 @@
(for-each (lambda (k) (hash-set! ht k #t)) keys) (for-each (lambda (k) (hash-set! ht k #t)) keys)
ht)) ht))
(define (read-out-sxref) (define (read-sxref)
(fasl->s-exp (current-input-port))) (fasl->s-exp (current-input-port)))
(define (normalized-read)
(with-module-reading-parameterization read))
(define (make-sci-cached sci info-out-file setup-printf) (define (make-sci-cached sci info-out-file setup-printf)
(when (verbose) (when (verbose)
(fprintf (current-error-port) " [Lazy ~a]\n" info-out-file)) (fprintf (current-error-port) " [Lazy ~a]\n" info-out-file))
@ -348,7 +345,7 @@
(void) (void)
#; #;
(fprintf (current-error-port) " [Re-load ~a]\n" info-out-file)) (fprintf (current-error-port) " [Re-load ~a]\n" info-out-file))
(let ([v (cadr (with-input-from-file info-out-file read-out-sxref))]) (let ([v (cadr (with-input-from-file info-out-file read-sxref))])
(set! b (make-weak-box v)) (set! b (make-weak-box v))
v))))))) v)))))))
@ -360,7 +357,6 @@
doc) doc)
(let* ([info-out-file (build-path (or latex-dest (doc-dest-dir doc)) "out.sxref")] (let* ([info-out-file (build-path (or latex-dest (doc-dest-dir doc)) "out.sxref")]
[info-in-file (build-path (or latex-dest (doc-dest-dir doc)) "in.sxref")] [info-in-file (build-path (or latex-dest (doc-dest-dir doc)) "in.sxref")]
[out-file (build-path (doc-dest-dir doc) "index.html")]
[src-zo (let-values ([(base name dir?) (split-path (doc-src-file doc))]) [src-zo (let-values ([(base name dir?) (split-path (doc-src-file doc))])
(build-path base "compiled" (path-add-suffix name ".zo")))] (build-path base "compiled" (path-add-suffix name ".zo")))]
[renderer (make-renderer latex-dest doc)] [renderer (make-renderer latex-dest doc)]
@ -378,9 +374,9 @@
(build-path (collection-path "scribble") (build-path (collection-path "scribble")
"scribble.css") "scribble.css")
#f (lambda () +inf.0)))] #f (lambda () +inf.0)))]
[my-time (file-or-directory-modify-seconds out-file #f (lambda () -inf.0))]
[info-out-time (file-or-directory-modify-seconds info-out-file #f (lambda () #f))] [info-out-time (file-or-directory-modify-seconds info-out-file #f (lambda () #f))]
[info-in-time (file-or-directory-modify-seconds info-in-file #f (lambda () #f))] [info-in-time (file-or-directory-modify-seconds info-in-file #f (lambda () #f))]
[my-time (min (or info-out-time -inf.0) (or info-in-time -inf.0))]
[vers (send renderer get-serialize-version)] [vers (send renderer get-serialize-version)]
[up-to-date? [up-to-date?
(and info-out-time (and info-out-time
@ -402,46 +398,48 @@
(path->name (doc-src-file doc))) (path->name (doc-src-file doc)))
(if up-to-date? (if up-to-date?
;; Load previously calculated info: ;; Load previously calculated info:
(with-handlers ([exn:fail? (lambda (exn) (render-time
(fprintf (current-error-port) "~a\n" (exn-message exn)) "use"
(delete-file info-out-file) (with-handlers ([exn:fail? (lambda (exn)
(delete-file info-in-file) (fprintf (current-error-port) "~a\n" (exn-message exn))
((get-doc-info only-dirs latex-dest auto-main? (delete-file info-out-file)
auto-user? with-record-error (delete-file info-in-file)
setup-printf) ((get-doc-info only-dirs latex-dest auto-main?
doc))]) auto-user? with-record-error
(let* ([v-in (with-input-from-file info-in-file normalized-read)] setup-printf)
[v-out (with-input-from-file info-out-file read-out-sxref)]) doc))])
(unless (and (equal? (car v-in) (list vers (doc-flags doc))) (let* ([v-in (with-input-from-file info-in-file read-sxref)]
(equal? (car v-out) (list vers (doc-flags doc)))) [v-out (with-input-from-file info-out-file read-sxref)])
(error "old info has wrong version or flags")) (unless (and (equal? (car v-in) (list vers (doc-flags doc)))
(make-info (equal? (car v-out) (list vers (doc-flags doc))))
doc (error "old info has wrong version or flags"))
(make-sci-cached (make-info
(list-ref v-out 1) ; sci (leave serialized) doc
info-out-file (make-sci-cached
setup-printf) (list-ref v-out 1) ; sci (leave serialized)
(let ([v (list-ref v-out 2)]) ; provides info-out-file
(with-my-namespace setup-printf)
(lambda () (let ([v (list-ref v-out 2)]) ; provides
(deserialize v)))) (with-my-namespace
(let ([v (list-ref v-in 1)]) ; undef (lambda ()
(with-my-namespace (deserialize v))))
(lambda () (let ([v (list-ref v-in 1)]) ; undef
(deserialize v)))) (with-my-namespace
(let ([v (list-ref v-in 3)]) ; searches (lambda ()
(with-my-namespace (deserialize v))))
(lambda () (let ([v (list-ref v-in 3)]) ; searches
(deserialize v)))) (with-my-namespace
(map rel->path (list-ref v-in 2)) ; expected deps, in case we don't need to build... (lambda ()
null ; known deps (none at this point) (deserialize v))))
can-run? (map rel->path (list-ref v-in 2)) ; expected deps, in case we don't need to build...
my-time info-out-time null ; known deps (none at this point)
(and can-run? (memq 'always-run (doc-flags doc))) can-run?
#f #f my-time info-out-time
vers (and can-run? (memq 'always-run (doc-flags doc)))
#f #f #f
#f))) vers
#f
#f))))
(if can-run? (if can-run?
;; Run the doc once: ;; Run the doc once:
(with-record-error (with-record-error
@ -456,7 +454,7 @@
[ri (send renderer resolve (list v) (list dest-dir) ci)] [ri (send renderer resolve (list v) (list dest-dir) ci)]
[out-v (and info-out-time [out-v (and info-out-time
(with-handlers ([exn:fail? (lambda (exn) #f)]) (with-handlers ([exn:fail? (lambda (exn) #f)])
(let ([v (with-input-from-file info-out-file read-out-sxref)]) (let ([v (with-input-from-file info-out-file read-sxref)])
(unless (equal? (car v) (list vers (doc-flags doc))) (unless (equal? (car v) (list vers (doc-flags doc)))
(error "old info has wrong version or flags")) (error "old info has wrong version or flags"))
v)))] v)))]
@ -497,6 +495,10 @@
(unless latex-dest (unless latex-dest
(render-time "xref-out" (write-out info setup-printf))) (render-time "xref-out" (write-out info setup-printf)))
(set-info-need-out-write?! info #f)) (set-info-need-out-write?! info #f))
(when (info-need-in-write? info)
(unless latex-dest
(render-time "xref-in" (write-in info)))
(set-info-need-in-write?! info #f))
info)))) info))))
(lambda () #f)) (lambda () #f))
#f)))) #f))))
@ -644,7 +646,7 @@
setup-printf))) setup-printf)))
(define (write-in info) (define (write-in info)
(make-directory* (doc-dest-dir (info-doc info))) (make-directory* (doc-dest-dir (info-doc info)))
(write- info "in.sxref" (lambda (o i) (write (i))))) (write- info "in.sxref" (lambda (o i) (write-bytes (s-exp->fasl (i))))))
(define (rel->path r) (define (rel->path r)
(if (bytes? r) (if (bytes? r)