From 2f45cfcb9c7ff7561b2b12f4f042af950cb0ac68 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Wed, 1 Nov 2017 14:29:20 +0100 Subject: [PATCH] free-ref, free-set take immediate parameters * module/language/cps/closure-conversion.scm (convert-one): * module/language/cps/compile-bytecode.scm (compile-function): * module/language/cps/effects-analysis.scm (define-primitive-effects*) (expression-effects, primitive-effects): Only fall back to passing constant table if the immediate parameter is false. Adapt closure effects analysis. * module/language/cps/slot-allocation.scm (compute-needs-slot): Remove special cases for free-ref/free-set!. --- module/language/cps/closure-conversion.scm | 15 +++++-------- module/language/cps/compile-bytecode.scm | 9 ++++---- module/language/cps/effects-analysis.scm | 26 +++++++++------------- module/language/cps/slot-allocation.scm | 4 ---- 4 files changed, 21 insertions(+), 33 deletions(-) diff --git a/module/language/cps/closure-conversion.scm b/module/language/cps/closure-conversion.scm index bb159088b..298784d72 100644 --- a/module/language/cps/closure-conversion.scm +++ b/module/language/cps/closure-conversion.scm @@ -503,10 +503,9 @@ Otherwise @var{var} is bound, so @var{k} is called with @var{var}." (letv var*) (let$ body (k var*)) (letk k* ($kargs (#f) (var*) ,body)) - ($ (with-cps-constants ((idx idx)) - (build-term - ($continue k* #f - ($primcall 'free-ref #f (self idx))))))))))))) + (build-term + ($continue k* #f + ($primcall 'free-ref idx (self))))))))))) (else (with-cps cps ($ (k var)))))) @@ -609,11 +608,9 @@ bound to @var{var}, and continue to @var{k}." ($primcall 'scm->u64 #f (idx)))))))) (else (with-cps cps - ($ (with-cps-constants ((idx idx)) - (build-term - ($continue k src - ($primcall 'free-set! #f - (var idx v))))))))))))))))))) + (build-term + ($continue k src + ($primcall 'free-set! idx (var v))))))))))))))))) (define (make-single-closure cps k src kfun) (let ((free (intmap-ref free-vars kfun))) diff --git a/module/language/cps/compile-bytecode.scm b/module/language/cps/compile-bytecode.scm index 57a570f3c..78de18723 100644 --- a/module/language/cps/compile-bytecode.scm +++ b/module/language/cps/compile-bytecode.scm @@ -151,9 +151,8 @@ (emit-define! asm (from-sp dst) (from-sp (slot sym)))) (($ $primcall 'resolve (bound?) (name)) (emit-resolve asm (from-sp dst) bound? (from-sp (slot name)))) - (($ $primcall 'free-ref #f (closure idx)) - (emit-free-ref asm (from-sp dst) (from-sp (slot closure)) - (constant idx))) + (($ $primcall 'free-ref idx (closure)) + (emit-free-ref asm (from-sp dst) (from-sp (slot closure)) idx)) (($ $primcall 'vector-ref #f (vector index)) (emit-vector-ref asm (from-sp dst) (from-sp (slot vector)) (from-sp (slot index)))) @@ -302,9 +301,9 @@ (emit-j asm (forward-label khandler-body)))))) (($ $primcall 'cache-current-module! (scope) (mod)) (emit-cache-current-module! asm (from-sp (slot mod)) scope)) - (($ $primcall 'free-set! #f (closure idx value)) + (($ $primcall 'free-set! idx (closure value)) (emit-free-set! asm (from-sp (slot closure)) (from-sp (slot value)) - (constant idx))) + idx)) (($ $primcall 'box-set! #f (box value)) (emit-box-set! asm (from-sp (slot box)) (from-sp (slot value)))) (($ $primcall 'struct-set! #f (struct index value)) diff --git a/module/language/cps/effects-analysis.scm b/module/language/cps/effects-analysis.scm index 266ef5a4e..fc5d198c0 100644 --- a/module/language/cps/effects-analysis.scm +++ b/module/language/cps/effects-analysis.scm @@ -244,18 +244,18 @@ is or might be a read or a write to the same location as A." (define *primitive-effects* (make-hash-table)) -(define-syntax-rule (define-primitive-effects* constants +(define-syntax-rule (define-primitive-effects* param ((name . args) effects ...) ...) (begin (hashq-set! *primitive-effects* 'name (case-lambda* - ((constants . args) (logior effects ...)) + ((param . args) (logior effects ...)) (_ &all-effects))) ...)) (define-syntax-rule (define-primitive-effects ((name . args) effects ...) ...) - (define-primitive-effects* constants ((name . args) effects ...) ...)) + (define-primitive-effects* param ((name . args) effects ...) ...)) ;; Miscellaneous. (define-primitive-effects @@ -415,15 +415,9 @@ is or might be a read or a write to the same location as A." ((bv-f64-set! bv n x) (&write-object &bytevector) &type-check)) ;; Closures. -(define (closure-field n constants) - (indexed-field &closure n constants)) -(define (read-closure-field n constants) - (logior &read (closure-field n constants))) -(define (write-closure-field n constants) - (logior &write (closure-field n constants))) -(define-primitive-effects* constants - ((free-ref closure idx) (read-closure-field idx constants)) - ((free-set! closure idx val) (write-closure-field idx constants))) +(define-primitive-effects* param + ((free-ref closure) (&read-field &closure param)) + ((free-set! closure val) (&write-field &closure param))) ;; Modules. (define-primitive-effects @@ -515,10 +509,10 @@ is or might be a read or a write to the same location as A." ;; so no need to have a case for them here. (Though, see ;; https://jfbastien.github.io/no-sane-compiler/.) -(define (primitive-effects constants name args) +(define (primitive-effects name param args) (let ((proc (hashq-ref *primitive-effects* name))) (if proc - (apply proc constants args) + (apply proc param args) &all-effects))) (define (expression-effects exp constants) @@ -539,7 +533,9 @@ is or might be a read or a write to the same location as A." (($ $branch k exp) (expression-effects exp constants)) (($ $primcall name param args) - (primitive-effects constants name args)))) + ;; FIXME: hack to still support constants table while migrating + ;; to immediate parameters. + (primitive-effects (or param constants) name args)))) (define (compute-effects conts) (let ((constants (compute-constant-values conts))) diff --git a/module/language/cps/slot-allocation.scm b/module/language/cps/slot-allocation.scm index 624ddf7d3..6a51ccae3 100644 --- a/module/language/cps/slot-allocation.scm +++ b/module/language/cps/slot-allocation.scm @@ -335,10 +335,6 @@ the definitions that are live before and after LABEL, as intsets." empty-intset) ;; FIXME: Move all of these instructions to use $primcall ;; params. - (($ $primcall 'free-ref #f (closure slot)) - (defs+ closure)) - (($ $primcall 'free-set! #f (closure slot value)) - (defs+* (intset closure value))) (($ $primcall 'make-vector/immediate #f (len init)) (defs+ init)) (($ $primcall 'vector-ref/immediate #f (v i))