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

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

View File

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

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,6 +398,8 @@
(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:
(render-time
"use"
(with-handlers ([exn:fail? (lambda (exn) (with-handlers ([exn:fail? (lambda (exn)
(fprintf (current-error-port) "~a\n" (exn-message exn)) (fprintf (current-error-port) "~a\n" (exn-message exn))
(delete-file info-out-file) (delete-file info-out-file)
@ -410,8 +408,8 @@
auto-user? with-record-error auto-user? with-record-error
setup-printf) setup-printf)
doc))]) doc))])
(let* ([v-in (with-input-from-file info-in-file normalized-read)] (let* ([v-in (with-input-from-file info-in-file read-sxref)]
[v-out (with-input-from-file info-out-file read-out-sxref)]) [v-out (with-input-from-file info-out-file read-sxref)])
(unless (and (equal? (car v-in) (list vers (doc-flags doc))) (unless (and (equal? (car v-in) (list vers (doc-flags doc)))
(equal? (car v-out) (list vers (doc-flags doc)))) (equal? (car v-out) (list vers (doc-flags doc))))
(error "old info has wrong version or flags")) (error "old info has wrong version or flags"))
@ -441,7 +439,7 @@
#f #f #f #f
vers vers
#f #f
#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)