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

13
collects/scribble/manual.ss
View File

@ -376,19 +376,16 @@
(hash-ref
checkers lib
(lambda ()
(let ([ns-id
(let ([ns (make-base-empty-namespace)])
(parameterize ([current-namespace ns])
(namespace-require `(for-label ,lib)))
(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)))])
(datum->syntax ns-id (syntax-e id))
id))])
(hash-set! checkers lib checker)
checker))))])
(and (checker id) lib)))

26
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,6 +398,8 @@
(path->name (doc-src-file doc)))
(if up-to-date?
;; Load previously calculated info:
(render-time
"use"
(with-handlers ([exn:fail? (lambda (exn)
(fprintf (current-error-port) "~a\n" (exn-message exn))
(delete-file info-out-file)
@ -410,8 +408,8 @@
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)])
(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"))
@ -441,7 +439,7 @@
#f #f
vers
#f
#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)