-
-;; If we can prove that we have a right shift, just do the right shift
-;; instead of calling the inline ASH which has to check for the
-;; direction of the shift at run-time.
-(deftransform ash ((num shift) (integer integer))
- (let ((num-type (continuation-type num))
- (shift-type (continuation-type shift)))
- ;; Can only handle right shifts
- (unless (csubtypep shift-type (specifier-type '(integer * 0)))
- (give-up-ir1-transform))
-
- ;; If we can prove the shift is so large that all bits are shifted
- ;; out, return the appropriate constant. If the shift is small
- ;; enough, call the VOP. Otherwise, check for the shift size and
- ;; do the appropriate thing. (Hmm, could we just leave the IF
- ;; s-expr and depend on other parts of the compiler to delete the
- ;; unreachable parts, if any?)
- (cond ((csubtypep num-type (specifier-type '(signed-byte #.sb!vm:n-word-bits)))
- ;; A right shift by 31 is the same as a right shift by
- ;; larger amount. We get just the sign.
- (if (csubtypep shift-type (specifier-type '(integer #.(- 1 sb!vm:n-word-bits) 0)))
- ;; FIXME: ash-right-{un,}signed package problems
- `(sb!vm::ash-right-signed num (- shift))
- `(sb!vm::ash-right-signed num (min (- shift) #.(1- sb!vm:n-word-bits)))))
- ((csubtypep num-type (specifier-type '(unsigned-byte #.sb!vm:n-word-bits)))
- (if (csubtypep shift-type (specifier-type '(integer #.(- 1 sb!vm:n-word-bits) 0)))
- `(sb!vm::ash-right-unsigned num (- shift))
- `(if (<= shift #.(- sb!vm:n-word-bits))
- 0
- (sb!vm::ash-right-unsigned num (- shift)))))
- (t
- (give-up-ir1-transform)))))
-