(move r x)
(inst add r y)))))
+
+;;;; Special logand cases: (logand signed unsigned) => unsigned
+
+(define-vop (fast-logand/signed-unsigned=>unsigned
+ fast-logand/unsigned=>unsigned)
+ (:args (x :target r :scs (signed-reg)
+ :load-if (not (and (sc-is x signed-stack)
+ (sc-is y unsigned-reg)
+ (sc-is r unsigned-stack)
+ (location= x r))))
+ (y :scs (unsigned-reg unsigned-stack)))
+ (:arg-types signed-num unsigned-num))
+
+(define-vop (fast-logand-c/signed-unsigned=>unsigned
+ fast-logand-c/unsigned=>unsigned)
+ (:args (x :target r :scs (signed-reg signed-stack)))
+ (:arg-types signed-num (:constant (unsigned-byte 32))))
+
+(define-vop (fast-logand/unsigned-signed=>unsigned
+ fast-logand/unsigned=>unsigned)
+ (:args (x :target r :scs (unsigned-reg)
+ :load-if (not (and (sc-is x unsigned-stack)
+ (sc-is y signed-reg)
+ (sc-is r unsigned-stack)
+ (location= x r))))
+ (y :scs (signed-reg signed-stack)))
+ (:arg-types unsigned-num signed-num))
+\f
+
(define-vop (fast-+-c/signed=>signed fast-safe-arith-op)
(:translate +)
(:args (x :target r :scs (signed-reg signed-stack)))
(inst and result #x0000ffff)
(inst and temp #x0000ffff)
(inst add result temp)))
-
-
\f
;;;; binary conditional VOPs
(macrolet ((define-conditional-vop (tran cond unsigned not-cond not-unsigned)
`(progn
,@(mapcar
- #'(lambda (suffix cost signed)
- `(define-vop (;; FIXME: These could be done more
- ;; cleanly with SYMBOLICATE.
- ,(intern (format nil "~:@(FAST-IF-~A~A~)"
- tran suffix))
- ,(intern
- (format nil "~:@(FAST-CONDITIONAL~A~)"
- suffix)))
- (:translate ,tran)
- (:generator ,cost
- (inst cmp x
- ,(if (eq suffix '-c/fixnum)
- '(fixnumize y)
- 'y))
- (inst jmp (if not-p
- ,(if signed
- not-cond
- not-unsigned)
- ,(if signed
- cond
- unsigned))
- target))))
+ (lambda (suffix cost signed)
+ `(define-vop (;; FIXME: These could be done more
+ ;; cleanly with SYMBOLICATE.
+ ,(intern (format nil "~:@(FAST-IF-~A~A~)"
+ tran suffix))
+ ,(intern
+ (format nil "~:@(FAST-CONDITIONAL~A~)"
+ suffix)))
+ (:translate ,tran)
+ (:generator ,cost
+ (inst cmp x
+ ,(if (eq suffix '-c/fixnum)
+ '(fixnumize y)
+ 'y))
+ (inst jmp (if not-p
+ ,(if signed
+ not-cond
+ not-unsigned)
+ ,(if signed
+ cond
+ unsigned))
+ target))))
'(/fixnum -c/fixnum /signed -c/signed /unsigned -c/unsigned)
'(4 3 6 5 6 5)
'(t t t t nil nil)))))
(move r x)
(inst and r y)))
-(def-source-transform 32bit-logical-nand (x y)
+(define-source-transform 32bit-logical-nand (x y)
`(32bit-logical-not (32bit-logical-and ,x ,y)))
(define-vop (32bit-logical-or 32bit-logical)
(move r x)
(inst or r y)))
-(def-source-transform 32bit-logical-nor (x y)
+(define-source-transform 32bit-logical-nor (x y)
`(32bit-logical-not (32bit-logical-or ,x ,y)))
(define-vop (32bit-logical-xor 32bit-logical)
(move r x)
(inst xor r y)))
-(def-source-transform 32bit-logical-eqv (x y)
+(define-source-transform 32bit-logical-eqv (x y)
`(32bit-logical-not (32bit-logical-xor ,x ,y)))
-(def-source-transform 32bit-logical-orc1 (x y)
+(define-source-transform 32bit-logical-orc1 (x y)
`(32bit-logical-or (32bit-logical-not ,x) ,y))
-(def-source-transform 32bit-logical-orc2 (x y)
+(define-source-transform 32bit-logical-orc2 (x y)
`(32bit-logical-or ,x (32bit-logical-not ,y)))
-(def-source-transform 32bit-logical-andc1 (x y)
+(define-source-transform 32bit-logical-andc1 (x y)
`(32bit-logical-and (32bit-logical-not ,x) ,y))
-(def-source-transform 32bit-logical-andc2 (x y)
+(define-source-transform 32bit-logical-andc2 (x y)
`(32bit-logical-and ,x (32bit-logical-not ,y)))
;;; Only the lower 5 bits of the shift amount are significant.
(:translate sb!bignum::%bignum-set-length)
(:policy :fast-safe))
-(define-full-reffer bignum-ref * bignum-digits-offset other-pointer-type
+(define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag
(unsigned-reg) unsigned-num sb!bignum::%bignum-ref)
-(define-full-setter bignum-set * bignum-digits-offset other-pointer-type
+(define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag
(unsigned-reg) unsigned-num sb!bignum::%bignum-set)
(define-vop (digit-0-or-plus)
\f
;;;; static functions
-(define-static-function two-arg-/ (x y) :translate /)
+(define-static-fun two-arg-/ (x y) :translate /)
-(define-static-function two-arg-gcd (x y) :translate gcd)
-(define-static-function two-arg-lcm (x y) :translate lcm)
+(define-static-fun two-arg-gcd (x y) :translate gcd)
+(define-static-fun two-arg-lcm (x y) :translate lcm)
-(define-static-function two-arg-and (x y) :translate logand)
-(define-static-function two-arg-ior (x y) :translate logior)
-(define-static-function two-arg-xor (x y) :translate logxor)
+(define-static-fun two-arg-and (x y) :translate logand)
+(define-static-fun two-arg-ior (x y) :translate logior)
+(define-static-fun two-arg-xor (x y) :translate logxor)
\f
;;; Support for the Mersenne Twister, MT19937, random number generator
(:result-types unsigned-num)
(:generator 50
(inst mov k (make-ea :dword :base state
- :disp (- (* (+ 2 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
+ :disp (- (* (+ 2 vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag)))
(inst cmp k 624)
(inst jmp :ne no-update)
(inst mov tmp state) ; The state is passed in EAX.
NO-UPDATE
;; y = ptgfsr[k++];
(inst mov y (make-ea :dword :base state :index k :scale 4
- :disp (- (* (+ 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
+ :disp (- (* (+ 3 vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag)))
;; y ^= (y >> 11);
(inst shr y 11)
(inst xor y (make-ea :dword :base state :index k :scale 4
- :disp (- (* (+ 3 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-type)))
+ :disp (- (* (+ 3 vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag)))
;; y ^= (y << 7) & #x9d2c5680
(inst mov tmp y)
(inst inc k)
(inst shl tmp 7)
(inst mov (make-ea :dword :base state
- :disp (- (* (+ 2 sb!vm:vector-data-offset)
- sb!vm:word-bytes)
- sb!vm:other-pointer-type))
+ :disp (- (* (+ 2 vector-data-offset)
+ n-word-bytes)
+ other-pointer-lowtag))
k)
(inst and tmp #x9d2c5680)
(inst xor y tmp)
projects / sbcl.git / blobdiff