X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fhppa%2Farith.lisp;h=78b3f536d8844f72fc31d69608be6c0476f0c15a;hb=095564c28a259002c7e34fd1d861f5bbd0a959b6;hp=d47fc7695a9e3e86cc056b356e1f835680f4800b;hpb=dd357f3be290498fb7ef172696d986337f517a93;p=sbcl.git diff --git a/src/compiler/hppa/arith.lisp b/src/compiler/hppa/arith.lisp index d47fc76..78b3f53 100644 --- a/src/compiler/hppa/arith.lisp +++ b/src/compiler/hppa/arith.lisp @@ -295,6 +295,9 @@ ;; Count=0? Shouldn't happen, but it's easy: (move number result))))) +;;; FIXME: implement FAST-ASH-LEFT/UNSIGNED=>UNSIGNED and friends, for +;;; use in modular ASH (and because they're useful anyway). -- CSR, +;;; 2004-08-16 (define-vop (signed-byte-32-len) (:translate integer-length) @@ -582,6 +585,24 @@ (: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)) +(define-vop (fast-ash-left-mod32/unsigned=>unsigned + ;; FIXME: when FAST-ASH-LEFT/UNSIGNED=>UNSIGNED is + ;; implemented, use it here. -- CSR, 2004-08-16 + fast-ash/unsigned=>unsigned)) +(deftransform ash-left-mod32 ((integer count) + ((unsigned-byte 32) (unsigned-byte 5))) + (when (sb!c::constant-lvar-p count) + (sb!c::give-up-ir1-transform)) + '(%primitive fast-ash-left-mod32/unsigned=>unsigned integer count)) (define-modular-fun lognot-mod32 (x) lognot 32) (define-vop (lognot-mod32/unsigned=>unsigned) @@ -622,42 +643,6 @@ (define-source-transform lognor (x y) `(lognot (logior ,x y))) -;;;; 32-bit logical operations - -(define-source-transform 32bit-logical-not (x) - `(logand (lognot (the (unsigned-byte 32) ,x)) #.(1- (ash 1 32)))) - -(deftransform 32bit-logical-and ((x y)) - '(logand x y)) - -(define-source-transform 32bit-logical-nand (x y) - `(32bit-logical-not (32bit-logical-and ,x ,y))) - -(deftransform 32bit-logical-or ((x y)) - '(logior x y)) - -(define-source-transform 32bit-logical-nor (x y) - `(logand (lognor (the (unsigned-byte 32) ,x) (the (unsigned-byte 32) ,y)) - #.(1- (ash 1 32)))) - -(deftransform 32bit-logical-xor ((x y)) - '(logxor x y)) - -(define-source-transform 32bit-logical-eqv (x y) - `(32bit-logical-not (32bit-logical-xor ,x ,y))) - -(define-source-transform 32bit-logical-orc1 (x y) - `(32bit-logical-or (32bit-logical-not ,x) ,y)) - -(define-source-transform 32bit-logical-orc2 (x y) - `(32bit-logical-or ,x (32bit-logical-not ,y))) - -(deftransform 32bit-logical-andc1 (x y) - '(logandc1 x y)) - -(deftransform 32bit-logical-andc2 (x y) - '(logandc2 x y)) - (define-vop (shift-towards-someplace) (:policy :fast-safe) (:args (num :scs (unsigned-reg)) @@ -687,21 +672,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) @@ -713,7 +698,7 @@ (inst bc :>= not-p digit zero-tn target))) (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)) @@ -728,7 +713,7 @@ (inst addc zero-tn zero-tn carry))) (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)) @@ -743,7 +728,7 @@ (inst addc zero-tn zero-tn borrow))) (define-vop (bignum-mult) - (:translate sb!bignum::%multiply) + (:translate sb!bignum:%multiply) (:policy :fast-safe) (:args (x-arg :scs (unsigned-reg) :target x) (y-arg :scs (unsigned-reg) :target y)) @@ -782,11 +767,11 @@ (define-source-transform sb!bignum:%multiply-and-add (x y carry &optional (extra 0)) #+nil ;; This would be greate if it worked, but it doesn't. (if (eql extra 0) - `(multiple-value-call #'sb!bignum::%dual-word-add + `(multiple-value-call #'sb!bignum:%dual-word-add (sb!bignum:%multiply ,x ,y) (values ,carry)) - `(multiple-value-call #'sb!bignum::%dual-word-add - (multiple-value-call #'sb!bignum::%dual-word-add + `(multiple-value-call #'sb!bignum:%dual-word-add + (multiple-value-call #'sb!bignum:%dual-word-add (sb!bignum:%multiply ,x ,y) (values ,carry)) (values ,extra))) @@ -822,7 +807,7 @@ (inst addc hi zero-tn hi-res))) (define-vop (bignum-lognot) - (:translate sb!bignum::%lognot) + (:translate sb!bignum:%lognot) (:policy :fast-safe) (:args (x :scs (unsigned-reg))) (:arg-types unsigned-num) @@ -832,7 +817,7 @@ (inst uaddcm zero-tn x r))) (define-vop (fixnum-to-digit) - (:translate sb!bignum::%fixnum-to-digit) + (:translate sb!bignum:%fixnum-to-digit) (:policy :fast-safe) (:args (fixnum :scs (signed-reg))) (:arg-types tagged-num) @@ -842,7 +827,7 @@ (move fixnum digit))) (define-vop (bignum-floor) - (:translate sb!bignum::%floor) + (:translate sb!bignum:%floor) (:policy :fast-safe) (:args (hi :scs (unsigned-reg) :to (:argument 1)) (lo :scs (unsigned-reg) :to (:argument 0)) @@ -865,7 +850,7 @@ (inst add divisor rem rem))) (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) @@ -875,7 +860,7 @@ (move digit res))) (define-vop (digit-lshr) - (:translate sb!bignum::%digit-logical-shift-right) + (:translate sb!bignum:%digit-logical-shift-right) (:policy :fast-safe) (:args (digit :scs (unsigned-reg)) (count :scs (unsigned-reg))) @@ -887,7 +872,7 @@ (inst shd zero-tn digit :variable result))) (define-vop (digit-ashr digit-lshr) - (:translate sb!bignum::%ashr) + (:translate sb!bignum:%ashr) (:temporary (:scs (unsigned-reg) :to (:result 0)) temp) (:generator 1 (inst extrs digit 0 1 temp) @@ -895,7 +880,7 @@ (inst shd temp digit :variable result))) (define-vop (digit-ashl digit-ashr) - (:translate sb!bignum::%ashl) + (:translate sb!bignum:%ashl) (:generator 1 (inst subi 31 count temp) (inst mtctl temp :sar)