From: Christophe Rhodes <crhodes@us...>  20030904 16:52:17

Update of /cvsroot/sbcl/sbcl/src/compiler/sparc In directory sc8prcvs1:/tmp/cvsserv11772/src/compiler/sparc Modified Files: arith.lisp Log Message: 0.8.3.37: Some more love and kisses to the ppc backend ... the strength reduction we perform on sparc multiplications is going to be common to most architectures, so ... factor out the reduction itself into a routine ... use it in a PPC deftransform for *, with suitable cutoffs ... some appropriate * vops, too Incidental cleanups in the ppc backend ... declare DSI instructions' operands to have the appropriate type ... fix the shady dodgy dealing going on in the %LR macrofunction Index: arith.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/sparc/arith.lisp,v retrieving revision 1.9 retrieving revision 1.10 diff u d r1.9 r1.10  arith.lisp 4 Sep 2003 13:35:08 0000 1.9 +++ arith.lisp 4 Sep 2003 16:52:07 0000 1.10 @@ 1252,70 +1252,24 @@ (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))) + (let ((y (continuationvalue y))) + (multiplevaluebind (result adds shifts) + (ub32strengthreduceconstantmultiply '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 :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 