X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Farith.lisp;h=d054afc8a8563896f55703beb633634a63194278;hb=e0697854ef9f4999c8585b64be1b282ce4725176;hp=7f2a0bd87423c56bc91401bbe135d3b5fe7c38cb;hpb=dd357f3be290498fb7ef172696d986337f517a93;p=sbcl.git diff --git a/src/compiler/alpha/arith.lisp b/src/compiler/alpha/arith.lisp index 7f2a0bd..d054afc 100644 --- a/src/compiler/alpha/arith.lisp +++ b/src/compiler/alpha/arith.lisp @@ -94,12 +94,12 @@ (define-vop (fast-signed-c-binop fast-signed-binop) (:args (x :target r :scs (signed-reg))) (:info y) - (:arg-types tagged-num (:constant integer))) + (:arg-types signed-num (:constant integer))) (define-vop (fast-unsigned-c-binop fast-unsigned-binop) (:args (x :target r :scs (unsigned-reg))) (:info y) - (:arg-types tagged-num (:constant integer))) + (:arg-types unsigned-num (:constant integer))) (defmacro define-binop (translate cost untagged-cost op tagged-type untagged-type @@ -139,6 +139,8 @@ ,@(when (and tagged-type (not arg-swap)) `((define-vop (,(symbolicate "FAST-" translate "-C/FIXNUM=>FIXNUM") fast-fixnum-c-binop) + (:args (x ,@(unless restore-fixnum-mask `(:target r)) + :scs (any-reg))) (:arg-types tagged-num (:constant ,tagged-type)) ,@(when restore-fixnum-mask `((:temporary (:sc non-descriptor-reg) temp))) @@ -196,7 +198,7 @@ (:translate ash) (:policy :fast-safe) (:temporary (:sc non-descriptor-reg) ndesc) - (:temporary (:sc non-descriptor-reg :to :eval) temp) + (:temporary (:sc non-descriptor-reg) temp) (:generator 3 (inst bge amount positive) (inst subq zero-tn amount ndesc) @@ -207,10 +209,10 @@ (inst bne temp done) (move zero-tn result) (inst br zero-tn done) - + POSITIVE (inst sll number amount result) - + DONE)) (define-vop (fast-ash/signed=>signed) @@ -223,7 +225,7 @@ (:translate ash) (:policy :fast-safe) (:temporary (:sc non-descriptor-reg) ndesc) - (:temporary (:sc non-descriptor-reg :to :eval) temp) + (:temporary (:sc non-descriptor-reg) temp) (:generator 3 (inst bge amount positive) (inst subq zero-tn amount ndesc) @@ -232,10 +234,10 @@ (inst bne temp done) (inst sra number 63 result) (inst br zero-tn done) - + POSITIVE (inst sll number amount result) - + DONE)) (define-vop (fast-ash-c/signed=>signed) @@ -249,8 +251,8 @@ (:result-types signed-num) (:generator 1 (cond - ((< count 0) (inst sra number (- count) result)) - ((> count 0) (inst sll number count result)) + ((< count 0) (inst sra number (min 63 (- count)) result)) + ((> count 0) (inst sll number (min 63 count) result)) (t (bug "identity ASH not transformed away"))))) (define-vop (fast-ash-c/unsigned=>unsigned) @@ -266,7 +268,7 @@ (cond ((< count -63) (move zero-tn result)) ((< count 0) (inst sra number (- count) result)) - ((> count 0) (inst sll number count result)) + ((> count 0) (inst sll number (min 63 count) result)) (t (bug "identity ASH not transformed away"))))) (define-vop (signed-byte-64-len) @@ -292,6 +294,18 @@ (:translate logcount) (:note "inline (unsigned-byte 64) logcount") (:policy :fast-safe) + (:args (arg :scs (unsigned-reg))) + (:arg-types unsigned-num) + (:results (res :scs (unsigned-reg))) + (:result-types positive-fixnum) + (:guard (member :cix *backend-subfeatures*)) + (:generator 1 + (inst ctpop zero-tn arg res))) + +(define-vop (unsigned-byte-64-count) + (:translate logcount) + (:note "inline (unsigned-byte 64) logcount") + (:policy :fast-safe) (:args (arg :scs (unsigned-reg) :target num)) (:arg-types unsigned-num) (:results (res :scs (unsigned-reg))) @@ -339,7 +353,7 @@ (:temporary (:scs (non-descriptor-reg)) temp) (:translate *) (:generator 4 - (inst sra y 2 temp) + (inst sra y n-fixnum-tag-bits temp) (inst mulq x temp r))) (define-vop (fast-*/signed=>signed fast-signed-binop) @@ -364,11 +378,15 @@ (:generator 1 (inst not x res))) +(define-vop (fast-ash-left-mod64-c/unsigned=>unsigned + fast-ash-c/unsigned=>unsigned) + (:translate ash-left-mod64)) + (macrolet ((define-modular-backend (fun &optional constantp) (let ((mfun-name (symbolicate fun '-mod64)) (modvop (symbolicate 'fast- fun '-mod64/unsigned=>unsigned)) - (modcvop (symbolicate 'fast- fun 'mod64-c/unsigned=>unsigned)) + (modcvop (symbolicate 'fast- fun '-mod64-c/unsigned=>unsigned)) (vop (symbolicate 'fast- fun '/unsigned=>unsigned)) (cvop (symbolicate 'fast- fun '-c/unsigned=>unsigned))) `(progn @@ -379,6 +397,7 @@ `((define-vop (,modcvop ,cvop) (:translate ,mfun-name)))))))) (define-modular-backend + t) + (define-modular-backend - t) (define-modular-backend logxor t) (define-modular-backend logeqv t) (define-modular-backend logandc1) @@ -576,41 +595,41 @@ (emit-label done) (move res result)))) -(define-source-transform 32bit-logical-not (x) +(define-source-transform word-logical-not (x) `(logand (lognot (the (unsigned-byte 32) ,x)) #.(1- (ash 1 32)))) -(deftransform 32bit-logical-and ((x y)) +(deftransform word-logical-and ((x y)) '(logand x y)) -(define-source-transform 32bit-logical-nand (x y) - `(32bit-logical-not (32bit-logical-and ,x ,y))) +(define-source-transform word-logical-nand (x y) + `(word-logical-not (word-logical-and ,x ,y))) -(deftransform 32bit-logical-or ((x y)) +(deftransform word-logical-or ((x y)) '(logior x y)) -(define-source-transform 32bit-logical-nor (x y) +(define-source-transform word-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)) +(deftransform word-logical-xor ((x y)) '(logxor x y)) -(define-source-transform 32bit-logical-eqv (x y) +(define-source-transform word-logical-eqv (x y) `(logand (logeqv (the (unsigned-byte 32) ,x) (the (unsigned-byte 32) ,y)) #.(1- (ash 1 32)))) -(define-source-transform 32bit-logical-orc1 (x y) +(define-source-transform word-logical-orc1 (x y) `(logand (logorc1 (the (unsigned-byte 32) ,x) (the (unsigned-byte 32) ,y)) #.(1- (ash 1 32)))) -(define-source-transform 32bit-logical-orc2 (x y) +(define-source-transform word-logical-orc2 (x y) `(logand (logorc2 (the (unsigned-byte 32) ,x) (the (unsigned-byte 32) ,y)) #.(1- (ash 1 32)))) -(define-source-transform 32bit-logical-andc1 (x y) +(define-source-transform word-logical-andc1 (x y) `(logandc1 (the (unsigned-byte 32) ,x) (the (unsigned-byte 32) ,y))) -(define-source-transform 32bit-logical-andc2 (x y) +(define-source-transform word-logical-andc2 (x y) `(logandc2 (the (unsigned-byte 32) ,x) (the (unsigned-byte 32) ,y))) (define-vop (shift-towards-someplace) @@ -640,21 +659,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 #!+gengc nil) + (unsigned-reg) unsigned-num sb!bignum:%bignum-set #!+gengc nil) (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) @@ -668,7 +687,7 @@ (inst bge temp 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)) @@ -684,7 +703,7 @@ (inst mskll result 4 result))) (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)) @@ -702,7 +721,7 @@ (inst mskll result 4 result))) (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)) @@ -719,7 +738,7 @@ (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)) @@ -737,7 +756,7 @@ (inst mskll lo 4 lo))) (define-vop (bignum-mult) - (:translate sb!bignum::%multiply) + (:translate sb!bignum:%multiply) (:policy :fast-safe) (:args (x :scs (unsigned-reg)) (y :scs (unsigned-reg))) @@ -751,7 +770,7 @@ (inst mskll lo 4 lo))) (define-vop (bignum-lognot) - (:translate sb!bignum::%lognot) + (:translate sb!bignum:%lognot) (:policy :fast-safe) (:args (x :scs (unsigned-reg))) (:arg-types unsigned-num) @@ -762,17 +781,17 @@ (inst mskll r 4 r))) (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) (:results (digit :scs (unsigned-reg))) (:result-types unsigned-num) (:generator 1 - (inst sra fixnum 2 digit))) + (inst sra fixnum n-fixnum-tag-bits digit))) (define-vop (bignum-floor) - (:translate sb!bignum::%floor) + (:translate sb!bignum:%floor) (:policy :fast-safe) (:args (num-high :scs (unsigned-reg)) (num-low :scs (unsigned-reg)) @@ -802,7 +821,7 @@ (emit-label shift2))))) (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) @@ -819,7 +838,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))) @@ -832,12 +851,12 @@ (inst srl result 32 result))) (define-vop (digit-lshr digit-ashr) - (:translate sb!bignum::%digit-logical-shift-right) + (:translate sb!bignum:%digit-logical-shift-right) (:generator 1 (inst srl digit count result))) (define-vop (digit-ashl digit-ashr) - (:translate sb!bignum::%ashl) + (:translate sb!bignum:%ashl) (:generator 1 (inst sll digit count result)))