X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fhppa%2Farith.lisp;h=8d9ae1955a5d710319c9162ff0a70b440550b891;hb=6822034325136cde4e14773c83c3769b42721306;hp=c09800b067cbdc4ae0ce29c9453fe75ec9befdf5;hpb=b61003dec6f5af2b03549439155676666186283e;p=sbcl.git diff --git a/src/compiler/hppa/arith.lisp b/src/compiler/hppa/arith.lisp index c09800b..8d9ae19 100644 --- a/src/compiler/hppa/arith.lisp +++ b/src/compiler/hppa/arith.lisp @@ -41,15 +41,15 @@ (define-vop (fast-lognot/fixnum fixnum-unop) (:temporary (:scs (any-reg) :type fixnum :to (:result 0)) - temp) + temp) (:translate lognot) - (:generator 2 + (:generator 1 (inst li (fixnumize -1) temp) (inst xor x temp res))) (define-vop (fast-lognot/signed signed-unop) (:translate lognot) - (:generator 1 + (:generator 2 (inst uaddcm zero-tn x res))) ;;;; Binary fixnum operations. @@ -58,7 +58,7 @@ (define-vop (fast-fixnum-binop) (:args (x :target r :scs (any-reg)) - (y :target r :scs (any-reg))) + (y :target r :scs (any-reg))) (:arg-types tagged-num tagged-num) (:results (r :scs (any-reg))) (:result-types tagged-num) @@ -69,7 +69,7 @@ (define-vop (fast-unsigned-binop) (:args (x :target r :scs (unsigned-reg)) - (y :target r :scs (unsigned-reg))) + (y :target r :scs (unsigned-reg))) (:arg-types unsigned-num unsigned-num) (:results (r :scs (unsigned-reg))) (:result-types unsigned-num) @@ -80,7 +80,7 @@ (define-vop (fast-signed-binop) (:args (x :target r :scs (signed-reg)) - (y :target r :scs (signed-reg))) + (y :target r :scs (signed-reg))) (:arg-types signed-num signed-num) (:results (r :scs (signed-reg))) (:result-types signed-num) @@ -92,32 +92,32 @@ (defmacro define-binop (translate cost untagged-cost op &optional arg-swap) `(progn (define-vop (,(symbolicate "FAST-" translate "/FIXNUM=>FIXNUM") - fast-fixnum-binop) + fast-fixnum-binop) (:args (x :target r :scs (any-reg)) - (y :target r :scs (any-reg))) + (y :target r :scs (any-reg))) (:translate ,translate) (:generator ,cost - ,(if arg-swap - `(inst ,op y x r) - `(inst ,op x y r)))) + ,(if arg-swap + `(inst ,op y x r) + `(inst ,op x y r)))) (define-vop (,(symbolicate "FAST-" translate "/SIGNED=>SIGNED") - fast-signed-binop) + fast-signed-binop) (:args (x :target r :scs (signed-reg)) - (y :target r :scs (signed-reg))) + (y :target r :scs (signed-reg))) (:translate ,translate) (:generator ,untagged-cost - ,(if arg-swap - `(inst ,op y x r) - `(inst ,op x y r)))) + ,(if arg-swap + `(inst ,op y x r) + `(inst ,op x y r)))) (define-vop (,(symbolicate "FAST-" translate "/UNSIGNED=>UNSIGNED") - fast-unsigned-binop) + fast-unsigned-binop) (:args (x :target r :scs (unsigned-reg)) - (y :target r :scs (unsigned-reg))) + (y :target r :scs (unsigned-reg))) (:translate ,translate) (:generator ,untagged-cost - ,(if arg-swap - `(inst ,op y x r) - `(inst ,op x y r)))))) + ,(if arg-swap + `(inst ,op y x r) + `(inst ,op x y r)))))) (define-binop + 2 6 add) (define-binop - 2 6 sub) @@ -143,27 +143,27 @@ (:arg-types tagged-num (:constant integer))) (defmacro define-c-binop (translate cost untagged-cost tagged-type - untagged-type inst) + untagged-type inst) `(progn (define-vop (,(symbolicate "FAST-" translate "-C/FIXNUM=>FIXNUM") - fast-fixnum-c-binop) + fast-fixnum-c-binop) (:arg-types tagged-num (:constant ,tagged-type)) (:translate ,translate) (:generator ,cost - (let ((y (fixnumize y))) - ,inst))) + (let ((y (fixnumize y))) + ,inst))) (define-vop (,(symbolicate "FAST-" translate "-C/SIGNED=>SIGNED") - fast-signed-c-binop) + fast-signed-c-binop) (:arg-types signed-num (:constant ,untagged-type)) (:translate ,translate) (:generator ,untagged-cost - ,inst)) + ,inst)) (define-vop (,(symbolicate "FAST-" translate "-C/UNSIGNED=>UNSIGNED") - fast-unsigned-c-binop) + fast-unsigned-c-binop) (:arg-types unsigned-num (:constant ,untagged-type)) (:translate ,translate) (:generator ,untagged-cost - ,inst)))) + ,inst)))) (define-c-binop + 1 3 (signed-byte 9) (signed-byte 11) (inst addi y x r)) @@ -210,7 +210,7 @@ (:translate ash) (:note "inline word ASH") (:args (number :scs (unsigned-reg)) - (count :scs (signed-reg))) + (count :scs (signed-reg))) (:arg-types unsigned-num tagged-num) (:temporary (:scs (unsigned-reg) :to (:result 0)) temp) (:results (result :scs (unsigned-reg))) @@ -235,7 +235,7 @@ (:translate ash) (:note "inline word ASH") (:args (number :scs (signed-reg)) - (count :scs (signed-reg))) + (count :scs (signed-reg))) (:arg-types signed-num tagged-num) (:temporary (:scs (unsigned-reg) :to (:result 0)) temp) (:results (result :scs (signed-reg))) @@ -266,14 +266,14 @@ (:result-types unsigned-num) (:generator 1 (cond ((< count 0) - ;; It is a right shift. - (inst srl number (min (- count) 31) result)) - ((> count 0) - ;; It is a left shift. - (inst sll number (min count 31) result)) - (t - ;; Count=0? Shouldn't happen, but it's easy: - (move number result))))) + ;; It is a right shift. + (inst srl number (min (- count) 31) result)) + ((> count 0) + ;; It is a left shift. + (inst sll number (min count 31) result)) + (t + ;; Count=0? Shouldn't happen, but it's easy: + (move number result))))) (define-vop (fast-ash-c/signed=>signed) (:policy :fast-safe) @@ -286,15 +286,18 @@ (:result-types signed-num) (:generator 1 (cond ((< count 0) - ;; It is a right shift. - (inst sra number (min (- count) 31) result)) - ((> count 0) - ;; It is a left shift. - (inst sll number (min count 31) result)) - (t - ;; Count=0? Shouldn't happen, but it's easy: - (move number result))))) - + ;; It is a right shift. + (inst sra number (min (- count) 31) result)) + ((> count 0) + ;; It is a left shift. + (inst sll number (min count 31) result)) + (t + ;; 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) @@ -325,7 +328,7 @@ (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:temporary (:scs (non-descriptor-reg) :from (:argument 0) :to (:result 0) - :target res) num) + :target res) num) (:temporary (:scs (non-descriptor-reg)) mask temp) (:generator 30 (inst li #x55555555 mask) @@ -358,16 +361,16 @@ (define-vop (fast-*/fixnum=>fixnum fast-fixnum-binop) (:args (x :scs (any-reg) :target x-pass) - (y :scs (any-reg) :target y-pass)) + (y :scs (any-reg) :target y-pass)) (:temporary (:sc signed-reg :offset nl0-offset - :from (:argument 0) :to (:result 0)) x-pass) + :from (:argument 0) :to (:result 0)) x-pass) (:temporary (:sc signed-reg :offset nl1-offset - :from (:argument 1) :to (:result 0)) y-pass) + :from (:argument 1) :to (:result 0)) y-pass) (:temporary (:sc signed-reg :offset nl2-offset :target r - :from (:argument 1) :to (:result 0)) res-pass) + :from (:argument 1) :to (:result 0)) res-pass) (:temporary (:sc signed-reg :offset nl3-offset :to (:result 0)) tmp) (:temporary (:sc signed-reg :offset nl4-offset - :from (:argument 1) :to (:result 0)) sign) + :from (:argument 1) :to (:result 0)) sign) (:temporary (:sc interior-reg :offset lip-offset) lip) (:ignore lip sign) (:translate *) @@ -378,23 +381,23 @@ (inst ldil fixup tmp) (inst ble fixup lisp-heap-space tmp)) (if (location= y y-pass) - (inst sra x 2 x-pass) - (inst move y y-pass)) + (inst sra x 2 x-pass) + (inst move y y-pass)) (move res-pass r))) (define-vop (fast-*/signed=>signed fast-signed-binop) (:translate *) (:args (x :scs (signed-reg) :target x-pass) - (y :scs (signed-reg) :target y-pass)) + (y :scs (signed-reg) :target y-pass)) (:temporary (:sc signed-reg :offset nl0-offset - :from (:argument 0) :to (:result 0)) x-pass) + :from (:argument 0) :to (:result 0)) x-pass) (:temporary (:sc signed-reg :offset nl1-offset - :from (:argument 1) :to (:result 0)) y-pass) + :from (:argument 1) :to (:result 0)) y-pass) (:temporary (:sc signed-reg :offset nl2-offset :target r - :from (:argument 1) :to (:result 0)) res-pass) + :from (:argument 1) :to (:result 0)) res-pass) (:temporary (:sc signed-reg :offset nl3-offset :to (:result 0)) tmp) (:temporary (:sc signed-reg :offset nl4-offset - :from (:argument 1) :to (:result 0)) sign) + :from (:argument 1) :to (:result 0)) sign) (:temporary (:sc interior-reg :offset lip-offset) lip) (:ignore lip sign) (:translate *) @@ -410,17 +413,17 @@ (define-vop (fast-truncate/fixnum fast-fixnum-binop) (:translate truncate) (:args (x :scs (any-reg) :target x-pass) - (y :scs (any-reg) :target y-pass)) + (y :scs (any-reg) :target y-pass)) (:temporary (:sc signed-reg :offset nl0-offset - :from (:argument 0) :to (:result 0)) x-pass) + :from (:argument 0) :to (:result 0)) x-pass) (:temporary (:sc signed-reg :offset nl1-offset - :from (:argument 1) :to (:result 0)) y-pass) + :from (:argument 1) :to (:result 0)) y-pass) (:temporary (:sc signed-reg :offset nl2-offset :target q - :from (:argument 1) :to (:result 0)) q-pass) + :from (:argument 1) :to (:result 0)) q-pass) (:temporary (:sc signed-reg :offset nl3-offset :target r - :from (:argument 1) :to (:result 1)) r-pass) + :from (:argument 1) :to (:result 1)) r-pass) (:results (q :scs (signed-reg)) - (r :scs (any-reg))) + (r :scs (any-reg))) (:result-types tagged-num tagged-num) (:vop-var vop) (:save-p :compute-only) @@ -439,17 +442,17 @@ (define-vop (fast-truncate/signed fast-signed-binop) (:translate truncate) (:args (x :scs (signed-reg) :target x-pass) - (y :scs (signed-reg) :target y-pass)) + (y :scs (signed-reg) :target y-pass)) (:temporary (:sc signed-reg :offset nl0-offset - :from (:argument 0) :to (:result 0)) x-pass) + :from (:argument 0) :to (:result 0)) x-pass) (:temporary (:sc signed-reg :offset nl1-offset - :from (:argument 1) :to (:result 0)) y-pass) + :from (:argument 1) :to (:result 0)) y-pass) (:temporary (:sc signed-reg :offset nl2-offset :target q - :from (:argument 1) :to (:result 0)) q-pass) + :from (:argument 1) :to (:result 0)) q-pass) (:temporary (:sc signed-reg :offset nl3-offset :target r - :from (:argument 1) :to (:result 1)) r-pass) + :from (:argument 1) :to (:result 1)) r-pass) (:results (q :scs (signed-reg)) - (r :scs (signed-reg))) + (r :scs (signed-reg))) (:result-types signed-num signed-num) (:vop-var vop) (:save-p :compute-only) @@ -477,7 +480,7 @@ (define-vop (fast-conditional/fixnum fast-conditional) (:args (x :scs (any-reg)) - (y :scs (any-reg))) + (y :scs (any-reg))) (:arg-types tagged-num tagged-num) (:note "inline fixnum comparison")) @@ -488,7 +491,7 @@ (define-vop (fast-conditional/signed fast-conditional) (:args (x :scs (signed-reg)) - (y :scs (signed-reg))) + (y :scs (signed-reg))) (:arg-types signed-num signed-num) (:note "inline (signed-byte 32) comparison")) @@ -499,7 +502,7 @@ (define-vop (fast-conditional/unsigned fast-conditional) (:args (x :scs (unsigned-reg)) - (y :scs (unsigned-reg))) + (y :scs (unsigned-reg))) (:arg-types unsigned-num unsigned-num) (:note "inline (unsigned-byte 32) comparison")) @@ -512,27 +515,27 @@ (defmacro define-conditional-vop (translate signed-cond unsigned-cond) `(progn ,@(mapcar #'(lambda (suffix cost signed imm) - (unless (and (member suffix '(/fixnum -c/fixnum)) - (eq translate 'eql)) - `(define-vop (,(intern (format nil "~:@(FAST-IF-~A~A~)" - translate suffix)) - ,(intern - (format nil "~:@(FAST-CONDITIONAL~A~)" - suffix))) - (:translate ,translate) - (:generator ,cost - (inst ,(if imm 'bci 'bc) - ,(if signed signed-cond unsigned-cond) - not-p - ,(if (eq suffix '-c/fixnum) - '(fixnumize y) - 'y) - x - target))))) - '(/fixnum -c/fixnum /signed -c/signed /unsigned -c/unsigned) - '(3 2 5 4 5 4) - '(t t t t nil nil) - '(nil t nil t nil t)))) + (unless (and (member suffix '(/fixnum -c/fixnum)) + (eq translate 'eql)) + `(define-vop (,(intern (format nil "~:@(FAST-IF-~A~A~)" + translate suffix)) + ,(intern + (format nil "~:@(FAST-CONDITIONAL~A~)" + suffix))) + (:translate ,translate) + (:generator ,cost + (inst ,(if imm 'bci 'bc) + ,(if signed signed-cond unsigned-cond) + not-p + ,(if (eq suffix '-c/fixnum) + '(fixnumize y) + 'y) + x + target))))) + '(/fixnum -c/fixnum /signed -c/signed /unsigned -c/unsigned) + '(3 2 5 4 5 4) + '(t t t t nil nil) + '(nil t nil t nil t)))) ;; We switch < and > because the immediate has to come first. @@ -552,7 +555,7 @@ ;;; (define-vop (fast-eql/fixnum fast-conditional) (:args (x :scs (any-reg descriptor-reg)) - (y :scs (any-reg))) + (y :scs (any-reg))) (:arg-types tagged-num tagged-num) (:note "inline fixnum comparison") (:translate eql) @@ -574,27 +577,34 @@ (define-vop (generic-eql-c/fixnum fast-eql-c/fixnum) (:arg-types * (:constant (signed-byte 9))) (:variant-cost 6)) - + ;;;; modular functions -(define-modular-fun +-mod32 (x y) + 32) +(define-modular-fun +-mod32 (x y) + :unsigned 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-modular-fun --mod32 (x y) - 32) +(define-modular-fun --mod32 (x y) - :unsigned 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)) -(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-modular-fun lognot-mod32 (x) lognot 32) +(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 :unsigned 32) (define-vop (lognot-mod32/unsigned=>unsigned) (:translate lognot-mod32) (:args (x :scs (unsigned-reg))) @@ -608,14 +618,14 @@ (macrolet ((define-modular-backend (fun) (let ((mfun-name (symbolicate fun '-mod32)) - ;; FIXME: if anyone cares, add constant-arg vops. -- - ;; CSR, 2003-09-16 - (modvop (symbolicate 'fast- fun '-mod32/unsigned=>unsigned)) - (vop (symbolicate 'fast- fun '/unsigned=>unsigned))) - `(progn - (define-modular-fun ,mfun-name (x y) ,fun 32) - (define-vop (,modvop ,vop) - (:translate ,mfun-name)))))) + ;; FIXME: if anyone cares, add constant-arg vops. -- + ;; CSR, 2003-09-16 + (modvop (symbolicate 'fast- fun '-mod32/unsigned=>unsigned)) + (vop (symbolicate 'fast- fun '/unsigned=>unsigned))) + `(progn + (define-modular-fun ,mfun-name (x y) ,fun :unsigned 32) + (define-vop (,modvop ,vop) + (:translate ,mfun-name)))))) (define-modular-backend logxor) (define-modular-backend logandc1) (define-modular-backend logandc2)) @@ -632,47 +642,11 @@ `(lognot (logand ,x ,y))) (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)) - (amount :scs (signed-reg))) + (amount :scs (signed-reg))) (:arg-types unsigned-num tagged-num) (:results (r :scs (unsigned-reg))) (:result-types unsigned-num)) @@ -698,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) @@ -724,14 +698,14 @@ (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)) - (c :scs (unsigned-reg))) + (b :scs (unsigned-reg)) + (c :scs (unsigned-reg))) (:arg-types unsigned-num unsigned-num positive-fixnum) (:results (result :scs (unsigned-reg)) - (carry :scs (unsigned-reg))) + (carry :scs (unsigned-reg))) (:result-types unsigned-num positive-fixnum) (:generator 3 (inst addi -1 c zero-tn) @@ -739,14 +713,14 @@ (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)) - (c :scs (unsigned-reg))) + (b :scs (unsigned-reg)) + (c :scs (unsigned-reg))) (:arg-types unsigned-num unsigned-num positive-fixnum) (:results (result :scs (unsigned-reg)) - (borrow :scs (unsigned-reg))) + (borrow :scs (unsigned-reg))) (:result-types unsigned-num positive-fixnum) (:generator 4 (inst addi -1 c zero-tn) @@ -754,16 +728,16 @@ (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)) + (y-arg :scs (unsigned-reg) :target y)) (:arg-types unsigned-num unsigned-num) (:temporary (:scs (signed-reg) :from (:argument 0)) x) (:temporary (:scs (signed-reg) :from (:argument 1)) y) (:temporary (:scs (signed-reg)) tmp) (:results (hi :scs (unsigned-reg)) - (lo :scs (unsigned-reg))) + (lo :scs (unsigned-reg))) (:result-types unsigned-num unsigned-num) (:generator 3 ;; Make sure X is less then Y. @@ -793,26 +767,26 @@ (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 - (sb!bignum:%multiply ,x ,y) - (values ,carry)) - `(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))) + `(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 + (sb!bignum:%multiply ,x ,y) + (values ,carry)) + (values ,extra))) (with-unique-names (hi lo) (if (eql extra 0) - `(multiple-value-bind (,hi ,lo) (sb!bignum:%multiply ,x ,y) - (sb!bignum::%dual-word-add ,hi ,lo ,carry)) - `(multiple-value-bind (,hi ,lo) (sb!bignum:%multiply ,x ,y) - (multiple-value-bind - (,hi ,lo) - (sb!bignum::%dual-word-add ,hi ,lo ,carry) - (sb!bignum::%dual-word-add ,hi ,lo ,extra)))))) + `(multiple-value-bind (,hi ,lo) (sb!bignum:%multiply ,x ,y) + (sb!bignum::%dual-word-add ,hi ,lo ,carry)) + `(multiple-value-bind (,hi ,lo) (sb!bignum:%multiply ,x ,y) + (multiple-value-bind + (,hi ,lo) + (sb!bignum::%dual-word-add ,hi ,lo ,carry) + (sb!bignum::%dual-word-add ,hi ,lo ,extra)))))) (defknown sb!bignum::%dual-word-add - (sb!bignum:bignum-element-type sb!bignum:bignum-element-type sb!bignum:bignum-element-type) + (sb!bignum:bignum-element-type sb!bignum:bignum-element-type sb!bignum:bignum-element-type) (values sb!bignum:bignum-element-type sb!bignum:bignum-element-type) (flushable movable)) @@ -820,11 +794,11 @@ (:policy :fast-safe) (:translate sb!bignum::%dual-word-add) (:args (hi :scs (unsigned-reg) :to (:result 1)) - (lo :scs (unsigned-reg)) - (extra :scs (unsigned-reg))) + (lo :scs (unsigned-reg)) + (extra :scs (unsigned-reg))) (:arg-types unsigned-num unsigned-num unsigned-num) (:results (hi-res :scs (unsigned-reg) :from (:result 1)) - (lo-res :scs (unsigned-reg) :from (:result 0))) + (lo-res :scs (unsigned-reg) :from (:result 0))) (:result-types unsigned-num unsigned-num) (:affected) (:effects) @@ -833,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) @@ -843,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) @@ -853,15 +827,15 @@ (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)) - (divisor :scs (unsigned-reg))) + (lo :scs (unsigned-reg) :to (:argument 0)) + (divisor :scs (unsigned-reg))) (:arg-types unsigned-num unsigned-num unsigned-num) (:temporary (:scs (unsigned-reg) :to (:argument 1)) temp) (:results (quo :scs (unsigned-reg) :from (:argument 0)) - (rem :scs (unsigned-reg) :from (:argument 1))) + (rem :scs (unsigned-reg) :from (:argument 1))) (:result-types unsigned-num unsigned-num) (:generator 65 (inst sub zero-tn divisor temp) @@ -876,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) @@ -886,10 +860,10 @@ (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))) + (count :scs (unsigned-reg))) (:arg-types unsigned-num positive-fixnum) (:results (result :scs (unsigned-reg))) (:result-types unsigned-num) @@ -898,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) @@ -906,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)