X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fmips%2Farith.lisp;h=9188d9836fc0fb34811bb08d63c8fd515afde900;hb=1d46d379bb7a6424524b978f213ef69be5f1ad69;hp=bc45854eadd8d2f512a9676a49d7eb79a8223941;hpb=806d9ee2d5834c88c558f0ea422879895e9f2e5e;p=sbcl.git diff --git a/src/compiler/mips/arith.lisp b/src/compiler/mips/arith.lisp index bc45854..9188d98 100644 --- a/src/compiler/mips/arith.lisp +++ b/src/compiler/mips/arith.lisp @@ -1,6 +1,15 @@ -(in-package "SB!VM") +;;;; the VM definition arithmetic VOPs for MIPS +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. +(in-package "SB!VM") ;;;; Unary operations. @@ -265,15 +274,11 @@ (:results (result :scs (unsigned-reg))) (:result-types unsigned-num) (:generator 1 - (cond ((< count 0) - ;; It is a right shift. - (inst srl result number (min (- count) 31))) - ((> count 0) - ;; It is a left shift. - (inst sll result number (min count 31))) - (t - ;; Count=0? Shouldn't happen, but it's easy: - (move result number))))) + (cond + ((< count -31) (move result zero-tn)) + ((< count 0) (inst srl result number (min (- count) 31))) + ((> count 0) (inst sll result number (min count 31))) + (t (bug "identity ASH not transformed away"))))) (define-vop (fast-ash-c/signed=>signed) (:policy :fast-safe) @@ -285,15 +290,10 @@ (:results (result :scs (signed-reg))) (:result-types signed-num) (:generator 1 - (cond ((< count 0) - ;; It is a right shift. - (inst sra result number (min (- count) 31))) - ((> count 0) - ;; It is a left shift. - (inst sll result number (min count 31))) - (t - ;; Count=0? Shouldn't happen, but it's easy: - (move result number))))) + (cond + ((< count 0) (inst sra result number (min (- count) 31))) + ((> count 0) (inst sll result number (min count 31))) + (t (bug "identity ASH not transformed away"))))) (define-vop (signed-byte-32-len) (:translate integer-length) @@ -684,6 +684,15 @@ (: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) @@ -727,21 +736,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) @@ -754,7 +763,7 @@ (inst nop))) (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)) (b :scs (unsigned-reg)) @@ -784,7 +793,7 @@ (move result res)))) (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)) (b :scs (unsigned-reg)) @@ -813,7 +822,7 @@ (move result res)))) (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)) (y :scs (unsigned-reg)) @@ -832,7 +841,7 @@ (inst addu hi temp))) (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)) (y :scs (unsigned-reg)) @@ -855,7 +864,7 @@ (inst addu hi temp))) (define-vop (bignum-mult) - (:translate sb!bignum::%multiply) + (:translate sb!bignum:%multiply) (:policy :fast-safe) (:args (x :scs (unsigned-reg)) (y :scs (unsigned-reg))) @@ -869,10 +878,10 @@ (inst mfhi hi))) (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))) (:arg-types tagged-num) @@ -882,7 +891,7 @@ (inst sra digit fixnum 2))) (define-vop (bignum-floor) - (:translate sb!bignum::%floor) + (:translate sb!bignum:%floor) (:policy :fast-safe) (:args (num-high :scs (unsigned-reg) :target rem) (num-low :scs (unsigned-reg) :target rem-low) @@ -914,7 +923,7 @@ (inst nor quo zero-tn))) (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) :target res)) (:arg-types unsigned-num) @@ -929,7 +938,7 @@ (define-vop (digit-ashr) - (:translate sb!bignum::%ashr) + (:translate sb!bignum:%ashr) (:policy :fast-safe) (:args (digit :scs (unsigned-reg)) (count :scs (unsigned-reg))) @@ -940,12 +949,12 @@ (inst sra result digit count))) (define-vop (digit-lshr digit-ashr) - (:translate sb!bignum::%digit-logical-shift-right) + (:translate sb!bignum:%digit-logical-shift-right) (:generator 1 (inst srl result digit count))) (define-vop (digit-ashl digit-ashr) - (:translate sb!bignum::%ashl) + (:translate sb!bignum:%ashl) (:generator 1 (inst sll result digit count)))