summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2017-11-03 09:28:27 +0100
committerAndy Wingo <wingo@pobox.com>2017-11-05 15:00:16 +0100
commit5457f28af9c4cea934f61b0e11e2ebdd7e2ce718 (patch)
treee1ea4759a922adec0cb4cfccc1b91a53665816db
parentecff426b8934e882e7e45ee8bfbf94e9d92120dc (diff)
downloadguile-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.scm41
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 ()))