2ada6d0e89
- the `lam' structure from `compiler/zo-struct' changed to include a `toplevel-map' field This change helps solve a finalization problem in `racket/draw', which in turn sigificantly reduces the peak memory use of `raco setup' during the doc-building phase (because some documents load `racket/draw' to render images, and multiple copies of `racket/draw' were retained before finalization was fixed). The change is an extreme way to solve a specific finalization problem, but it's a kind of space-safety improvement; space safety almost never matters, but when it does, then working around a lack of space safety is practically impossible. In this case, it's not clear how to otherwise solve the `racket/draw' finalization problem. The improvement doesn't change the representation of closures, but it requires special cooperation with the GC. All closures in a module continue to share the same array of globals (plus syntax objects); that is, instead of completely flat closures, Racket uses a two-level environment where top-/module-level variables are grouped together. The code half of a closure now records which top-/module-level variables the body code actually uses, and the mark phase of GC consults this information to retain only parts of the top-/module-level environment frame that are actually used by some closure (or all of the frame if it is accessible through some other route). In other words, the GC supports a kind of "dependent reference" to an array that is indexed by positions into the array --- except that the code is more in the "Racket" directory instead of the "GC" directory, since it's so specific to the closure representation.
99 lines
3.5 KiB
Racket
99 lines
3.5 KiB
Racket
#lang racket
|
|
(require compiler/zo-structs
|
|
"util.rkt")
|
|
|
|
(define (update-toplevels toplevel-updater topsyntax-updater topsyntax-new-midpt)
|
|
(define (inner-update form)
|
|
(match form
|
|
[(struct def-values (ids rhs))
|
|
(make-def-values (map update ids)
|
|
(update rhs))]
|
|
[(? def-syntaxes?)
|
|
(error 'increment "Doesn't handle syntax")]
|
|
[(? def-for-syntax?)
|
|
(error 'increment "Doesn't handle syntax")]
|
|
[(struct req (reqs dummy))
|
|
(make-req reqs (update dummy))]
|
|
[(? mod?)
|
|
(error 'increment "Doesn't handle modules")]
|
|
[(struct seq (forms))
|
|
(make-seq (map update forms))]
|
|
[(struct splice (forms))
|
|
(make-splice (map update forms))]
|
|
[(and l (struct lam (name flags num-params param-types rest? closure-map closure-types tl-map max-let-depth body)))
|
|
(struct-copy lam l
|
|
[toplevel-map #f] ; conservative
|
|
[body (update body)])]
|
|
[(and c (struct closure (code gen-id)))
|
|
(struct-copy closure c
|
|
[code (update code)])]
|
|
[(and cl (struct case-lam (name clauses)))
|
|
(define new-clauses
|
|
(map update clauses))
|
|
(struct-copy case-lam cl
|
|
[clauses new-clauses])]
|
|
[(struct let-one (rhs body flonum? unused?))
|
|
(make-let-one (update rhs) (update body) flonum? unused?)] ; Q: is it okay to just pass in the old value for flonum?
|
|
[(and f (struct let-void (count boxes? body)))
|
|
(struct-copy let-void f
|
|
[body (update body)])]
|
|
[(and f (struct install-value (_ _ _ rhs body)))
|
|
(struct-copy install-value f
|
|
[rhs (update rhs)]
|
|
[body (update body)])]
|
|
[(struct let-rec (procs body))
|
|
(make-let-rec (map update procs) (update body))]
|
|
[(and f (struct boxenv (_ body)))
|
|
(struct-copy boxenv f [body (update body)])]
|
|
[(and f (struct toplevel (_ pos _ _)))
|
|
(struct-copy toplevel f
|
|
[pos (toplevel-updater pos)])]
|
|
[(and f (struct topsyntax (_ pos _)))
|
|
(struct-copy topsyntax f
|
|
[pos (topsyntax-updater pos)]
|
|
[midpt topsyntax-new-midpt])]
|
|
[(struct application (rator rands))
|
|
(make-application
|
|
(update rator)
|
|
(map update rands))]
|
|
[(struct branch (test then else))
|
|
(make-branch
|
|
(update test)
|
|
(update then)
|
|
(update else))]
|
|
[(struct with-cont-mark (key val body))
|
|
(make-with-cont-mark
|
|
(update key)
|
|
(update val)
|
|
(update body))]
|
|
[(struct beg0 (seq))
|
|
(make-beg0 (map update seq))]
|
|
[(struct varref (tl))
|
|
(make-varref (update tl))]
|
|
[(and f (struct assign (id rhs undef-ok?)))
|
|
(struct-copy assign f
|
|
[id (update id)]
|
|
[rhs (update rhs)])]
|
|
[(struct apply-values (proc args-expr))
|
|
(make-apply-values
|
|
(update proc)
|
|
(update args-expr))]
|
|
[(and f (struct primval (id)))
|
|
f]
|
|
[(and f (struct localref (unbox? pos clear? other-clears? flonum?)))
|
|
f]
|
|
[(and f (not (? form?)))
|
|
f]
|
|
))
|
|
(define-values (first-update update)
|
|
(build-form-memo inner-update))
|
|
first-update)
|
|
|
|
(provide/contract
|
|
[update-toplevels
|
|
((exact-nonnegative-integer? . -> . exact-nonnegative-integer?)
|
|
(exact-nonnegative-integer? . -> . exact-nonnegative-integer?)
|
|
exact-nonnegative-integer?
|
|
. -> .
|
|
(form? . -> . form?))])
|