1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00

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.
This commit is contained in:
Andy Wingo 2017-11-15 19:54:10 +01:00
parent 0951551fb4
commit 8ce6f359bb
4 changed files with 13 additions and 14 deletions

View file

@ -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

View file

@ -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

View file

@ -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 ()))

View file

@ -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)