From: Christophe Rhodes <crhodes@us...>  20030829 17:59:19

Update of /cvsroot/sbcl/sbcl/src/compiler/sparc In directory sc8prcvs1:/tmp/cvsserv32019/src/compiler/sparc Modified Files: arith.lisp Log Message: 0.8.3.13: Implement better constant multiply routines ... have a cutoff on Sparc, as measured by Raymond Toy ... use LEA more on x86, as per cited paper ... don't do anything at all (yet) on other architectures. This needs to be fixed before 0.8.4, at least for PPC and Alpha Index: arith.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/sparc/arith.lisp,v retrieving revision 1.7 retrieving revision 1.8 diff u d r1.7 r1.8  arith.lisp 20 Aug 2003 12:28:59 0000 1.7 +++ arith.lisp 29 Aug 2003 17:59:09 0000 1.8 @@ 591,6 +591,21 @@ (inst sra temp y nfixnumtagbits) (inst smul r x temp))) +(definevop (fastv8*c/fixnum=>fixnum fastsafearithop) + (:args (x :target r :scs (anyreg zero))) + (:info y) + (:argtypes taggednum + (:constant (and (signedbyte 13) (not (integer 0 0))))) + (:results (r :scs (anyreg))) + (:resulttypes taggednum) + (:note "inline fixnum arithmetic") + (:translate *) + (:guard (or (member :sparcv8 *backendsubfeatures*) + (and (member :sparcv9 *backendsubfeatures*) + (not (member :sparc64 *backendsubfeatures*))))) + (:generator 1 + (inst smul r x y))) + (definevop (fastv8*/signed=>signed fastsignedbinop) (:translate *) (:guard (or (member :sparcv8 *backendsubfeatures*) @@ 599,6 +614,14 @@ (:generator 3 (inst smul r x y))) +(definevop (fastv8*c/signed=>signed fastsignedbinopc) + (:translate *) + (:guard (or (member :sparcv8 *backendsubfeatures*) + (and (member :sparcv9 *backendsubfeatures*) + (not (member :sparc64 *backendsubfeatures*))))) + (:generator 2 + (inst smul r x y))) + (definevop (fastv8*/unsigned=>unsigned fastunsignedbinop) (:translate *) (:guard (or (member :sparcv8 *backendsubfeatures*) @@ 607,6 +630,14 @@ (:generator 3 (inst umul r x y))) +(definevop (fastv8*c/unsigned=>unsigned fastunsignedbinopc) + (:translate *) + (:guard (or (member :sparcv8 *backendsubfeatures*) + (and (member :sparcv9 *backendsubfeatures*) + (not (member :sparc64 *backendsubfeatures*))))) + (:generator 2 + (inst umul r x y))) + ;; The smul and umul instructions are deprecated on the Sparc V9. Use ;; mulx instead. (definevop (fastv9*/fixnum=>fixnum fastfixnumbinop) @@ 1212,11 +1243,76 @@ (defun ashrightunsigned (num shuft) (ashrightunsigned num shift))) +(inpackage "SB!C") + +;;; If both arguments and the result are (UNSIGNEDBYTE 32), try to +;;; come up with a ``better'' multiplication using multiplier +;;; recoding. There are two different ways the multiplier can be +;;; recoded. The more obvious is to shift X by the correct amount for +;;; each bit set in Y and to sum the results. But if there is a string +;;; of bits that are all set, you can add X shifted by one more then +;;; the bit position of the first set bit and subtract X shifted by +;;; the bit position of the last set bit. We can't use this second +;;; method when the high order bit is bit 31 because shifting by 32 +;;; doesn't work too well. +(deftransform * ((x y) + ((unsignedbyte 32) (constantarg (unsignedbyte 32))) + (unsignedbyte 32)) + "recode as shifts and adds" + (let ((y (continuationvalue y)) + (adds 0) + (shifts 0) + (result nil) + (firstone nil)) + (labels ((tub32 (x) `(trulythe (unsignedbyte 32) ,x)) + (add (nextfactor) + (setf result + (tub32 + (if result + (progn (incf adds) `(+ ,result ,(tub32 nextfactor))) + nextfactor))))) + (declare (inline add)) + (dotimes (bitpos 32) + (if firstone + (when (not (logbitp bitpos y)) + (add (if (= (1+ firstone) bitpos) + ;; There is only a single bit in the string. + (progn (incf shifts) `(ash x ,firstone)) + ;; There are at least two. + (progn + (incf adds) + (incf shifts 2) + `( ,(tub32 `(ash x ,bitpos)) + ,(tub32 `(ash x ,firstone)))))) + (setf firstone nil)) + (when (logbitp bitpos y) + (setf firstone bitpos)))) + (when firstone + (cond ((= firstone 31)) + ((= firstone 30) (incf shifts) (add '(ash x 30))) + (t + (incf shifts 2) + (incf adds) + (add `( ,(tub32 '(ash x 31)) ,(tub32 `(ash x ,firstone)))))) + (incf shifts) + (add '(ash x 31)))) + + (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 :sparc64 *backendsubfeatures*) (giveupir1transform)) + ((or (member :sparcv9 *backendsubfeatures*) + (member :sparcv8 *backendsubfeatures*)) + ;; breakeven point as measured by Raymond Toy + (when (> (+ adds shifts) 9) + (giveupir1transform)))) + + (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 runtime. (inpackage "SB!C")  (deftransform ash ((num shift) (integer integer)) (let ((numtype (continuationtype num)) (shifttype (continuationtype shift))) 