suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

break link to namespaces from from closures over top-/module-level vars

Browse Source 
- 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.

original commit: 2ada6d0e89
This commit is contained in:
Matthew Flatt 2011-05-02 20:41:59 -06:00
parent 9f2fba9625
commit 1955c935ff
6 changed files with 81 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
collects/compiler/decompile.rkt
View File

@ -2,7 +2,8 @@
(require compiler/zo-parse
syntax/modcollapse
scheme/port
scheme/match)
scheme/match
racket/set)
(provide decompile)
@ -42,6 +43,8 @@
;; ----------------------------------------
(define-struct glob-desc (vars num-tls num-stxs num-lifts))
;; Main entry:
(define (decompile top)
(match top
@ -56,30 +59,34 @@
(match a-prefix
[(struct prefix (num-lifts toplevels stxs))
(let ([lift-ids (for/list ([i (in-range num-lifts)])
(gensym 'lift))]
(gensym 'lift))]
[stx-ids (map (lambda (i) (gensym 'stx))
stxs)])
(values (append
(map (lambda (tl)
(match tl
[#f '#%linkage]
[(? symbol?) (string->symbol (format "_~a" tl))]
[(struct global-bucket (name))
(string->symbol (format "_~a" name))]
[(struct module-variable (modidx sym pos phase))
(if (and (module-path-index? modidx)
(let-values ([(n b) (module-path-index-split modidx)])
(and (not n) (not b))))
(string->symbol (format "_~a" sym))
(string->symbol (format "_~s@~s~a" sym (mpi->string modidx)
(if (zero? phase)
""
(format "/~a" phase)))))]
[else (error 'decompile-prefix "bad toplevel: ~e" tl)]))
toplevels)
stx-ids
(if (null? stx-ids) null '(#%stx-array))
lift-ids)
(values (glob-desc
(append
(map (lambda (tl)
(match tl
[#f '#%linkage]
[(? symbol?) (string->symbol (format "_~a" tl))]
[(struct global-bucket (name))
(string->symbol (format "_~a" name))]
[(struct module-variable (modidx sym pos phase))
(if (and (module-path-index? modidx)
(let-values ([(n b) (module-path-index-split modidx)])
(and (not n) (not b))))
(string->symbol (format "_~a" sym))
(string->symbol (format "_~s@~s~a" sym (mpi->string modidx)
(if (zero? phase)
""
(format "/~a" phase)))))]
[else (error 'decompile-prefix "bad toplevel: ~e" tl)]))
toplevels)
stx-ids
(if (null? stx-ids) null '(#%stx-array))
lift-ids)
(length toplevels)
(length stxs)
num-lifts)
(map (lambda (stx id)
`(define ,id ,(if stx
`(#%decode-syntax ,(stx-encoded stx))
@ -117,7 +124,7 @@
`(define-values ,(map (lambda (tl)
(match tl
[(struct toplevel (depth pos const? mutated?))
(list-ref/protect globs pos 'def-vals)]))
(list-ref/protect (glob-desc-vars globs) pos 'def-vals)]))
ids)
,(decompile-expr rhs globs stack closed))]
[(struct def-syntaxes (ids rhs prefix max-let-depth))
@ -154,7 +161,7 @@
(define (extract-id expr)
(match expr
[(struct lam (name flags num-params arg-types rest? closure-map closure-types max-let-depth body))
[(struct lam (name flags num-params arg-types rest? closure-map closure-types tl-map max-let-depth body))
(extract-name name)]
[(struct case-lam (name lams))
(extract-name name)]
@ -179,7 +186,7 @@
(define (decompile-tl expr globs stack closed no-check?)
(match expr
[(struct toplevel (depth pos const? ready?))
(let ([id (list-ref/protect globs pos 'toplevel)])
(let ([id (list-ref/protect (glob-desc-vars globs) pos 'toplevel)])
(if (or no-check? const? ready?)
id
`(#%checked ,id)))]))
@ -191,7 +198,7 @@
[(struct varref (tl))
`(#%variable-reference ,(decompile-tl tl globs stack closed #t))]
[(struct topsyntax (depth pos midpt))
(list-ref/protect globs (+ midpt pos) 'topsyntax)]
(list-ref/protect (glob-desc-vars globs) (+ midpt pos) 'topsyntax)]
[(struct primval (id))
(hash-ref primitive-table id)]
[(struct assign (id rhs undef-ok?))
@ -291,7 +298,7 @@
(define (decompile-lam expr globs stack closed)
(match expr
[(struct closure (lam gen-id)) (decompile-lam lam globs stack closed)]
[(struct lam (name flags num-params arg-types rest? closure-map closure-types max-let-depth body))
[(struct lam (name flags num-params arg-types rest? closure-map closure-types tl-map max-let-depth body))
(let ([vars (for/list ([i (in-range num-params)]
[type (in-list arg-types)])
(gensym (format "~a~a-"
@ -315,7 +322,16 @@
`(flonum ,c)
c))
captures
closure-types))))
closure-types)
,@(if (not tl-map)
'()
(list
(for/list ([pos (in-set tl-map)])
(list-ref/protect (glob-desc-vars globs)
(if (pos . < . (glob-desc-num-tls globs))
pos
(+ pos (glob-desc-num-stxs globs) 1))
'lam)))))))
,(decompile-expr body globs
(append captures
(append vars rest-vars))

5
collects/compiler/demodularizer/gc-toplevels.rkt
View File

@ -74,7 +74,7 @@
(for-each (lambda (f) (build-graph! lhs f)) forms)]
[(struct splice (forms))
(for-each (lambda (f) (build-graph! lhs f)) forms)]
[(and l (struct lam (name flags num-params param-types rest? closure-map closure-types max-let-depth body)))
[(and l (struct lam (name flags num-params param-types rest? closure-map closure-types tl-map max-let-depth body)))
(build-graph! lhs body)]
[(and c (struct closure (code gen-id)))
(build-graph! lhs code)]
@ -206,8 +206,9 @@
(make-seq (filter identity (map update forms)))]
[(struct splice (forms))
(make-splice (filter identity (map update forms)))]
[(and l (struct lam (name flags num-params param-types rest? closure-map closure-types max-let-depth body)))
[(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] ; consevrative
[body (update body)])]
[(and c (struct closure (code gen-id)))
(struct-copy closure c

3
collects/compiler/demodularizer/update-toplevels.rkt
View File

@ -20,8 +20,9 @@
(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 max-let-depth body)))
[(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

13
collects/compiler/zo-marshal.rkt
View File

@ -968,7 +968,7 @@
(define (out-lam expr out)
(match expr
[(struct lam (name flags num-params param-types rest? closure-map closure-types max-let-depth body))
[(struct lam (name flags num-params param-types rest? closure-map closure-types toplevel-map max-let-depth body))
(let* ([l (protect-quote body)]
[any-refs? (or (ormap (lambda (t) (memq t '(ref flonum))) param-types)
(ormap (lambda (t) (memq t '(flonum))) closure-types))]
@ -1001,7 +1001,9 @@
l)]
[l (if any-refs?
(cons (vector-length closure-map) l)
l)])
l)]
[tl-map (for/fold ([v 0]) ([i (in-set toplevel-map)])
(bitwise-ior v (arithmetic-shift 1 i)))])
(out-marshaled unclosed-procedure-type-num
(list*
(+ (if rest? CLOS_HAS_REST 0)
@ -1012,6 +1014,13 @@
(if (memq 'single-result flags) CLOS_SINGLE_RESULT 0))
num-all-params
max-let-depth
(if (tl-map . < . #x7FFFFFFF)
tl-map
;; Encode as an even-sized vector of 16-bit integers:
(let ([len (* 2 (quotient (+ (integer-length tl-map) 31) 32))])
(for/vector ([i (in-range len)])
(let ([s (* i 16)])
(bitwise-bit-field tl-map s (+ s 16))))))
name
l)
out))]))

19
collects/compiler/zo-parse.rkt
View File

@ -5,7 +5,8 @@
scheme/list
unstable/struct
compiler/zo-structs
racket/dict)
racket/dict
racket/set)
(provide zo-parse)
(provide (all-from-out compiler/zo-structs))
@ -86,7 +87,7 @@
(define CLOS_SINGLE_RESULT 32)
(define BITS_PER_MZSHORT 32)
(match v
[`(,flags ,num-params ,max-let-depth ,name ,v . ,rest)
[`(,flags ,num-params ,max-let-depth ,tl-map ,name ,v . ,rest)
(let ([rest? (positive? (bitwise-and flags CLOS_HAS_REST))])
(let*-values ([(closure-size closed-over body)
(if (zero? (bitwise-and flags CLOS_HAS_REF_ARGS))
@ -132,6 +133,20 @@
(vector-copy! v2 0 closed-over 0 closure-size)
v2))
closure-types
(and tl-map
(let* ([bits (if (exact-integer? tl-map)
tl-map
(for/fold ([i 0]) ([v (in-list tl-map)]
[s (in-naturals)])
(bitwise-ior i (arithmetic-shift v 16))))]
[len (integer-length bits)])
(list->set
(let loop ([bit 0])
(cond
[(bit . >= . len) null]
[(bitwise-bit-set? bits bit)
(cons bit (loop (add1 bit)))]
[else (loop (add1 bit))])))))
max-let-depth
body)))]))

4
collects/compiler/zo-structs.rkt
View File

@ -2,7 +2,8 @@
(require mzlib/etc
scheme/match
scheme/contract
scheme/list)
scheme/list
racket/set)
#| Unresolved issues
@ -138,6 +139,7 @@
[rest? boolean?]
[closure-map (vectorof exact-nonnegative-integer?)]
[closure-types (listof (or/c 'val/ref 'flonum))]
[toplevel-map (or/c #f (set/c exact-nonnegative-integer?))]
[max-let-depth exact-nonnegative-integer?]
[body (or/c expr? seq? any/c)])) ; `lambda'
(define-form-struct (closure expr) ([code lam?] [gen-id symbol?])) ; a static closure (nothing to close over)