From 8ce6f359bb6ca7fdb987840ea0c74237ecd0e5df Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Wed, 15 Nov 2017 19:54:10 +0100 Subject: [PATCH] ursh, ursh/immediate, etc only residualized if count < 64 * module/language/cps/reify-primitives.scm (reify-primitives): Remove cases for ursh/immediate etc, as these should all be within range, by construction. * module/language/cps/specialize-numbers.scm (specialize-operations): Only reify ursh/immediate, etc if the shift count is less than 64. * module/language/cps/specialize-primcalls.scm (specialize-primcalls): Remove specialization cases for ursh/immediate etc; this is the domain of specialize-numbers. * module/language/cps/types.scm (ursh, srsh, ulsh): Limit arguments to be less than 63. (ulsh/immediate): Assume parameter is in range. --- module/language/cps/reify-primitives.scm | 7 ++++--- module/language/cps/specialize-numbers.scm | 4 +++- module/language/cps/specialize-primcalls.scm | 3 --- module/language/cps/types.scm | 13 ++++++------- 4 files changed, 13 insertions(+), 14 deletions(-) diff --git a/module/language/cps/reify-primitives.scm b/module/language/cps/reify-primitives.scm index 680c1b771..bac85adf9 100644 --- a/module/language/cps/reify-primitives.scm +++ b/module/language/cps/reify-primitives.scm @@ -199,9 +199,10 @@ ((umul/immediate (u8? y) x) (umul x y)) ((rsh/immediate (u6? y) x) (rsh x y)) ((lsh/immediate (u6? y) x) (lsh x y)) - ((ursh/immediate (u6? y) x) (ursh x y)) - ((srsh/immediate (u6? y) x) (srsh x y)) - ((ulsh/immediate (u6? y) x) (ulsh x y)) + ;; These should all be u6's by construction. + ;; ((ursh/immediate (u6? y) x) (ursh x y)) + ;; ((srsh/immediate (u6? y) x) (srsh x y)) + ;; ((ulsh/immediate (u6? y) x) (ulsh x y)) (_ cps)))))) (param (error "unexpected param to reified primcall" name)) (else diff --git a/module/language/cps/specialize-numbers.scm b/module/language/cps/specialize-numbers.scm index 0e8ae931f..52ac70330 100644 --- a/module/language/cps/specialize-numbers.scm +++ b/module/language/cps/specialize-numbers.scm @@ -453,6 +453,8 @@ BITS indicating the significant bits needed for a variable. BITS may be (and (type<=? type &type) (<= &min min max &max))))) (define (u64-operand? var) (operand-in-range? var &exact-integer 0 (1- (ash 1 64)))) + (define (u6-operand? var) + (operand-in-range? var (logior &s64 &u64) 0 63)) (define (s64-operand? var) (operand-in-range? var &exact-integer (ash -1 63) (1- (ash 1 63)))) (define (fixnum-operand? var) @@ -608,7 +610,7 @@ BITS indicating the significant bits needed for a variable. BITS may be (setk label ($kargs names vars ,body)))) (((or 'lsh 'rsh) - (? u64-result?) #f (? u64-operand? a) b) + (? u64-result?) #f (? u64-operand? a) (? u6-operand? b)) (with-cps cps (let$ body (specialize-u64-shift k src op a b diff --git a/module/language/cps/specialize-primcalls.scm b/module/language/cps/specialize-primcalls.scm index eedc28ba4..a5ce739fd 100644 --- a/module/language/cps/specialize-primcalls.scm +++ b/module/language/cps/specialize-primcalls.scm @@ -73,9 +73,6 @@ (('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))) - (('srsh x (? uint? y)) (srsh/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 ())) diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm index f56ce0fae..3edd9ef61 100644 --- a/module/language/cps/types.scm +++ b/module/language/cps/types.scm @@ -1382,8 +1382,8 @@ minimum, and maximum." (define-type-inferrer (ursh a b result) (define! result &u64 - (ash (&min/0 a) (- (min 64 (&max/u64 b)))) - (ash (&max/u64 a) (- (min 64 (&min/0 b)))))) + (ash (&min/0 a) (- (min 63 (&max/u64 b)))) + (ash (&max/u64 a) (- (min 63 (&min/0 b)))))) (define-type-inferrer/param (ursh/immediate param a result) (define! result &u64 (ash (&min/0 a) (- param)) @@ -1392,8 +1392,8 @@ minimum, and maximum." (define-type-inferrer (srsh a b result) (let-values (((min max) (compute-ash-range (&min/s64 a) (&max/s64 a) - (- (&min/0 b)) - (- (&max/u64 b))))) + (- (min 63 (&min/0 b))) + (- (min 63 (&max/u64 b)))))) (if (<= &s64-min min max &s64-max) (define! result &s64 min max) (define! result &s64 &s64-min &s64-max)))) @@ -1406,8 +1406,7 @@ minimum, and maximum." (define! result &s64 &s64-min &s64-max)))) (define-type-inferrer (ulsh a b result) - (if (and (< (&max/u64 b) 64) - (<= (ash (&max/u64 a) (&max/u64 b)) &u64-max)) + (if (<= (ash (&max/u64 a) (&max/u64 b)) &u64-max) ;; No overflow; we can be precise. (define! result &u64 (ash (&min/0 a) (&min/0 b)) @@ -1415,7 +1414,7 @@ minimum, and maximum." ;; Otherwise assume the whole range. (define! result &u64 0 &u64-max))) (define-type-inferrer/param (ulsh/immediate param a result) - (if (and (< param 64) (<= (ash (&max/u64 a) param) &u64-max)) + (if (<= (ash (&max/u64 a) param) &u64-max) ;; No overflow; we can be precise. (define! result &u64 (ash (&min/0 a) param)