X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Farith.lisp;h=33cf26a407a1a28b2d29dfcaadd8689f89d97daf;hb=c3699db2053ff3b5ac6a98d4431c3789496002d8;hp=2da36e3eeeeb3ab80e1b5a734e240fdde6027931;hpb=b61003dec6f5af2b03549439155676666186283e;p=sbcl.git diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp index 2da36e3..33cf26a 100644 --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -1,4 +1,4 @@ -;;;; the VM definition arithmetic VOPs for the x86 +;;;; the VM definition of arithmetic VOPs for the x86 ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. @@ -683,9 +683,15 @@ (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)))))))) + (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 (if (sc-is result unsigned-reg) + (inst xor result result) + (inst mov result 0)))))))) (define-vop (fast-ash-left/signed=>signed) (:translate ash) @@ -1148,11 +1154,9 @@ (define-vop (fast---mod32-c/unsigned=>unsigned fast---c/unsigned=>unsigned) (:translate --mod32)) -(defknown ash-left-constant-mod32 (integer (integer 0)) (unsigned-byte 32) - (foldable flushable movable)) -(define-vop (fast-ash-left-constant-mod32/unsigned=>unsigned - fast-ash-c/unsigned=>unsigned) - (:translate ash-left-constant-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) @@ -1201,21 +1205,21 @@ ;;;; bignum stuff (define-vop (bignum-length get-header-data) - (:translate sb!bignum::%bignum-length) + (:translate sb!bignum:%bignum-length) (:policy :fast-safe)) (define-vop (bignum-set-length set-header-data) - (:translate sb!bignum::%bignum-set-length) + (:translate sb!bignum:%bignum-set-length) (:policy :fast-safe)) (define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag - (unsigned-reg) unsigned-num sb!bignum::%bignum-ref) + (unsigned-reg) unsigned-num sb!bignum:%bignum-ref) (define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag - (unsigned-reg) unsigned-num sb!bignum::%bignum-set) + (unsigned-reg) unsigned-num sb!bignum:%bignum-set) (define-vop (digit-0-or-plus) - (:translate sb!bignum::%digit-0-or-plusp) + (:translate sb!bignum:%digit-0-or-plusp) (:policy :fast-safe) (:args (digit :scs (unsigned-reg))) (:arg-types unsigned-num) @@ -1231,7 +1235,7 @@ ;;; 4. This is easy to deal with and may save a fixnum-word ;;; conversion. (define-vop (add-w/carry) - (:translate sb!bignum::%add-with-carry) + (:translate sb!bignum:%add-with-carry) (:policy :fast-safe) (:args (a :scs (unsigned-reg) :target result) (b :scs (unsigned-reg unsigned-stack) :to :eval) @@ -1252,7 +1256,7 @@ ;;; Note: the borrow is the oppostite of the x86 convention - 1 for no ;;; borrow and 0 for a borrow. (define-vop (sub-w/borrow) - (:translate sb!bignum::%subtract-with-borrow) + (:translate sb!bignum:%subtract-with-borrow) (:policy :fast-safe) (:args (a :scs (unsigned-reg) :to :eval :target result) (b :scs (unsigned-reg unsigned-stack) :to :result) @@ -1271,7 +1275,7 @@ (define-vop (bignum-mult-and-add-3-arg) - (:translate sb!bignum::%multiply-and-add) + (:translate sb!bignum:%multiply-and-add) (:policy :fast-safe) (:args (x :scs (unsigned-reg) :target eax) (y :scs (unsigned-reg unsigned-stack)) @@ -1293,7 +1297,7 @@ (move lo eax))) (define-vop (bignum-mult-and-add-4-arg) - (:translate sb!bignum::%multiply-and-add) + (:translate sb!bignum:%multiply-and-add) (:policy :fast-safe) (:args (x :scs (unsigned-reg) :target eax) (y :scs (unsigned-reg unsigned-stack)) @@ -1319,7 +1323,7 @@ (define-vop (bignum-mult) - (:translate sb!bignum::%multiply) + (:translate sb!bignum:%multiply) (:policy :fast-safe) (:args (x :scs (unsigned-reg) :target eax) (y :scs (unsigned-reg unsigned-stack))) @@ -1338,10 +1342,10 @@ (move lo eax))) (define-vop (bignum-lognot lognot-mod32/unsigned=>unsigned) - (:translate sb!bignum::%lognot)) + (:translate sb!bignum:%lognot)) (define-vop (fixnum-to-digit) - (:translate sb!bignum::%fixnum-to-digit) + (:translate sb!bignum:%fixnum-to-digit) (:policy :fast-safe) (:args (fixnum :scs (any-reg control-stack) :target digit)) (:arg-types tagged-num) @@ -1355,7 +1359,7 @@ (inst sar digit 2))) (define-vop (bignum-floor) - (:translate sb!bignum::%floor) + (:translate sb!bignum:%floor) (:policy :fast-safe) (:args (div-high :scs (unsigned-reg) :target edx) (div-low :scs (unsigned-reg) :target eax) @@ -1376,7 +1380,7 @@ (move rem edx))) (define-vop (signify-digit) - (:translate sb!bignum::%fixnum-digit-with-correct-sign) + (:translate sb!bignum:%fixnum-digit-with-correct-sign) (:policy :fast-safe) (:args (digit :scs (unsigned-reg unsigned-stack) :target res)) (:arg-types unsigned-num) @@ -1391,7 +1395,7 @@ (inst shl res 2)))) (define-vop (digit-ashr) - (:translate sb!bignum::%ashr) + (:translate sb!bignum:%ashr) (:policy :fast-safe) (:args (digit :scs (unsigned-reg unsigned-stack) :target result) (count :scs (unsigned-reg) :target ecx)) @@ -1407,14 +1411,14 @@ (inst sar result :cl))) (define-vop (digit-lshr digit-ashr) - (:translate sb!bignum::%digit-logical-shift-right) + (:translate sb!bignum:%digit-logical-shift-right) (:generator 1 (move result digit) (move ecx count) (inst shr result :cl))) (define-vop (digit-ashl digit-ashr) - (:translate sb!bignum::%ashl) + (:translate sb!bignum:%ashl) (:generator 1 (move result digit) (move ecx count)