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

bytecode validator: check "constant" annotations on variable references

Browse Source 
Bytecode changes in two small ways to help the validator:
 * a cross-module variable reference preserves the compiler's
   annotation on whether the reference is constant, fixed, or other
 * lifted procedures now appear in the module body just before the
   definitions that use them, instead of at the beginning of the
   module body

original commit: e59066debe
This commit is contained in:
Matthew Flatt 2012-10-19 07:09:56 -06:00
parent 5eaf286081
commit 4807353e8d
6 changed files with 26 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/compiler/decompile.rkt
View File

@ -73,7 +73,7 @@
[(? symbol?) (string->symbol (format "_~a" tl))]
[(struct global-bucket (name))
(string->symbol (format "_~a" name))]
[(struct module-variable (modidx sym pos phase))
[(struct module-variable (modidx sym pos phase constantness))
(if (and (module-path-index? modidx)
(let-values ([(n b) (module-path-index-split modidx)])
(and (not n) (not b))))

4
collects/compiler/demodularizer/merge.rkt
View File

@ -59,7 +59,7 @@
(define (compute-new-modvar mv rw)
(match mv
[(struct module-variable (modidx sym pos phase))
[(struct module-variable (modidx sym pos phase constantness))
(match rw
[(struct modvar-rewrite (self-modidx provide->toplevel))
(log-debug (format "Rewriting ~a of ~S" pos (mpi->path* modidx)))
@ -76,7 +76,7 @@
[remap empty])
([tl (in-list mod-toplevels)])
(match tl
[(and mv (struct module-variable (modidx sym pos phase)))
[(and mv (struct module-variable (modidx sym pos phase constantness)))
(define rw ((current-get-modvar-rewrite) modidx))
; XXX We probably don't need to deal with #f phase
(unless (or (not phase) (zero? phase))

2
collects/compiler/demodularizer/nodep.rkt
View File

@ -118,7 +118,7 @@
(define new-prefix prefix)
; Cache all the mpi paths
(for-each (match-lambda
[(and mv (struct module-variable (modidx sym pos phase)))
[(and mv (struct module-variable (modidx sym pos phase constantness)))
(mpi->path! modidx)]
[tl
(void)])

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

@ -603,10 +603,14 @@
(out-byte CPT_FALSE out)]
[(? void?)
(out-byte CPT_VOID out)]
[(struct module-variable (modidx sym pos phase))
[(struct module-variable (modidx sym pos phase constantness))
(out-byte CPT_MODULE_VAR out)
(out-anything modidx out)
(out-anything sym out)
(case constantness
[(constant) (out-number -4 out)]
[(fixed) (out-number -5 out)]
[else (void)])
(unless (zero? phase)
(out-number -2 out)
(out-number phase out))

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

@ -857,11 +857,21 @@
(let ([mod (read-compact cp)]
[var (read-compact cp)]
[pos (read-compact-number cp)])
(let-values ([(mod-phase pos)
(if (= pos -2)
(values (read-compact-number cp) (read-compact-number cp))
(values 0 pos))])
(make-module-variable mod var pos mod-phase)))]
(let-values ([(flags mod-phase pos)
(let loop ([pos pos])
(cond
[(pos . < . -3)
(let ([real-pos (read-compact-number cp)])
(define-values (_ m p) (loop real-pos))
(values (- (+ pos 3)) m p))]
[(= pos -2)
(values 0 (read-compact-number cp) (read-compact-number cp))]
[else (values 0 0 pos)]))])
(make-module-variable mod var pos mod-phase
(cond
[(not (zero? (bitwise-and #x1 flags))) 'constant]
[(not (zero? (bitwise-and #x2 flags))) 'fixed]
[else #f]))))]
[(local-unbox)
(let* ([p* (read-compact-number cp)]
[p (if (< p* 0) (- (add1 p*)) p*)]

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

@ -43,7 +43,8 @@
(define-form-struct module-variable ([modidx module-path-index?]
[sym symbol?]
[pos exact-integer?]
[phase exact-nonnegative-integer?]))
[phase exact-nonnegative-integer?]
[constantness (or/c #f 'constant 'fixed)]))
;; Syntax object
(define ((alist/c k? v?) l)