[Sbcl-commits] CVS: sbcl/src/compiler fndb.lisp,1.59,1.60 srctran.lisp,1.57,1.58

[Alexey D. <ade...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs1:/tmp/cvs-serv21936/src/compiler

Modified Files:
	fndb.lisp srctran.lisp 
Log Message:
0.7.13.13:
        * SIGNAL-BOUNDING-INDICES-BAD-ERROR accepts any bounding index
          designators;
        * fixed CEILING optimization for a divisor of form 2^k.


Index: fndb.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/fndb.lisp,v
retrieving revision 1.59
retrieving revision 1.60
diff -u -d -r1.59 -r1.60
--- fndb.lisp	19 Feb 2003 17:11:38 -0000	1.59
+++ fndb.lisp	5 Mar 2003 06:06:42 -0000	1.60
@@ -1352,7 +1352,8 @@
 ;;; get efficient compilation of the inline expansion of
 ;;; %FIND-POSITION-IF, so it should maybe be in a more
 ;;; compiler-friendly package (SB-INT?)
-(defknown sb!impl::signal-bounding-indices-bad-error (sequence index index)
+(defknown sb!impl::signal-bounding-indices-bad-error
+    (sequence index sequence-end)
   nil) ; never returns
   
 

Index: srctran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/srctran.lisp,v
retrieving revision 1.57
retrieving revision 1.58
diff -u -d -r1.57 -r1.58
--- srctran.lisp	18 Feb 2003 15:22:54 -0000	1.57
+++ srctran.lisp	5 Mar 2003 06:06:42 -0000	1.58
@@ -2589,7 +2589,8 @@
     (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.
+;;; mask. If CEILING, add in (1- (ABS Y)), do FLOOR and correct a
+;;; remainder.
 (flet ((frob (y ceil-p)
 	 (unless (constant-continuation-p y)
 	   (give-up-ir1-transform))
@@ -2599,13 +2600,14 @@
 	   (unless (= y-abs (ash 1 len))
 	     (give-up-ir1-transform))
 	   (let ((shift (- len))
-		 (mask (1- y-abs)))
-	     `(let ,(when ceil-p `((x (+ x ,(1- y-abs)))))
+		 (mask (1- y-abs))
+                 (delta (if ceil-p (* (signum y) (1- y-abs)) 0)))
+	     `(let ((x (+ x ,delta)))
 		,(if (minusp y)
 		     `(values (ash (- x) ,shift)
-			      (- (logand (- x) ,mask)))
+			      (- (- (logand (- x) ,mask)) ,delta))
 		     `(values (ash x ,shift)
-			      (logand x ,mask))))))))
+			      (- (logand x ,mask) ,delta))))))))
   (deftransform floor ((x y) (integer integer) *)
     "convert division by 2^k to shift"
     (frob y nil))