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:
parent
489f4b623c
commit
95fa65b7b3
|
@ -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)))
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user