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

Update of /cvsroot/sbcl/sbcl/src/compiler In directory sc8prcvs1:/tmp/cvsserv32019/src/compiler Modified Files: srctran.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: srctran.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/srctran.lisp,v retrieving revision 1.79 retrieving revision 1.80 diff u d r1.79 r1.80  srctran.lisp 26 Aug 2003 13:21:18 0000 1.79 +++ srctran.lisp 29 Aug 2003 17:59:09 0000 1.80 @@ 2573,54 +2573,6 @@ `( (ash x ,len)) `(ash x ,len)))) ;;; 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) (unsignedbyte 32))  (unsignedbyte 32))  "recode as shift and add"  (unless (constantcontinuationp y)  (giveupir1transform))  (let ((y (continuationvalue y))  (result nil)  (firstone nil))  (labels ((tub32 (x) `(trulythe (unsignedbyte 32) ,x))  (add (nextfactor)  (setf result  (tub32  (if result  `(+ ,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.  `(ash x ,firstone)  ;; There are at least two.  `( ,(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)  (add '(ash x 30)))  (t  (add `( ,(tub32 '(ash x 31)) ,(tub32 `(ash x ,firstone))))))  (add '(ash x 31))))  (or result 0)))  ;;; If arg is a constant power of two, turn FLOOR into a shift and ;;; mask. If CEILING, add in (1 (ABS Y)), do FLOOR and correct a ;;; remainder. 