- (frob fast-ash-left/signed=>signed signed-reg signed-num signed-reg 3)
- (frob fast-ash-left/fixnum=>fixnum any-reg tagged-num any-reg 2)
- (frob fast-ash-left/unsigned=>unsigned unsigned-reg unsigned-num unsigned-reg 3))
-
-(defknown ash-right-signed ((signed-byte #.sb!vm:n-word-bits)
- (and fixnum unsigned-byte))
- (signed-byte #.sb!vm:n-word-bits)
- (movable foldable flushable))
-
-(defknown ash-right-unsigned ((unsigned-byte #.sb!vm:n-word-bits)
- (and fixnum unsigned-byte))
- (unsigned-byte #.sb!vm:n-word-bits)
- (movable foldable flushable))
-
-;; Some special cases where we want a right shift. Just do the shift.
-;; (Needs appropriate deftransforms to call these, though.)
-
-(macrolet
- ((frob (trans name sc-type type shift-inst cost)
- `(define-vop (,name)
- (:note "inline right ASH")
- (:translate ,trans)
- (:args (number :scs (,sc-type))
- (amount :scs (signed-reg unsigned-reg immediate)))
- (:arg-types ,type positive-fixnum)
- (:results (result :scs (,sc-type)))
- (:result-types ,type)
- (:policy :fast-safe)
- (:generator ,cost
- (sc-case amount
- ((signed-reg unsigned-reg)
- (inst ,shift-inst result number amount))
- (immediate
- (let ((amt (tn-value amount)))
- (inst ,shift-inst result number amt))))))))
- (frob ash-right-signed fast-ash-right/signed=>signed
- signed-reg signed-num sra 3)
- (frob ash-right-unsigned fast-ash-right/unsigned=>unsigned
- unsigned-reg unsigned-num srl 3))
-
-(define-vop (fast-ash-right/fixnum=>fixnum)
- (:note "inline right ASH")
- (:translate ash-right-signed)
- (:args (number :scs (any-reg))
- (amount :scs (signed-reg unsigned-reg immediate)))
- (:arg-types tagged-num positive-fixnum)
- (:results (result :scs (any-reg)))
- (:result-types tagged-num)
- (:temporary (:sc non-descriptor-reg :target result) temp)
- (:policy :fast-safe)
- (:generator 2
- ;; Shift the fixnum right by the desired amount. Then zap out the
- ;; 2 LSBs to make it a fixnum again. (Those bits are junk.)
- (sc-case amount
- ((signed-reg unsigned-reg)
- (inst sra temp number amount))
- (immediate
- (inst sra temp number (tn-value amount))))
- (inst andn result temp fixnum-tag-mask)))
-
-