From ad98dc0ddf06f4097fffc06583f069c7fccee825 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 30 Oct 2012 09:28:15 -0600 Subject: [PATCH] track import "shapes" as procedure or structure type Shape information allows the linker to check the importing module's compile-time expectation against the run-time value of its imports. The JIT, in turn, can rely on that checking to better inline structure-type predicates, etc., and to more directy call JIT-generated code across module boundaries. In addition to checking the "shape" of an import, the import's JITted vs. non-JITted state must be consistent. To prevent shifts in JIT state, the `eval-jit-enabled' parameter is now restricted in its effect to top-level bindings. original commit: d7bf6776450abf0524975a2b09e8568760621e77 --- collects/compiler/decompile.rkt | 15 +++++++++++- collects/compiler/zo-marshal.rkt | 42 ++++++++++++++++++++++++++++++-- collects/compiler/zo-parse.rkt | 28 +++++++++++++++++++++ collects/compiler/zo-structs.rkt | 15 +++++++++++- 4 files changed, 96 insertions(+), 4 deletions(-) diff --git a/collects/compiler/decompile.rkt b/collects/compiler/decompile.rkt index 1411e6d50f..2217060f65 100644 --- a/collects/compiler/decompile.rkt +++ b/collects/compiler/decompile.rkt @@ -78,7 +78,20 @@ (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) + (string->symbol (format "_~s~a@~s~a" + sym + (match constantness + ['constant ":c"] + ['fixed ":f"] + [(function-shape a pm?) + (if pm? ":P" ":p")] + [(struct-type-shape c) ":t"] + [(constructor-shape a) ":mk"] + [(predicate-shape) ":?"] + [(accessor-shape c) ":ref"] + [(mutator-shape c) ":set!"] + [else ""]) + (mpi->string modidx) (if (zero? phase) "" (format "/~a" phase)))))] diff --git a/collects/compiler/zo-marshal.rkt b/collects/compiler/zo-marshal.rkt index 9f39c208ad..b9e1333a99 100644 --- a/collects/compiler/zo-marshal.rkt +++ b/collects/compiler/zo-marshal.rkt @@ -604,13 +604,51 @@ [(? void?) (out-byte CPT_VOID out)] [(struct module-variable (modidx sym pos phase constantness)) + (define (to-sym n) (string->symbol (format "struct~a" n))) (out-byte CPT_MODULE_VAR out) (out-anything modidx out) (out-anything sym out) + (out-anything (cond + [(function-shape? constantness) + (let ([a (function-shape-arity constantness)]) + (cond + [(arity-at-least? a) + (bitwise-ior (arithmetic-shift (- (add1 (arity-at-least-value a))) 1) + (if (function-shape-preserves-marks? constantness) 1 0))] + [(list? a) + (string->symbol (apply + string-append + (add-between + (for/list ([a (in-list a)]) + (define n (if (arity-at-least? a) + (- (add1 (arity-at-least-value a))) + a)) + (number->string n)) + ":")))] + [else + (bitwise-ior (arithmetic-shift a 1) + (if (function-shape-preserves-marks? constantness) 1 0))]))] + [(struct-type-shape? constantness) + (to-sym (arithmetic-shift (struct-type-shape-field-count constantness) + 4))] + [(constructor-shape? constantness) + (to-sym (bitwise-ior 1 (arithmetic-shift (constructor-shape-arity constantness) + 4)))] + [(predicate-shape? constantness) (to-sym 2)] + [(accessor-shape? constantness) + (to-sym (bitwise-ior 3 (arithmetic-shift (accessor-shape-field-count constantness) + 4)))] + [(mutator-shape? constantness) + (to-sym (bitwise-ior 4 (arithmetic-shift (mutator-shape-field-count constantness) + 4)))] + [(struct-other-shape? constantness) + (to-sym 5)] + [else #f]) + out) (case constantness - [(constant) (out-number -4 out)] + [(#f) (void)] [(fixed) (out-number -5 out)] - [else (void)]) + [else (out-number -4 out)]) (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 13856e48e0..18e7426b01 100644 --- a/collects/compiler/zo-parse.rkt +++ b/collects/compiler/zo-parse.rkt @@ -856,6 +856,7 @@ [(module-var) (let ([mod (read-compact cp)] [var (read-compact cp)] + [shape (read-compact cp)] [pos (read-compact-number cp)]) (let-values ([(flags mod-phase pos) (let loop ([pos pos]) @@ -869,6 +870,33 @@ [else (values 0 0 pos)]))]) (make-module-variable mod var pos mod-phase (cond + [shape + (cond + [(number? shape) + (define n (arithmetic-shift shape -1)) + (make-function-shape (if (negative? n) + (make-arity-at-least (sub1 (- n))) + n) + (odd? shape))] + [(and (symbol? shape) + (regexp-match? #rx"^struct" (symbol->string shape))) + (define n (string->number (substring (symbol->string shape) 6))) + (case (bitwise-and n #x7) + [(0) (make-struct-type-shape (arithmetic-shift n -3))] + [(1) (make-constructor-shape (arithmetic-shift n -3))] + [(2) (make-predicate-shape)] + [(3) (make-accessor-shape (arithmetic-shift n -3))] + [(4) (make-mutator-shape (arithmetic-shift n -3))] + [else (make-struct-other-shape)])] + [else + ;; parse symbol as ":"-separated sequence of arities + (make-function-shape + (for/list ([s (regexp-split #rx":" (symbol->string shape))]) + (define i (string->number s)) + (if (negative? i) + (make-arity-at-least (sub1 (- i))) + i)) + #f)])] [(not (zero? (bitwise-and #x1 flags))) 'constant] [(not (zero? (bitwise-and #x2 flags))) 'fixed] [else #f]))))] diff --git a/collects/compiler/zo-structs.rkt b/collects/compiler/zo-structs.rkt index 3fc6b2c11d..a2aa9c284b 100644 --- a/collects/compiler/zo-structs.rkt +++ b/collects/compiler/zo-structs.rkt @@ -38,13 +38,26 @@ [(_ id . rest) (define-form-struct* id (id zo) . rest)])) +(define-form-struct function-shape ([arity procedure-arity?] + [preserves-marks? boolean?])) + +(define-form-struct struct-shape ()) +(define-form-struct (constructor-shape struct-shape) ([arity exact-nonnegative-integer?])) +(define-form-struct (predicate-shape struct-shape) ()) +(define-form-struct (accessor-shape struct-shape) ([field-count exact-nonnegative-integer?])) +(define-form-struct (mutator-shape struct-shape) ([field-count exact-nonnegative-integer?])) +(define-form-struct (struct-type-shape struct-shape) ([field-count exact-nonnegative-integer?])) +(define-form-struct (struct-other-shape struct-shape) ()) + ;; 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 exact-nonnegative-integer?] - [constantness (or/c #f 'constant 'fixed)])) + [constantness (or/c #f 'constant 'fixed + function-shape? + struct-shape?)])) ;; Syntax object (define ((alist/c k? v?) l)