diff --git a/compiler/aliencomp.lisp b/compiler/aliencomp.lisp index 9cb21e6adc6b7582312cf540d450e9b73fef7214..f2c199874eb3512d5987a33f5522413c8f9770d7 100644 --- a/compiler/aliencomp.lisp +++ b/compiler/aliencomp.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/aliencomp.lisp,v 1.28 2004/05/24 22:52:34 cwang Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/aliencomp.lisp,v 1.29 2004/08/03 00:12:28 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -586,7 +586,8 @@ (give-up)) (let* ((denominator (continuation-value denominator)) (bits (1- (integer-length denominator)))) - (unless (= (ash 1 bits) denominator) + (unless (and (plusp denominator) + (= (ash 1 bits) denominator)) (give-up)) (let ((alignment (count-low-order-zeros numerator))) (unless (>= alignment bits) diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp index e444c575991df1273a2ee1ac420051c4be793182..dff2b21a42ce8e8f1a8d1163e37e6450539e962c 100644 --- a/compiler/srctran.lisp +++ b/compiler/srctran.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.151 2004/07/21 04:01:00 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.152 2004/08/03 00:12:28 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2906,7 +2906,9 @@ (let* ((y (continuation-value y)) (y-abs (abs y)) (len (1- (integer-length y-abs)))) - (unless (= y-abs (ash 1 len)) (give-up)) + (unless (and (plusp y-abs) + (= y-abs (ash 1 len))) + (give-up)) (if (minusp y) `(- (ash x ,len)) `(ash x ,len)))) @@ -3013,7 +3015,9 @@ (let* ((y (continuation-value y)) (y-abs (abs y)) (len (1- (integer-length y-abs)))) - (unless (= y-abs (ash 1 len)) (give-up)) + (unless (and (plusp y-abs) + (= y-abs (ash 1 len))) + (give-up)) (let ((shift (- len)) (mask (1- y-abs)) (delta (if ceil-p (* (signum y) (1- y-abs)) 0))) @@ -3039,7 +3043,9 @@ (let* ((y (continuation-value y)) (y-abs (abs y)) (len (1- (integer-length y-abs)))) - (unless (= y-abs (ash 1 len)) (give-up)) + (unless (and (plusp y-abs) + (= y-abs (ash 1 len))) + (give-up)) (let ((mask (1- y-abs))) (if (minusp y) `(- (logand (- x) ,mask)) @@ -3054,7 +3060,9 @@ (let* ((y (continuation-value y)) (y-abs (abs y)) (len (1- (integer-length y-abs)))) - (unless (= y-abs (ash 1 len)) (give-up)) + (unless (and (plusp y-abs) + (= y-abs (ash 1 len))) + (give-up)) (let* ((shift (- len)) (mask (1- y-abs))) `(if (minusp x) @@ -3075,7 +3083,9 @@ (let* ((y (continuation-value y)) (y-abs (abs y)) (len (1- (integer-length y-abs)))) - (unless (= y-abs (ash 1 len)) (give-up)) + (unless (and (plusp y-abs) + (= y-abs (ash 1 len))) + (give-up)) (let ((mask (1- y-abs))) `(if (minusp x) (- (logand (- x) ,mask))