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