Commit b61003de authored by Christophe Rhodes's avatar Christophe Rhodes
Browse files

0.8.4.12:

        I'm not proud of this.

        HEALTH WARNING: this may not work.  It does for me, on Linux/PPC.
		If your sourceforge-fu is strong, please try it.
        HEALTH WARNING: this is ugly as sin.  Unexported symbols, special
                assumptions, KLUDGEs thrown in with gay abandon.

        In partial mitigation, it does fix a bug :-)

        Fix for lying-to-the-compiler bug in
                UB32-STRENGTH-REDUCE-CONSTANT-MULTIPLY
        ... turn TRULY-THEs into suitable LOGANDs
                (inefficient in compile-time space; we only need one
                LOGAND wrapping the resulting form)
        ... likewise in x86 OPTIMIZE-MULTIPLY
                (even less efficient: constant mask is first :-)
        but that would be slow at runtime if we just left it there, so
        ... add - as a modular function (that was easy)
        ... add preliminary support for ASH as a modular function
                (for constant right shifts):
        ... delete ASH-RIGHT-[UN]SIGNED from the sparc backend
                (will be restored eventually, fear not, probably more
		cross-platformly)
        ... hack in special knowledge about ASH into CUT-TO-WIDTH
        ... ensure that all backends have a suitable VOP for translation
                of new ASH function
        ... (alpha version is 64bit, oh yes)
        ... don't forget out-of-line version (for xc also!)
                (aside: might we not need out-of-line versions of
                other modular functions in the xc?)
parent 11f02398
Loading
Loading
Loading
Loading
+6 −6
Original line number Diff line number Diff line
@@ -145,9 +145,9 @@
  (assert (typep array '(simple-array * (*))))
  (values array start end 0))

#!+sparc
(progn
  (defun sb!vm::ash-right-signed (num shift)
    (ash num (- shift)))
  (defun sb!vm::ash-right-unsigned (num shift)
    (ash num (- shift))))
#!-alpha
(defun sb!vm::ash-left-constant-mod32 (integer amount)
  (ldb (byte 32 0) (ash integer amount)))
#!+alpha
(defun sb!vm::ash-left-constant-mod64 (integer amount)
  (ldb (byte 64 0) (ash integer amount)))
+19 −0
Original line number Diff line number Diff line
@@ -1377,3 +1377,22 @@
                   for pattern = (1- (ash 1 width))
                   do (forms (definition name lambda-list width pattern)))))
  `(progn ,@(forms)))

;;; KLUDGE: these out-of-line definitions can't use the modular
;;; arithmetic, as that is only (currently) defined for constant
;;; shifts.  See also the comment in (LOGAND OPTIMIZER) for more
;;; discussion of this hack.  -- CSR, 2003-10-09
#!-alpha
(defun sb!vm::ash-left-constant-mod32 (integer amount)
  (etypecase integer
    ((unsigned-byte 32) (ldb (byte 32 0) (ash integer amount)))
    (fixnum (ldb (byte 32 0) (ash (logand integer #xffffffff) amount)))
    (bignum (ldb (byte 32 0) (ash (logand integer #xffffffff) amount)))))
#!+alpha
(defun sb!vm::ash-left-constant-mod64 (integer amount)
  (etypecase integer
    ((unsigned-byte 64) (ldb (byte 64 0) (ash integer amount)))
    (fixnum (ldb (byte 64 0) (ash (logand integer #xffffffffffffffff) amount)))
    (bignum (ldb (byte 64 0) 
		 (ash (logand integer #xffffffffffffffff) amount)))))
    
+8 −1
Original line number Diff line number Diff line
@@ -364,11 +364,17 @@
  (:generator 1
    (inst not x res)))

(defknown ash-left-constant-mod64 (integer (integer 0)) (unsigned-byte 64)
  (foldable flushable movable))
(define-vop (fast-ash-left-constant-mod64/unsigned=>unsigned
	     fast-ash-c/unsigned=>unsigned)
  (:translate ash-left-constant-mod64))

(macrolet
    ((define-modular-backend (fun &optional constantp)
       (let ((mfun-name (symbolicate fun '-mod64))
             (modvop (symbolicate 'fast- fun '-mod64/unsigned=>unsigned))
             (modcvop (symbolicate 'fast- fun 'mod64-c/unsigned=>unsigned))
             (modcvop (symbolicate 'fast- fun '-mod64-c/unsigned=>unsigned))
             (vop (symbolicate 'fast- fun '/unsigned=>unsigned))
             (cvop (symbolicate 'fast- fun '-c/unsigned=>unsigned)))
         `(progn
@@ -379,6 +385,7 @@
                `((define-vop (,modcvop ,cvop)
                    (:translate ,mfun-name))))))))
  (define-modular-backend + t)
  (define-modular-backend - t)
  (define-modular-backend logxor t)
  (define-modular-backend logeqv t)
  (define-modular-backend logandc1)
+1 −1
Original line number Diff line number Diff line
@@ -456,7 +456,7 @@
  (declare (type (unsigned-byte 32) num))
  (let ((adds 0) (shifts 0)
	(result nil) first-one)
    (labels ((tub32 (x) `(truly-the (unsigned-byte 32) ,x))
    (labels ((tub32 (x) `(logand ,x #xffffffff)) ; uses modular arithmetic
	     (add (next-factor)
	       (setf result
		     (tub32
+11 −0
Original line number Diff line number Diff line
@@ -582,6 +582,17 @@
  (:translate +-mod32))
(define-vop (fast-+-mod32-c/unsigned=>unsigned fast-+-c/unsigned=>unsigned)
  (:translate +-mod32))
(define-modular-fun --mod32 (x y) - 32)
(define-vop (fast---mod32/unsigned=>unsigned fast--/unsigned=>unsigned)
  (:translate --mod32))
(define-vop (fast---mod32-c/unsigned=>unsigned fast---c/unsigned=>unsigned)
  (:translate --mod32))

(defknown ash-left-constant-mod32 (integer (integer 0)) (unsigned-byte 32)
  (foldable flushable movable))
(define-vop (fast-ash-left-constant-mod32/unsigned=>unsigned
	     fast-ash-c/unsigned=>unsigned)
  (:translate ash-left-constant-mod32))

(define-modular-fun lognot-mod32 (x) lognot 32)
(define-vop (lognot-mod32/unsigned=>unsigned)
Loading