From 28971fe77b99b7faf54ac59d803531e2cf6d6e6a Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Thu, 14 Nov 1991 05:51:04 +0000 Subject: [PATCH] Added multiplier recoding for ub-32 * ub-32 => ub-32. --- compiler/srctran.lisp | 47 ++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 46 insertions(+), 1 deletion(-) diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp index 41ddb0e66..d336644ee 100644 --- a/compiler/srctran.lisp +++ b/compiler/srctran.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.31 1991/11/12 16:01:57 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.32 1991/11/14 05:51:04 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -930,6 +930,51 @@ `(- (ash x ,len)) `(ash x ,len)))) +;;; If both arguments and the result are (unsigned-byte 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) + ((unsigned-byte 32) (unsigned-byte 32)) + (unsigned-byte 32)) + (unless (constant-continuation-p y) + (give-up)) + (let ((y (continuation-value y)) + (result nil) + (first-one nil)) + (flet ((add (next-factor) + (setf result + (if result + `(+ ,next-factor ,result) + next-factor)))) + (declare (inline add)) + (dotimes (bitpos 32) + (if first-one + (when (not (logbitp bitpos y)) + (add (if (= (1+ first-one) bitpos) + ;; There is only a single bit in the string. + `(ash x ,first-one) + ;; There are at least two. + `(- (ash x ,bitpos) + (ash x ,first-one)))) + (setf first-one nil)) + (when (logbitp bitpos y) + (setf first-one bitpos)))) + (when first-one + (cond ((= first-one 31)) + ((= first-one 30) + (add '(ash x 30))) + (t + (add `(- (ash x 31) (ash x ,first-one))))) + (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)) and then do floor. ;;; -- GitLab