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:
parent
0951551fb4
commit
8ce6f359bb
4 changed files with 13 additions and 14 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ()))
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue