(define-binop logior 2 or)
(define-binop logxor 2 xor))
-
;;; Special handling of add on the x86; can use lea to avoid a
;;; register load, otherwise it uses add.
(define-vop (fast-+/fixnum=>fixnum fast-safe-arith-op)
(inst lea result (make-ea :dword :index number :scale 8)))
(t
(move result number)
- (cond ((plusp amount) (inst shl result amount))
- ((< amount -31) (inst xor result result))
- (t (inst shr result (- amount))))))))
-
-(define-vop (fast-ash-left/signed)
+ (cond ((< -32 amount 32)
+ ;; this code is used both in ASH and ASH-MOD32, so
+ ;; be careful
+ (if (plusp amount)
+ (inst shl result amount)
+ (inst shr result (- amount))))
+ (t (inst xor result result)))))))
+
+(define-vop (fast-ash-left/signed=>signed)
(:translate ash)
(:args (number :scs (signed-reg) :target result
:load-if (not (and (sc-is number signed-stack)
(move ecx amount)
(inst shl result :cl)))
-(define-vop (fast-ash-left/unsigned)
+(define-vop (fast-ash-left/unsigned=>unsigned)
(:translate ash)
(:args (number :scs (unsigned-reg) :target result
:load-if (not (and (sc-is number unsigned-stack)
(:translate +-mod32))
(define-vop (fast-+-mod32-c/unsigned=>unsigned fast-+-c/unsigned=>unsigned)
(:translate +-mod32))
+(define-modular-fun --mod32 (x y) - 32)
+(define-vop (fast---mod32/unsigned=>unsigned fast--/unsigned=>unsigned)
+ (:translate --mod32))
+(define-vop (fast---mod32-c/unsigned=>unsigned fast---c/unsigned=>unsigned)
+ (:translate --mod32))
+
+(define-vop (fast-ash-left-mod32-c/unsigned=>unsigned
+ fast-ash-c/unsigned=>unsigned)
+ (:translate ash-left-mod32))
;;; logical operations
(define-modular-fun lognot-mod32 (x) lognot 32)
(define-vop (fast-logxor-mod32-c/unsigned=>unsigned
fast-logxor-c/unsigned=>unsigned)
(:translate logxor-mod32))
+
+(define-source-transform logeqv (&rest args)
+ (if (oddp (length args))
+ `(logxor ,@args)
+ `(lognot (logxor ,@args))))
+(define-source-transform logandc1 (x y)
+ `(logand (lognot ,x) ,y))
+(define-source-transform logandc2 (x y)
+ `(logand ,x (lognot ,y)))
+(define-source-transform logorc1 (x y)
+ `(logior (lognot ,x) ,y))
+(define-source-transform logorc2 (x y)
+ `(logior ,x (lognot ,y)))
+(define-source-transform lognor (x y)
+ `(lognot (logior ,x ,y)))
+(define-source-transform lognand (x y)
+ `(lognot (logand ,x ,y)))
\f
;;;; bignum stuff
(0
(let ((tmp (min 3 (aref condensed 1))))
(decf (aref condensed 1) tmp)
- `(truly-the (unsigned-byte 32)
+ `(logand #xffffffff
(%lea ,arg
,(decompose-multiplication
arg (ash (1- num) (- tmp)) (1- n-bits) (subseq condensed 1))
((1 2 3)
(let ((r0 (aref condensed 0)))
(incf (aref condensed 1) r0)
- `(truly-the (unsigned-byte 32)
+ `(logand #xffffffff
(%lea ,(decompose-multiplication
arg (- num (ash 1 r0)) (1- n-bits) (subseq condensed 1))
,arg
,(ash 1 r0) 0))))
(t (let ((r0 (aref condensed 0)))
(setf (aref condensed 0) 0)
- `(truly-the (unsigned-byte 32)
+ `(logand #xffffffff
(ash ,(decompose-multiplication
arg (ash num (- r0)) n-bits condensed)
,r0))))))
((= n-bits 0) 0)
((= num 1) arg)
((= n-bits 1)
- `(truly-the (unsigned-byte 32) (ash ,arg ,(1- (integer-length num)))))
+ `(logand #xffffffff (ash ,arg ,(1- (integer-length num)))))
((let ((max 0) (end 0))
(loop for i from 2 to (length condensed)
for j = (reduce #'+ (subseq condensed 0 i))
(let ((n2 (+ (ash 1 (1+ j))
(ash (ldb (byte (- 32 (1+ j)) (1+ j)) num) (1+ j))))
(n1 (1+ (ldb (byte (1+ j) 0) (lognot num)))))
- `(truly-the (unsigned-byte 32)
+ `(logand #xffffffff
(- ,(optimize-multiply arg n2) ,(optimize-multiply arg n1))))))))
((dolist (i '(9 5 3))
(when (integerp (/ num i))
(when (< (logcount (/ num i)) (logcount num))
(let ((x (gensym)))
(return `(let ((,x ,(optimize-multiply arg (/ num i))))
- (truly-the (unsigned-byte 32)
+ (logand #xffffffff
(%lea ,x ,x (1- ,i) 0)))))))))
(t (basic-decompose-multiplication arg num n-bits condensed))))