X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmips%2Farith.lisp;h=93e0bf6fec80f91fbb5e794d1fd231c08e2e67cd;hb=3fe0010d2777b41e01ea9b4a0f894cfa40f7df1b;hp=9188d9836fc0fb34811bb08d63c8fd515afde900;hpb=4ed3f0d08c3a57a6762018d9622f253ab9d0f2b6;p=sbcl.git diff --git a/src/compiler/mips/arith.lisp b/src/compiler/mips/arith.lisp index 9188d98..93e0bf6 100644 --- a/src/compiler/mips/arith.lisp +++ b/src/compiler/mips/arith.lisp @@ -160,15 +160,24 @@ (define-binop logand 1 3 and (unsigned-byte 14) (unsigned-byte 16)) (define-binop logxor 1 3 xor (unsigned-byte 14) (unsigned-byte 16)) -;;; KLUDGE: no FIXNUM VOP for LOGNOR, because there's no efficient way -;;; of restoring the tag bits. (No -C/ VOPs for LOGNOR because the -;;; NOR instruction doesn't take immediate args). -- CSR, 2003-09-11 +;;; No -C/ VOPs for LOGNOR because the NOR instruction doesn't take +;;; immediate args. -- CSR, 2003-09-11 +(define-vop (fast-lognor/fixnum=>fixnum fast-fixnum-binop) + (:translate lognor) + (:args (x :target r :scs (any-reg)) + (y :target r :scs (any-reg))) + (:temporary (:sc non-descriptor-reg) temp) + (:generator 4 + (inst nor temp x y) + (inst addu r temp (- fixnum-tag-mask)))) + (define-vop (fast-lognor/signed=>signed fast-signed-binop) (:translate lognor) (:args (x :target r :scs (signed-reg)) (y :target r :scs (signed-reg))) (:generator 4 (inst nor r x y))) + (define-vop (fast-lognor/unsigned=>unsigned fast-unsigned-binop) (:translate lognor) (:args (x :target r :scs (unsigned-reg)) @@ -229,7 +238,7 @@ (inst bne temp zero-tn done) (inst srl result number ndesc) (inst b done) - (inst move result zero-tn) + (move result zero-tn t) POSITIVE ;; The result-type assures us that this shift will not overflow. @@ -295,6 +304,28 @@ ((> count 0) (inst sll result number (min count 31))) (t (bug "identity ASH not transformed away"))))) +(macrolet ((def (name sc-type type result-type cost) + `(define-vop (,name) + (:note "inline ASH") + (:translate ash) + (:args (number :scs (,sc-type)) + (amount :scs (signed-reg unsigned-reg immediate))) + (:arg-types ,type positive-fixnum) + (:results (result :scs (,result-type))) + (:result-types ,type) + (:policy :fast-safe) + (:generator ,cost + (sc-case amount + ((signed-reg unsigned-reg) + (inst sll result number amount)) + (immediate + (let ((amount (tn-value amount))) + (aver (> amount 0)) + (inst sll result number amount)))))))) + (def fast-ash-left/fixnum=>fixnum any-reg tagged-num any-reg 2) + (def fast-ash-left/signed=>signed signed-reg signed-num signed-reg 3) + (def fast-ash-left/unsigned=>unsigned unsigned-reg unsigned-num unsigned-reg 3)) + (define-vop (signed-byte-32-len) (:translate integer-length) (:note "inline (signed-byte 32) integer-length") @@ -309,7 +340,7 @@ (test (gen-label))) (move shift arg) (inst bgez shift test) - (move res zero-tn) + (move res zero-tn t) (inst b test) (inst nor shift shift) @@ -616,40 +647,6 @@ (emit-label done) (move result res)))) -(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))) - -(define-source-transform 32bit-logical-andc1 (x y) - `(32bit-logical-and (32bit-logical-not ,x) ,y)) - -(define-source-transform 32bit-logical-andc2 (x y) - `(32bit-logical-and ,x (32bit-logical-not ,y))) - (define-vop (shift-towards-someplace) (:policy :fast-safe) (:args (num :scs (unsigned-reg)) @@ -679,12 +676,12 @@ (inst sll r num amount))))) ;;;; Modular arithmetic -(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) @@ -694,8 +691,16 @@ fast-ash-c/unsigned=>unsigned) (:translate ash-left-mod32)) +(define-vop (fast-ash-left-mod32/unsigned=>unsigned + fast-ash-left/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)) + ;;; logical operations -(define-modular-fun lognot-mod32 (x) lognot 32) +(define-modular-fun lognot-mod32 (x) lognot :unsigned 32) (define-vop (lognot-mod32/unsigned=>unsigned) (:translate lognot-mod32) (:args (x :scs (unsigned-reg))) @@ -706,7 +711,7 @@ (:generator 1 (inst nor r x zero-tn))) -(define-modular-fun logxor-mod32 (x y) logxor 32) +(define-modular-fun logxor-mod32 (x y) logxor :unsigned 32) (define-vop (fast-logxor-mod32/unsigned=>unsigned fast-logxor/unsigned=>unsigned) (:translate logxor-mod32)) @@ -714,7 +719,7 @@ fast-logxor-c/unsigned=>unsigned) (:translate logxor-mod32)) -(define-modular-fun lognor-mod32 (x y) lognor 32) +(define-modular-fun lognor-mod32 (x y) lognor :unsigned 32) (define-vop (fast-lognor-mod32/unsigned=>unsigned fast-lognor/unsigned=>unsigned) (:translate lognor-mod32))