X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsparc%2Farith.lisp;h=1f400396b8deeac0a96b16702d27b401b1376ff0;hb=8a8a8922802460741d6f8f6c11d71b1f414cf3a7;hp=2669bf6d607bdbcbce46287148748b9625a2a487;hpb=2f25121d2f99afb4840138dd7e86807ceee20696;p=sbcl.git diff --git a/src/compiler/sparc/arith.lisp b/src/compiler/sparc/arith.lisp index 2669bf6..1f40039 100644 --- a/src/compiler/sparc/arith.lisp +++ b/src/compiler/sparc/arith.lisp @@ -111,68 +111,81 @@ (eval-when (:compile-toplevel :load-toplevel :execute) -(defmacro define-binop (translate untagged-penalty op) +(defmacro define-binop (translate untagged-penalty op + &optional arg-swap restore-fixnum-mask) `(progn - (define-vop (,(symbolicate "FAST-" translate "/FIXNUM=>FIXNUM") + (define-vop (,(symbolicate 'fast translate '/fixnum=>fixnum) fast-fixnum-binop) + ,@(when restore-fixnum-mask + `((:temporary (:sc non-descriptor-reg) temp))) (:translate ,translate) (:generator 2 - (inst ,op r x y))) - (define-vop (,(symbolicate 'fast- translate '-c/fixnum=>fixnum) - fast-fixnum-binop-c) - (:translate ,translate) - (:generator 1 - (inst ,op r x (fixnumize y)))) - (define-vop (,(symbolicate "FAST-" translate "/SIGNED=>SIGNED") + ,(if arg-swap + `(inst ,op ,(if restore-fixnum-mask 'temp 'r) y x) + `(inst ,op ,(if restore-fixnum-mask 'temp 'r) x y)) + ,@(when restore-fixnum-mask + `((inst andn r temp fixnum-tag-mask))))) + ,@(unless arg-swap + `((define-vop (,(symbolicate 'fast- translate '-c/fixnum=>fixnum) + fast-fixnum-binop-c) + ,@(when restore-fixnum-mask + `((:temporary (:sc non-descriptor-reg) temp))) + (:translate ,translate) + (:generator 1 + (inst ,op ,(if restore-fixnum-mask 'temp 'r) x (fixnumize y)) + ,@(when restore-fixnum-mask + `((inst andn r temp fixnum-tag-mask))))))) + (define-vop (,(symbolicate 'fast- translate '/signed=>signed) fast-signed-binop) (:translate ,translate) (:generator ,(1+ untagged-penalty) - (inst ,op r x y))) - (define-vop (,(symbolicate 'fast- translate '-c/signed=>signed) - fast-signed-binop-c) - (:translate ,translate) - (:generator ,untagged-penalty - (inst ,op r x y))) - (define-vop (,(symbolicate "FAST-" translate "/UNSIGNED=>UNSIGNED") + ,(if arg-swap + `(inst ,op r y x) + `(inst ,op r x y)))) + ,@(unless arg-swap + `((define-vop (,(symbolicate 'fast- translate '-c/signed=>signed) + fast-signed-binop-c) + (:translate ,translate) + (:generator ,untagged-penalty + (inst ,op r x y))))) + (define-vop (,(symbolicate 'fast- translate '/unsigned=>unsigned) fast-unsigned-binop) (:translate ,translate) (:generator ,(1+ untagged-penalty) - (inst ,op r x y))) - (define-vop (,(symbolicate 'fast- translate '-c/unsigned=>unsigned) - fast-unsigned-binop-c) - (:translate ,translate) - (:generator ,untagged-penalty - (inst ,op r x y))))) + ,(if arg-swap + `(inst ,op r y x) + `(inst ,op r x y)))) + ,@(unless arg-swap + `((define-vop (,(symbolicate 'fast- translate '-c/unsigned=>unsigned) + fast-unsigned-binop-c) + (:translate ,translate) + (:generator ,untagged-penalty + (inst ,op r x y))))))) ); eval-when (define-binop + 4 add) (define-binop - 4 sub) (define-binop logand 2 and) +(define-binop logandc1 2 andn t) (define-binop logandc2 2 andn) (define-binop logior 2 or) -(define-binop logorc2 2 orn) +(define-binop logorc1 2 orn t t) +(define-binop logorc2 2 orn nil t) (define-binop logxor 2 xor) -(define-binop logeqv 2 xnor) - -;;; Special logand cases: (logand signed unsigned) => unsigned - -(define-vop (fast-logand/signed-unsigned=>unsigned - fast-logand/unsigned=>unsigned) - (:args (x :scs (signed-reg)) - (y :target r :scs (unsigned-reg))) - (:arg-types signed-num unsigned-num)) - -(define-vop (fast-logand/unsigned-signed=>unsigned - fast-logand/unsigned=>unsigned) - (:args (x :target r :scs (unsigned-reg)) - (y :scs (signed-reg))) - (:arg-types unsigned-num signed-num)) - +(define-binop logeqv 2 xnor nil t) + +(define-vop (fast-logand/signed-unsigned=>unsigned fast-logand/unsigned=>unsigned) + (:args (x :scs (signed-reg) :target r) + (y :scs (unsigned-reg) :target r)) + (:arg-types signed-num unsigned-num) + (:translate logand)) + ;;; Special case fixnum + and - that trap on overflow. Useful when we ;;; don't know that the output type is a fixnum. -;;; I (Raymond Toy) took these out. They don't seem to be used anywhere at all. +;;; I (Raymond Toy) took these out. They don't seem to be used +;;; anywhere at all. #+nil (progn (define-vop (+/fixnum fast-+/fixnum=>fixnum) @@ -380,7 +393,7 @@ (define-vop (fast-ash/signed=>signed) (:note "inline ASH") (:args (number :scs (signed-reg) :to :save) - (amount :scs (signed-reg immediate) :to :save)) + (amount :scs (signed-reg) :to :save)) (:arg-types signed-num signed-num) (:results (result :scs (signed-reg))) (:result-types signed-num) @@ -388,32 +401,43 @@ (:policy :fast-safe) (:temporary (:sc non-descriptor-reg) ndesc) (:generator 5 - (sc-case amount - (signed-reg - (let ((done (gen-label))) - (inst cmp amount) - (inst b :ge done) - ;; The result-type assures us that this shift will not - ;; overflow. - (inst sll result number amount) - (inst neg ndesc amount) - (inst cmp ndesc 31) - (if (member :sparc-v9 *backend-subfeatures*) - (progn - (inst cmove :ge ndesc 31) - (inst sra result number ndesc)) - (progn - (inst b :le done) - (inst sra result number ndesc) - (inst sra result number 31))) - (emit-label done))) - (immediate - (bug "IMMEDIATE case in ASH VOP; should have been transformed"))))) + (let ((done (gen-label))) + (inst cmp amount) + (inst b :ge done) + ;; The result-type assures us that this shift will not + ;; overflow. + (inst sll result number amount) + (inst neg ndesc amount) + (inst cmp ndesc 31) + (if (member :sparc-v9 *backend-subfeatures*) + (progn + (inst cmove :ge ndesc 31) + (inst sra result number ndesc)) + (progn + (inst b :le done) + (inst sra result number ndesc) + (inst sra result number 31))) + (emit-label done)))) + +(define-vop (fast-ash-c/signed=>signed) + (:note "inline constant ASH") + (:args (number :scs (signed-reg))) + (:info count) + (:arg-types signed-num (:constant integer)) + (:results (result :scs (signed-reg))) + (:result-types signed-num) + (:translate ash) + (:policy :fast-safe) + (:generator 4 + (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 (fast-ash/unsigned=>unsigned) (:note "inline ASH") (:args (number :scs (unsigned-reg) :to :save) - (amount :scs (signed-reg immediate) :to :save)) + (amount :scs (signed-reg) :to :save)) (:arg-types unsigned-num signed-num) (:results (result :scs (unsigned-reg))) (:result-types unsigned-num) @@ -421,32 +445,44 @@ (:policy :fast-safe) (:temporary (:sc non-descriptor-reg) ndesc) (:generator 5 - (sc-case amount - (signed-reg - (let ((done (gen-label))) - (inst cmp amount) - (inst b :ge done) - ;; The result-type assures us that this shift will not - ;; overflow. - (inst sll result number amount) - (inst neg ndesc amount) - (inst cmp ndesc 32) - (if (member :sparc-v9 *backend-subfeatures*) - (progn - (inst srl result number ndesc) - (inst cmove :ge result zero-tn)) - (progn - (inst b :lt done) - (inst srl result number ndesc) - (move result zero-tn))) - (emit-label done))) - (immediate - (bug "IMMEDIATE case in ASH VOP; should have been transformed"))))) + (let ((done (gen-label))) + (inst cmp amount) + (inst b :ge done) + ;; The result-type assures us that this shift will not + ;; overflow. + (inst sll result number amount) + (inst neg ndesc amount) + (inst cmp ndesc 32) + (if (member :sparc-v9 *backend-subfeatures*) + (progn + (inst srl result number ndesc) + (inst cmove :ge result zero-tn)) + (progn + (inst b :lt done) + (inst srl result number ndesc) + (move result zero-tn))) + (emit-label done)))) + +(define-vop (fast-ash-c/unsigned=>unsigned) + (:note "inline constant ASH") + (:args (number :scs (unsigned-reg))) + (:info count) + (:arg-types unsigned-num (:constant integer)) + (:results (result :scs (unsigned-reg))) + (:result-types unsigned-num) + (:translate ash) + (:policy :fast-safe) + (:generator 4 + (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"))))) ;; Some special cases where we know we want a left shift. Just do the ;; shift, instead of checking for the sign of the shift. (macrolet - ((frob (name sc-type type result-type cost) + ((def (name sc-type type result-type cost) `(define-vop (,name) (:note "inline ASH") (:translate ash) @@ -465,69 +501,11 @@ (inst sll result number amount)) (immediate (let ((amount (tn-value amount))) - (assert (>= amount 0)) + (aver (>= amount 0)) (inst sll result number amount)))))))) - (frob fast-ash-left/signed=>signed signed-reg signed-num signed-reg 3) - (frob fast-ash-left/fixnum=>fixnum any-reg tagged-num any-reg 2) - (frob fast-ash-left/unsigned=>unsigned unsigned-reg unsigned-num unsigned-reg 3)) - -(defknown ash-right-signed ((signed-byte #.sb!vm:n-word-bits) - (and fixnum unsigned-byte)) - (signed-byte #.sb!vm:n-word-bits) - (movable foldable flushable)) - -(defknown ash-right-unsigned ((unsigned-byte #.sb!vm:n-word-bits) - (and fixnum unsigned-byte)) - (unsigned-byte #.sb!vm:n-word-bits) - (movable foldable flushable)) - -;; Some special cases where we want a right shift. Just do the shift. -;; (Needs appropriate deftransforms to call these, though.) - -(macrolet - ((frob (trans name sc-type type shift-inst cost) - `(define-vop (,name) - (:note "inline right ASH") - (:translate ,trans) - (:args (number :scs (,sc-type)) - (amount :scs (signed-reg unsigned-reg immediate))) - (:arg-types ,type positive-fixnum) - (:results (result :scs (,sc-type))) - (:result-types ,type) - (:policy :fast-safe) - (:generator ,cost - (sc-case amount - ((signed-reg unsigned-reg) - (inst ,shift-inst result number amount)) - (immediate - (let ((amt (tn-value amount))) - (inst ,shift-inst result number amt)))))))) - (frob ash-right-signed fast-ash-right/signed=>signed - signed-reg signed-num sra 3) - (frob ash-right-unsigned fast-ash-right/unsigned=>unsigned - unsigned-reg unsigned-num srl 3)) - -(define-vop (fast-ash-right/fixnum=>fixnum) - (:note "inline right ASH") - (:translate ash-right-signed) - (:args (number :scs (any-reg)) - (amount :scs (signed-reg unsigned-reg immediate))) - (:arg-types tagged-num positive-fixnum) - (:results (result :scs (any-reg))) - (:result-types tagged-num) - (:temporary (:sc non-descriptor-reg :target result) temp) - (:policy :fast-safe) - (:generator 2 - ;; Shift the fixnum right by the desired amount. Then zap out the - ;; 2 LSBs to make it a fixnum again. (Those bits are junk.) - (sc-case amount - ((signed-reg unsigned-reg) - (inst sra temp number amount)) - (immediate - (inst sra temp number (tn-value amount)))) - (inst andn result temp fixnum-tag-mask))) - - + (def fast-ash-left/signed=>signed signed-reg signed-num signed-reg 3) + (def fast-ash-left/fixnum=>fixnum any-reg tagged-num any-reg 2) + (def fast-ash-left/unsigned=>unsigned unsigned-reg unsigned-num unsigned-reg 3)) (define-vop (signed-byte-32-len) @@ -668,6 +646,58 @@ (inst mulx r x y))) +;;;; Modular functions: +(define-modular-fun lognot-mod32 (x) lognot 32) +(define-vop (lognot-mod32/unsigned=>unsigned) + (:translate lognot-mod32) + (:args (x :scs (unsigned-reg))) + (:arg-types unsigned-num) + (:results (res :scs (unsigned-reg))) + (:result-types unsigned-num) + (:policy :fast-safe) + (:generator 1 + (inst not res x))) + +(macrolet + ((define-modular-backend (fun &optional constantp) + (let ((mfun-name (symbolicate fun '-mod32)) + (modvop (symbolicate 'fast- fun '-mod32/unsigned=>unsigned)) + (modcvop (symbolicate 'fast- fun '-mod32-c/unsigned=>unsigned)) + (vop (symbolicate 'fast- fun '/unsigned=>unsigned)) + (cvop (symbolicate 'fast- fun '-c/unsigned=>unsigned))) + `(progn + (define-modular-fun ,mfun-name (x y) ,fun 32) + (define-vop (,modvop ,vop) + (:translate ,mfun-name)) + ,@(when constantp + `((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) + (define-modular-backend logandc2 t) + (define-modular-backend logorc1) + (define-modular-backend logorc2 t)) + +(define-source-transform lognand (x y) + `(lognot (logand ,x ,y))) +(define-source-transform lognor (x y) + `(lognot (logior ,x ,y))) + +(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 + 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)) + ;;;; Binary conditional VOPs: (define-vop (fast-conditional) @@ -781,7 +811,6 @@ ;;;; 32-bit logical operations - (define-vop (merge-bits) (:translate merge-bits) (:args (shift :scs (signed-reg unsigned-reg)) @@ -804,65 +833,6 @@ (emit-label done) (move result res)))) - -(define-vop (32bit-logical) - (:args (x :scs (unsigned-reg zero)) - (y :scs (unsigned-reg zero))) - (:arg-types unsigned-num unsigned-num) - (:results (r :scs (unsigned-reg))) - (:result-types unsigned-num) - (:policy :fast-safe)) - -(define-vop (32bit-logical-not 32bit-logical) - (:translate 32bit-logical-not) - (:args (x :scs (unsigned-reg zero))) - (:arg-types unsigned-num) - (:generator 1 - (inst not r x))) - -(define-vop (32bit-logical-and 32bit-logical) - (:translate 32bit-logical-and) - (:generator 1 - (inst and r x y))) - -(deftransform 32bit-logical-nand ((x y) (* *)) - '(32bit-logical-not (32bit-logical-and x y))) - -(define-vop (32bit-logical-or 32bit-logical) - (:translate 32bit-logical-or) - (:generator 1 - (inst or r x y))) - -(deftransform 32bit-logical-nor ((x y) (* *)) - '(32bit-logical-not (32bit-logical-or x y))) - -(define-vop (32bit-logical-xor 32bit-logical) - (:translate 32bit-logical-xor) - (:generator 1 - (inst xor r x y))) - -(define-vop (32bit-logical-eqv 32bit-logical) - (:translate 32bit-logical-eqv) - (:generator 1 - (inst xnor r x y))) - -(define-vop (32bit-logical-orc2 32bit-logical) - (:translate 32bit-logical-orc2) - (:generator 1 - (inst orn r x y))) - -(deftransform 32bit-logical-orc1 ((x y) (* *)) - '(32bit-logical-orc2 y x)) - -(define-vop (32bit-logical-andc2 32bit-logical) - (:translate 32bit-logical-andc2) - (:generator 1 - (inst andn r x y))) - -(deftransform 32bit-logical-andc1 ((x y) (* *)) - '(32bit-logical-andc2 y x)) - - (define-vop (shift-towards-someplace) (:policy :fast-safe) (:args (num :scs (unsigned-reg)) @@ -882,29 +852,25 @@ (:note "shift-towards-end") (:generator 1 (inst srl r num amount))) - - - ;;;; 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-vop (bignum-ref word-index-ref) (:variant bignum-digits-offset other-pointer-lowtag) - (:translate sb!bignum::%bignum-ref) + (:translate sb!bignum:%bignum-ref) (:results (value :scs (unsigned-reg))) (:result-types unsigned-num)) (define-vop (bignum-set word-index-set) (:variant bignum-digits-offset other-pointer-lowtag) - (:translate sb!bignum::%bignum-set) + (:translate sb!bignum:%bignum-set) (:args (object :scs (descriptor-reg)) (index :scs (any-reg immediate zero)) (value :scs (unsigned-reg))) @@ -913,7 +879,7 @@ (:result-types unsigned-num)) (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) @@ -928,7 +894,7 @@ (emit-label done)))) (define-vop (v9-digit-0-or-plus-cmove) - (: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) @@ -942,7 +908,7 @@ ;; This doesn't work? #+nil (define-vop (v9-digit-0-or-plus-movr) - (: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) @@ -954,9 +920,8 @@ (inst movr result null-tn digit :lz) (inst movr result temp digit :gez))) - (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)) @@ -971,7 +936,7 @@ (inst addx carry zero-tn zero-tn))) (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)) @@ -1039,7 +1004,7 @@ (inst rdy result-low))))) (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) :to (:eval 1)) (y :scs (unsigned-reg) :to (:eval 1)) @@ -1054,7 +1019,7 @@ (inst addx hi zero-tn))) (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) :to (:eval 1)) (y :scs (unsigned-reg) :to (:eval 1)) @@ -1072,7 +1037,7 @@ (inst addx hi zero-tn))) (define-vop (bignum-mult) - (:translate sb!bignum::%multiply) + (:translate sb!bignum:%multiply) (:policy :fast-safe) (:args (x :scs (unsigned-reg) :to (:result 1)) (y :scs (unsigned-reg) :to (:result 1))) @@ -1083,18 +1048,11 @@ (:generator 40 (emit-multiply x y hi lo))) -(define-vop (bignum-lognot) - (:translate sb!bignum::%lognot) - (:policy :fast-safe) - (:args (x :scs (unsigned-reg))) - (:arg-types unsigned-num) - (:results (r :scs (unsigned-reg))) - (:result-types unsigned-num) - (:generator 1 - (inst not r x))) +(define-vop (bignum-lognot lognot-mod32/unsigned=>unsigned) + (: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) @@ -1104,7 +1062,7 @@ (inst sra digit fixnum n-fixnum-tag-bits))) (define-vop (bignum-floor) - (:translate sb!bignum::%floor) + (:translate sb!bignum:%floor) (:policy :fast-safe) (:args (div-high :scs (unsigned-reg) :target rem) (div-low :scs (unsigned-reg) :target quo) @@ -1128,7 +1086,7 @@ (inst not quo))) (define-vop (bignum-floor-v8) - (:translate sb!bignum::%floor) + (:translate sb!bignum:%floor) (:policy :fast-safe) (:args (div-high :scs (unsigned-reg) :target rem) (div-low :scs (unsigned-reg) :target quo) @@ -1157,7 +1115,7 @@ (move quo q)))) (define-vop (bignum-floor-v9) - (:translate sb!bignum::%floor) + (:translate sb!bignum:%floor) (:policy :fast-safe) (:args (div-high :scs (unsigned-reg)) (div-low :scs (unsigned-reg)) @@ -1179,7 +1137,7 @@ (inst sub rem dividend 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) @@ -1192,9 +1150,8 @@ (signed-reg (move res digit))))) - (define-vop (digit-ashr) - (:translate sb!bignum::%ashr) + (:translate sb!bignum:%ashr) (:policy :fast-safe) (:args (digit :scs (unsigned-reg)) (count :scs (unsigned-reg))) @@ -1205,12 +1162,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))) @@ -1237,26 +1194,16 @@ (define-static-fun two-arg-and (x y) :translate logand) (define-static-fun two-arg-ior (x y) :translate logior) (define-static-fun two-arg-xor (x y) :translate logxor) +(define-static-fun two-arg-eqv (x y) :translate logeqv) -;; Need these so constant folding works with the deftransform. - -;; FIXME KLUDGE ew yuk. -#-sb-xc-host -(progn - (defun ash-right-signed (num shift) - (ash-right-signed num shift)) - - (defun ash-right-unsigned (num shuft) - (ash-right-unsigned num shift))) - (in-package "SB!C") (deftransform * ((x y) ((unsigned-byte 32) (constant-arg (unsigned-byte 32))) (unsigned-byte 32)) "recode as shifts and adds" - (let ((y (continuation-value y))) + (let ((y (lvar-value y))) (multiple-value-bind (result adds shifts) (ub32-strength-reduce-constant-multiply 'x y) (cond @@ -1270,36 +1217,3 @@ (when (> (+ adds shifts) 9) (give-up-ir1-transform)))) (or result 0)))) - -;; If we can prove that we have a right shift, just do the right shift -;; instead of calling the inline ASH which has to check for the -;; direction of the shift at run-time. -(deftransform ash ((num shift) (integer integer)) - (let ((num-type (continuation-type num)) - (shift-type (continuation-type shift))) - ;; Can only handle right shifts - (unless (csubtypep shift-type (specifier-type '(integer * 0))) - (give-up-ir1-transform)) - - ;; If we can prove the shift is so large that all bits are shifted - ;; out, return the appropriate constant. If the shift is small - ;; enough, call the VOP. Otherwise, check for the shift size and - ;; do the appropriate thing. (Hmm, could we just leave the IF - ;; s-expr and depend on other parts of the compiler to delete the - ;; unreachable parts, if any?) - (cond ((csubtypep num-type (specifier-type '(signed-byte #.sb!vm:n-word-bits))) - ;; A right shift by 31 is the same as a right shift by - ;; larger amount. We get just the sign. - (if (csubtypep shift-type (specifier-type '(integer #.(- 1 sb!vm:n-word-bits) 0))) - ;; FIXME: ash-right-{un,}signed package problems - `(sb!vm::ash-right-signed num (- shift)) - `(sb!vm::ash-right-signed num (min (- shift) #.(1- sb!vm:n-word-bits))))) - ((csubtypep num-type (specifier-type '(unsigned-byte #.sb!vm:n-word-bits))) - (if (csubtypep shift-type (specifier-type '(integer #.(- 1 sb!vm:n-word-bits) 0))) - `(sb!vm::ash-right-unsigned num (- shift)) - `(if (<= shift #.(- sb!vm:n-word-bits)) - 0 - (sb!vm::ash-right-unsigned num (- shift))))) - (t - (give-up-ir1-transform))))) -