diff options
author | Andy Wingo <wingo@pobox.com> | 2017-11-03 09:28:27 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2017-11-05 15:00:16 +0100 |
commit | 5457f28af9c4cea934f61b0e11e2ebdd7e2ce718 (patch) | |
tree | e1ea4759a922adec0cb4cfccc1b91a53665816db | |
parent | ecff426b8934e882e7e45ee8bfbf94e9d92120dc (diff) | |
download | guile-5457f28af9c4cea934f61b0e11e2ebdd7e2ce718.tar.gz |
Specialize primcalls more aggressively
* module/language/cps/specialize-primcalls.scm (specialize-primcalls):
Don't restrict /imm params to encodeable immediates; specialize any
imm. Rely on reify-primitives to undo the transformation if needed.
-rw-r--r-- | module/language/cps/specialize-primcalls.scm | 41 |
1 files changed, 20 insertions, 21 deletions
diff --git a/module/language/cps/specialize-primcalls.scm b/module/language/cps/specialize-primcalls.scm index 1bde78a4e..6e92365c9 100644 --- a/module/language/cps/specialize-primcalls.scm +++ b/module/language/cps/specialize-primcalls.scm @@ -33,15 +33,14 @@ (define (specialize-primcalls conts) (let ((constants (compute-constant-values conts))) - (define (u6? var) + (define (uint? var) (let ((val (intmap-ref constants var (lambda (_) #f)))) - (and (exact-integer? val) (<= 0 val 63)))) - (define (u8? var) - (let ((val (intmap-ref constants var (lambda (_) #f)))) - (and (exact-integer? val) (<= 0 val 255)))) + (and (exact-integer? val) (<= 0 val)))) (define (u64? var) (let ((val (intmap-ref constants var (lambda (_) #f)))) (and (exact-integer? val) (<= 0 val #xffffFFFFffffFFFF)))) + (define (num? var) + (number? (intmap-ref constants var (lambda (_) #f)))) (define (s64? var) (let ((val (intmap-ref constants var (lambda (_) #f)))) (and (exact-integer? val) @@ -60,22 +59,22 @@ ... (_ #f))) (specialize-case - (('make-vector (? u8? n) init) (make-vector/immediate n (init))) - (('vector-ref v (? u8? n)) (vector-ref/immediate n (v))) - (('vector-set! v (? u8? n) x) (vector-set!/immediate n (v x))) - (('allocate-struct v (? u8? n)) (allocate-struct/immediate n (v))) - (('struct-ref s (? u8? n)) (struct-ref/immediate n (s))) - (('struct-set! s (? u8? n) x) (struct-set!/immediate n (s x))) - (('add x (? u8? y)) (add/immediate y (x))) - (('add (? u8? y) x) (add/immediate y (x))) - (('sub x (? u8? y)) (sub/immediate y (x))) - (('uadd x (? u8? y)) (uadd/immediate y (x))) - (('uadd (? u8? y) x) (uadd/immediate y (x))) - (('usub x (? u8? y)) (usub/immediate y (x))) - (('umul x (? u8? y)) (umul/immediate y (x))) - (('umul (? u8? y) x) (umul/immediate y (x))) - (('ursh x (? u6? y)) (ursh/immediate y (x))) - (('ulsh x (? u6? y)) (ulsh/immediate y (x))) + (('make-vector (? uint? n) init) (make-vector/immediate n (init))) + (('vector-ref v (? uint? n)) (vector-ref/immediate n (v))) + (('vector-set! v (? uint? n) x) (vector-set!/immediate n (v x))) + (('allocate-struct v (? uint? n)) (allocate-struct/immediate n (v))) + (('struct-ref s (? uint? n)) (struct-ref/immediate n (s))) + (('struct-set! s (? uint? n) x) (struct-set!/immediate n (s x))) + (('add x (? num? y)) (add/immediate y (x))) + (('add (? num? y) x) (add/immediate y (x))) + (('sub x (? num? y)) (sub/immediate y (x))) + (('uadd x (? uint? y)) (uadd/immediate y (x))) + (('uadd (? uint? y) x) (uadd/immediate y (x))) + (('usub x (? uint? y)) (usub/immediate y (x))) + (('umul x (? uint? y)) (umul/immediate y (x))) + (('umul (? uint? y) x) (umul/immediate y (x))) + (('ursh x (? uint? y)) (ursh/immediate y (x))) + (('ulsh x (? uint? y)) (ulsh/immediate y (x))) (('scm->f64 (? f64? var)) (load-f64 var ())) (('scm->u64 (? u64? var)) (load-u64 var ())) (('scm->u64/truncate (? u64? var)) (load-u64 var ())) |