X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsparc%2Farith.lisp;h=2669bf6d607bdbcbce46287148748b9625a2a487;hb=1b650be8b800cf96e2c268ae317fb26d0bf36827;hp=7f6faada96ef176f2f837410d8897a33e8631530;hpb=a8166c109a5ae1ebaa0204946c0f720e1acb700e;p=sbcl.git diff --git a/src/compiler/sparc/arith.lisp b/src/compiler/sparc/arith.lisp index 7f6faad..2669bf6 100644 --- a/src/compiler/sparc/arith.lisp +++ b/src/compiler/sparc/arith.lisp @@ -1,4 +1,4 @@ -;;;; the VM definition arithmetic VOPs for the Alpha +;;;; the VM definition arithmetic VOPs for the SPARC ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. @@ -377,64 +377,71 @@ ;;; Shifting -(macrolet - ((frob (name sc-type type shift-right-inst) - `(define-vop (,name) - (:note "inline ASH") - (:args (number :scs (,sc-type) :to :save) - (amount :scs (signed-reg immediate))) - (:arg-types ,type signed-num) - (:results (result :scs (,sc-type))) - (:result-types ,type) - (:translate ash) - (:policy :fast-safe) - (:temporary (:sc non-descriptor-reg) ndesc) - (:generator 5 - (sc-case amount - (signed-reg - (cond - ;; FIXME: These two don't look different enough. - ((member :sparc-v9 *backend-subfeatures*) - (let ((done (gen-label)) - (positive (gen-label))) - (inst cmp amount) - (inst b :ge positive) - (inst neg ndesc amount) - ;; ndesc = max(-amount, 31) - (inst cmp ndesc 31) - (inst cmove :ge ndesc 31) - (inst b done) - (inst ,shift-right-inst result number ndesc) - (emit-label positive) - ;; The result-type assures us that this shift will - ;; not overflow. - (inst sll result number amount) - ;; We want a right shift of the appropriate size. - (emit-label done))) - (t - (let ((positive (gen-label)) - (done (gen-label))) - (inst cmp amount) - (inst b :ge positive) - (inst neg ndesc amount) - (inst cmp ndesc 31) - (inst b :le done) - (inst ,shift-right-inst result number ndesc) - (inst b done) - (inst ,shift-right-inst result number 31) - (emit-label positive) - ;; The result-type assures us that this shift will - ;; not overflow. - (inst sll result number amount) - (emit-label done))))) - (immediate - (let ((amount (tn-value amount))) - (if (minusp amount) - (let ((amount (min 31 (- amount)))) - (inst ,shift-right-inst result number amount)) - (inst sll result number amount))))))))) - (frob fast-ash/signed=>signed signed-reg signed-num sra) - (frob fast-ash/unsigned=>unsigned unsigned-reg unsigned-num srl)) +(define-vop (fast-ash/signed=>signed) + (:note "inline ASH") + (:args (number :scs (signed-reg) :to :save) + (amount :scs (signed-reg immediate) :to :save)) + (:arg-types signed-num signed-num) + (:results (result :scs (signed-reg))) + (:result-types signed-num) + (:translate ash) + (: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"))))) + +(define-vop (fast-ash/unsigned=>unsigned) + (:note "inline ASH") + (:args (number :scs (unsigned-reg) :to :save) + (amount :scs (signed-reg immediate) :to :save)) + (:arg-types unsigned-num signed-num) + (:results (result :scs (unsigned-reg))) + (:result-types unsigned-num) + (:translate ash) + (: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"))))) ;; Some special cases where we know we want a left shift. Just do the ;; shift, instead of checking for the sign of the shift. @@ -451,7 +458,7 @@ (:policy :fast-safe) (:generator ,cost ;; The result-type assures us that this shift will not - ;; overflow. And for fixnum's, the zero bits that get + ;; overflow. And for fixnums, the zero bits that get ;; shifted in are just fine for the fixnum tag. (sc-case amount ((signed-reg unsigned-reg) @@ -591,6 +598,21 @@ (inst sra temp y n-fixnum-tag-bits) (inst smul r x temp))) +(define-vop (fast-v8-*-c/fixnum=>fixnum fast-safe-arith-op) + (:args (x :target r :scs (any-reg zero))) + (:info y) + (:arg-types tagged-num + (:constant (and (signed-byte 13) (not (integer 0 0))))) + (:results (r :scs (any-reg))) + (:result-types tagged-num) + (:note "inline fixnum arithmetic") + (:translate *) + (:guard (or (member :sparc-v8 *backend-subfeatures*) + (and (member :sparc-v9 *backend-subfeatures*) + (not (member :sparc-64 *backend-subfeatures*))))) + (:generator 1 + (inst smul r x y))) + (define-vop (fast-v8-*/signed=>signed fast-signed-binop) (:translate *) (:guard (or (member :sparc-v8 *backend-subfeatures*) @@ -599,6 +621,14 @@ (:generator 3 (inst smul r x y))) +(define-vop (fast-v8-*-c/signed=>signed fast-signed-binop-c) + (:translate *) + (:guard (or (member :sparc-v8 *backend-subfeatures*) + (and (member :sparc-v9 *backend-subfeatures*) + (not (member :sparc-64 *backend-subfeatures*))))) + (:generator 2 + (inst smul r x y))) + (define-vop (fast-v8-*/unsigned=>unsigned fast-unsigned-binop) (:translate *) (:guard (or (member :sparc-v8 *backend-subfeatures*) @@ -607,6 +637,14 @@ (:generator 3 (inst umul r x y))) +(define-vop (fast-v8-*-c/unsigned=>unsigned fast-unsigned-binop-c) + (:translate *) + (:guard (or (member :sparc-v8 *backend-subfeatures*) + (and (member :sparc-v9 *backend-subfeatures*) + (not (member :sparc-64 *backend-subfeatures*))))) + (:generator 2 + (inst umul r x y))) + ;; The smul and umul instructions are deprecated on the Sparc V9. Use ;; mulx instead. (define-vop (fast-v9-*/fixnum=>fixnum fast-fixnum-binop) @@ -1212,11 +1250,30 @@ (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))) + (multiple-value-bind (result adds shifts) + (ub32-strength-reduce-constant-multiply 'x y) + (cond + ;; we assume, perhaps foolishly, that good SPARCs don't have an + ;; issue with multiplications. (Remember that there's a + ;; different transform for converting x*2^k to a shift). + ((member :sparc-64 *backend-subfeatures*) (give-up-ir1-transform)) + ((or (member :sparc-v9 *backend-subfeatures*) + (member :sparc-v8 *backend-subfeatures*)) + ;; breakeven point as measured by Raymond Toy + (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. -(in-package "SB!C") - (deftransform ash ((num shift) (integer integer)) (let ((num-type (continuation-type num)) (shift-type (continuation-type shift)))