bytecode validator: check "constant" annotations on variable references

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

View File

@ -73,7 +73,7 @@
[(? symbol?) (string->symbol (format "_~a" tl))] [(? symbol?) (string->symbol (format "_~a" tl))]
[(struct global-bucket (name)) [(struct global-bucket (name))
(string->symbol (format "_~a" 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) (if (and (module-path-index? modidx)
(let-values ([(n b) (module-path-index-split modidx)]) (let-values ([(n b) (module-path-index-split modidx)])
(and (not n) (not b)))) (and (not n) (not b))))

View File

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

View File

@ -118,7 +118,7 @@
(define new-prefix prefix) (define new-prefix prefix)
; Cache all the mpi paths ; Cache all the mpi paths
(for-each (match-lambda (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)] (mpi->path! modidx)]
[tl [tl
(void)]) (void)])

View File

@ -603,10 +603,14 @@
(out-byte CPT_FALSE out)] (out-byte CPT_FALSE out)]
[(? void?) [(? void?)
(out-byte CPT_VOID out)] (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-byte CPT_MODULE_VAR out)
(out-anything modidx out) (out-anything modidx out)
(out-anything sym out) (out-anything sym out)
(case constantness
[(constant) (out-number -4 out)]
[(fixed) (out-number -5 out)]
[else (void)])
(unless (zero? phase) (unless (zero? phase)
(out-number -2 out) (out-number -2 out)
(out-number phase out)) (out-number phase out))

View File

@ -857,11 +857,21 @@
(let ([mod (read-compact cp)] (let ([mod (read-compact cp)]
[var (read-compact cp)] [var (read-compact cp)]
[pos (read-compact-number cp)]) [pos (read-compact-number cp)])
(let-values ([(mod-phase pos) (let-values ([(flags mod-phase pos)
(if (= pos -2) (let loop ([pos pos])
(values (read-compact-number cp) (read-compact-number cp)) (cond
(values 0 pos))]) [(pos . < . -3)
(make-module-variable mod var pos mod-phase)))] (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) [(local-unbox)
(let* ([p* (read-compact-number cp)] (let* ([p* (read-compact-number cp)]
[p (if (< p* 0) (- (add1 p*)) p*)] [p (if (< p* 0) (- (add1 p*)) p*)]

View File

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