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.
253 lines
14 KiB
Racket
253 lines
14 KiB
Racket
#lang scheme/base
|
|
(require mzlib/etc
|
|
scheme/match
|
|
scheme/contract
|
|
scheme/list
|
|
racket/set)
|
|
|
|
#| Unresolved issues
|
|
|
|
what are the booleans in lexical-rename?
|
|
|
|
contracts that are probably too generous:
|
|
prefix-stxs
|
|
provided-nom-src
|
|
lam-num-params
|
|
lexical-rename-alist
|
|
all-from-module
|
|
|
|
|#
|
|
|
|
;; ----------------------------------------
|
|
;; Structures to represent bytecode
|
|
|
|
(define-syntax-rule (define-form-struct* id id+par ([field-id field-contract] ...))
|
|
(begin
|
|
(define-struct id+par (field-id ...) #:prefab)
|
|
#;(provide (struct-out id))
|
|
(provide/contract
|
|
[struct id ([field-id field-contract] ...)])))
|
|
|
|
(define-struct zo () #:prefab)
|
|
(provide zo?)
|
|
|
|
(define-syntax define-form-struct
|
|
(syntax-rules ()
|
|
[(_ (id sup) . rest)
|
|
(define-form-struct* id (id sup) . rest)]
|
|
[(_ id . rest)
|
|
(define-form-struct* id (id zo) . rest)]))
|
|
|
|
;; In toplevels of resove prefix:
|
|
(define-form-struct global-bucket ([name symbol?])) ; top-level binding
|
|
(define-form-struct module-variable ([modidx module-path-index?]
|
|
[sym symbol?]
|
|
[pos exact-integer?]
|
|
[phase (or/c 0 1)])) ; direct access to exported id
|
|
|
|
;; Syntax object
|
|
(define ((alist/c k? v?) l)
|
|
(let loop ([l l])
|
|
(match l
|
|
[(list) #t]
|
|
[(list* (? k?) (? v?) l)
|
|
(loop l)]
|
|
[_ #f])))
|
|
|
|
(define mark-map?
|
|
(alist/c number? module-path-index?)
|
|
#;(hash/c number? module-path-index?))
|
|
(define-form-struct certificate ())
|
|
(define-form-struct (certificate:nest certificate)
|
|
([nested mark-map?]
|
|
[map mark-map?]))
|
|
(define-form-struct (certificate:ref certificate)
|
|
([val any/c]
|
|
[map mark-map?]))
|
|
(define-form-struct (certificate:plain certificate)
|
|
([map mark-map?]))
|
|
|
|
|
|
(define-form-struct wrap ())
|
|
(define-form-struct wrapped ([datum any/c]
|
|
[wraps (listof wrap?)]
|
|
[certs (or/c certificate? #f)]))
|
|
|
|
;; In stxs of prefix:
|
|
(define-form-struct stx ([encoded wrapped?]))
|
|
|
|
(define-form-struct prefix ([num-lifts exact-nonnegative-integer?]
|
|
[toplevels (listof (or/c #f symbol? global-bucket? module-variable?))]
|
|
[stxs list?])) ; should be (listof stx?) sets up top-level and syntax-object array
|
|
|
|
(define-form-struct form ())
|
|
(define-form-struct (expr form) ())
|
|
|
|
(define-form-struct compilation-top ([max-let-depth exact-nonnegative-integer?] [prefix prefix?] [code (or/c form? any/c)])) ; compiled code always wrapped with this
|
|
|
|
;; A provided identifier
|
|
(define-form-struct provided ([name symbol?]
|
|
[src (or/c module-path-index? #f)]
|
|
[src-name symbol?]
|
|
[nom-src any/c] ; should be (or/c module-path-index? #f)
|
|
[src-phase (or/c 0 1)]
|
|
[protected? boolean?]
|
|
[insp (or/c boolean? void?)]))
|
|
|
|
(define-form-struct (toplevel expr) ([depth exact-nonnegative-integer?]
|
|
[pos exact-nonnegative-integer?]
|
|
[const? boolean?]
|
|
[ready? boolean?])) ; access binding via prefix array (which is on stack)
|
|
|
|
(define-form-struct (seq form) ([forms (listof (or/c form? any/c))])) ; `begin'
|
|
|
|
;; Definitions (top level or within module):
|
|
(define-form-struct (def-values form) ([ids (listof (or/c toplevel? symbol?))] ; added symbol?
|
|
[rhs (or/c expr? seq? any/c)]))
|
|
(define-form-struct (def-syntaxes form) ([ids (listof (or/c toplevel? symbol?))] ; added symbol?
|
|
[rhs (or/c expr? seq? any/c)]
|
|
[prefix prefix?]
|
|
[max-let-depth exact-nonnegative-integer?]))
|
|
(define-form-struct (def-for-syntax form) ([ids (listof (or/c toplevel? symbol?))] ; added symbol?
|
|
[rhs (or/c expr? seq? any/c)]
|
|
[prefix prefix?]
|
|
[max-let-depth exact-nonnegative-integer?]))
|
|
|
|
(define-form-struct (mod form) ([name symbol?]
|
|
[srcname symbol?]
|
|
[self-modidx module-path-index?]
|
|
[prefix prefix?]
|
|
[provides (listof (list/c (or/c exact-integer? #f)
|
|
(listof provided?)
|
|
(listof provided?)))]
|
|
[requires (listof (cons/c (or/c exact-integer? #f)
|
|
(listof module-path-index?)))]
|
|
[body (listof (or/c form? any/c))]
|
|
[syntax-body (listof (or/c def-syntaxes? def-for-syntax?))]
|
|
[unexported (list/c (listof symbol?) (listof symbol?)
|
|
(listof symbol?))]
|
|
[max-let-depth exact-nonnegative-integer?]
|
|
[dummy toplevel?]
|
|
[lang-info (or/c #f (vector/c module-path? symbol? any/c))]
|
|
[internal-context (or/c #f #t stx?)]))
|
|
|
|
(define-form-struct (lam expr) ([name (or/c symbol? vector? empty?)]
|
|
[flags (listof (or/c 'preserves-marks 'is-method 'single-result
|
|
'only-rest-arg-not-used 'sfs-clear-rest-args))]
|
|
[num-params exact-nonnegative-integer?]
|
|
[param-types (listof (or/c 'val 'ref 'flonum))]
|
|
[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)
|
|
(define-form-struct (case-lam expr) ([name (or/c symbol? vector? empty?)] [clauses (listof (or/c lam? closure?))]))
|
|
|
|
(define-form-struct (let-one expr) ([rhs (or/c expr? seq? any/c)] [body (or/c expr? seq? any/c)] [flonum? boolean?] [unused? boolean?])) ; pushes one value onto stack
|
|
(define-form-struct (let-void expr) ([count exact-nonnegative-integer?] [boxes? boolean?] [body (or/c expr? seq? any/c)])) ; create new stack slots
|
|
(define-form-struct (install-value expr) ([count exact-nonnegative-integer?]
|
|
[pos exact-nonnegative-integer?]
|
|
[boxes? boolean?]
|
|
[rhs (or/c expr? seq? any/c)]
|
|
[body (or/c expr? seq? any/c)])) ; set existing stack slot(s)
|
|
(define-form-struct (let-rec expr) ([procs (listof lam?)] [body (or/c expr? seq? any/c)])) ; put `letrec'-bound closures into existing stack slots
|
|
(define-form-struct (boxenv expr) ([pos exact-nonnegative-integer?] [body (or/c expr? seq? any/c)])) ; box existing stack element
|
|
|
|
(define-form-struct (localref expr) ([unbox? boolean?] [pos exact-nonnegative-integer?] [clear? boolean?] [other-clears? boolean?] [flonum? boolean?])) ; access local via stack
|
|
|
|
|
|
(define-form-struct (topsyntax expr) ([depth exact-nonnegative-integer?] [pos exact-nonnegative-integer?] [midpt exact-nonnegative-integer?])) ; access syntax object via prefix array (which is on stack)
|
|
|
|
(define-form-struct (application expr) ([rator (or/c expr? seq? any/c)] [rands (listof (or/c expr? seq? any/c))])) ; function call
|
|
(define-form-struct (branch expr) ([test (or/c expr? seq? any/c)] [then (or/c expr? seq? any/c)] [else (or/c expr? seq? any/c)])) ; `if'
|
|
(define-form-struct (with-cont-mark expr) ([key (or/c expr? seq? any/c)]
|
|
[val (or/c expr? seq? any/c)]
|
|
[body (or/c expr? seq? any/c)])) ; `with-continuation-mark'
|
|
(define-form-struct (beg0 expr) ([seq (listof (or/c expr? seq? any/c))])) ; `begin0'
|
|
(define-form-struct (splice form) ([forms (listof (or/c form? any/c))])) ; top-level `begin'
|
|
(define-form-struct (varref expr) ([toplevel toplevel?])) ; `#%variable-reference'
|
|
(define-form-struct (assign expr) ([id toplevel?] [rhs (or/c expr? seq? any/c)] [undef-ok? boolean?])) ; top-level or module-level set!
|
|
(define-form-struct (apply-values expr) ([proc (or/c expr? seq? any/c)] [args-expr (or/c expr? seq? any/c)])) ; `(call-with-values (lambda () ,args-expr) ,proc)
|
|
(define-form-struct (primval expr) ([id exact-nonnegative-integer?])) ; direct preference to a kernel primitive
|
|
|
|
;; Top-level `require'
|
|
(define-form-struct (req form) ([reqs stx?] [dummy toplevel?]))
|
|
|
|
|
|
(define-form-struct free-id-info ([path0 module-path-index?]
|
|
[symbol0 symbol?]
|
|
[path1 module-path-index?]
|
|
[symbol1 symbol?]
|
|
[phase0 (or/c exact-integer? #f)]
|
|
[phase1 (or/c exact-integer? #f)]
|
|
[phase2 (or/c exact-integer? #f)]
|
|
[use-current-inspector? boolean?]))
|
|
|
|
(define-form-struct (lexical-rename wrap) ([has-free-id-renames? boolean?]
|
|
[bool2 boolean?] ; this needs a name
|
|
[alist (listof
|
|
(cons/c symbol?
|
|
(or/c
|
|
symbol?
|
|
(cons/c
|
|
symbol?
|
|
(or/c
|
|
(cons/c symbol? (or/c symbol? #f))
|
|
free-id-info?)))))]))
|
|
(define-form-struct (phase-shift wrap) ([amt exact-integer?] [src (or/c module-path-index? #f)] [dest (or/c module-path-index? #f)]))
|
|
(define-form-struct (wrap-mark wrap) ([val exact-integer?]))
|
|
(define-form-struct (prune wrap) ([sym any/c]))
|
|
|
|
(define-form-struct all-from-module ([path module-path-index?]
|
|
[phase (or/c exact-integer? #f)]
|
|
[src-phase any/c] ; should be (or/c exact-integer? #f)
|
|
[exceptions (or/c (listof (or/c symbol? number?)) #f)] ; should be (listof symbol?)
|
|
[prefix (or/c (vector/c (or/c symbol? #f)) #f)])) ; should be (or/c symbol? #f)
|
|
|
|
(define-form-struct nominal-path ())
|
|
(define-form-struct (simple-nominal-path nominal-path) ([value module-path-index?]))
|
|
(define-form-struct (imported-nominal-path nominal-path) ([value module-path-index?]
|
|
[import-phase exact-integer?]))
|
|
(define-form-struct (phased-nominal-path nominal-path) ([value module-path-index?]
|
|
[import-phase (or/c false/c exact-integer?)]
|
|
[phase exact-integer?]))
|
|
|
|
(define-form-struct module-binding ())
|
|
(define-form-struct (phased-module-binding module-binding) ([path module-path-index?]
|
|
[phase exact-integer?]
|
|
[export-name any/c]
|
|
[nominal-path nominal-path?]
|
|
[nominal-export-name any/c]))
|
|
(define-form-struct (exported-nominal-module-binding module-binding) ([path module-path-index?]
|
|
[export-name any/c]
|
|
[nominal-path nominal-path?]
|
|
[nominal-export-name any/c]))
|
|
(define-form-struct (nominal-module-binding module-binding) ([path module-path-index?]
|
|
[nominal-path nominal-path?]))
|
|
(define-form-struct (exported-module-binding module-binding) ([path module-path-index?]
|
|
[export-name any/c]))
|
|
(define-form-struct (simple-module-binding module-binding) ([path module-path-index?]))
|
|
|
|
(define-form-struct (module-rename wrap) ([phase (or/c exact-integer? #f)]
|
|
[kind (or/c 'marked 'normal)]
|
|
[set-id any/c]
|
|
[unmarshals (listof all-from-module?)]
|
|
[renames (listof (cons/c symbol? module-binding?))]
|
|
[mark-renames any/c]
|
|
[plus-kern? boolean?]))
|
|
|
|
; XXX better name for 'flag'
|
|
(define-form-struct (top-level-rename wrap) ([flag boolean?]))
|
|
|
|
; XXX better name for 'value'
|
|
(define-form-struct (mark-barrier wrap) ([value symbol?]))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|