From 4807353e8d7c2e90e17a0eac09b12fd12607cd0f Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 19 Oct 2012 07:09:56 -0600 Subject: [PATCH] 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: e59066debe046e808263e26387e94d6fcdb79f2a --- collects/compiler/decompile.rkt | 2 +- collects/compiler/demodularizer/merge.rkt | 4 ++-- collects/compiler/demodularizer/nodep.rkt | 2 +- collects/compiler/zo-marshal.rkt | 6 +++++- collects/compiler/zo-parse.rkt | 20 +++++++++++++++----- collects/compiler/zo-structs.rkt | 3 ++- 6 files changed, 26 insertions(+), 11 deletions(-) diff --git a/collects/compiler/decompile.rkt b/collects/compiler/decompile.rkt index 645d294e68..1411e6d50f 100644 --- a/collects/compiler/decompile.rkt +++ b/collects/compiler/decompile.rkt @@ -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)))) diff --git a/collects/compiler/demodularizer/merge.rkt b/collects/compiler/demodularizer/merge.rkt index aff21cee1b..5b087e257f 100644 --- a/collects/compiler/demodularizer/merge.rkt +++ b/collects/compiler/demodularizer/merge.rkt @@ -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)) diff --git a/collects/compiler/demodularizer/nodep.rkt b/collects/compiler/demodularizer/nodep.rkt index cb717a1a2c..60afbaf7ec 100644 --- a/collects/compiler/demodularizer/nodep.rkt +++ b/collects/compiler/demodularizer/nodep.rkt @@ -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)]) diff --git a/collects/compiler/zo-marshal.rkt b/collects/compiler/zo-marshal.rkt index e0a96c0feb..9f39c208ad 100644 --- a/collects/compiler/zo-marshal.rkt +++ b/collects/compiler/zo-marshal.rkt @@ -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)) diff --git a/collects/compiler/zo-parse.rkt b/collects/compiler/zo-parse.rkt index 229ecc9544..13856e48e0 100644 --- a/collects/compiler/zo-parse.rkt +++ b/collects/compiler/zo-parse.rkt @@ -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*)] diff --git a/collects/compiler/zo-structs.rkt b/collects/compiler/zo-structs.rkt index 1065cf265c..3fc6b2c11d 100644 --- a/collects/compiler/zo-structs.rkt +++ b/collects/compiler/zo-structs.rkt @@ -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)