0.8.2.38:
authorAlexey Dejneka <adejneka@comail.ru>
Sun, 17 Aug 2003 17:17:06 +0000 (17:17 +0000)
committerAlexey Dejneka <adejneka@comail.ru>
Sun, 17 Aug 2003 17:17:06 +0000 (17:17 +0000)
        * Try to fix bug 267 = optimization issue #7: inside
          NAMED-LAMBDA replace references to a function with the same
          name with self-references;
        * ASSERT-GLOBAL-FUNCTION-DEFINITION-TYPE: do not put type
          assertions for functions with EXPLICIT-CHECK attribute;
        ... FLOAT-RADIX does not perform explicit check;
        * implement cross-compiler versions of %DPB and %WITH-ARRAY-DATA.

BUGS
OPTIMIZATIONS
src/code/cross-misc.lisp
src/compiler/ctype.lisp
src/compiler/fndb.lisp
src/compiler/ir1tran-lambda.lisp
version.lisp-expr

diff --git a/BUGS b/BUGS
index d964818..4582384 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -1033,16 +1033,6 @@ WORKAROUND:
   be nice to understand why the first patch caused problems, and to
   fix the cause if possible.
 
-267:
-  In
-    (defun fact (x i)
-      (if (= x 0)
-          i
-          (fact (1- x) (* x i))))
-  sbcl does not convert the self-recursive call to a jump, though it
-  is allowed to by CLHS 3.2.2.3.  CMUCL, however, does perform this
-  optimization.
-
 268: "wrong free declaration scope"
   The following code must signal type error:
 
index 2806884..3b6ebe1 100644 (file)
@@ -90,25 +90,14 @@ VOP DATA-VECTOR-SET/SIMPLE-STRING V2!14[EDI] t32[EAX] t30[S2]>t33[CL]
                 (incf x)))))))
    (format t "~A~%" x)))
 --------------------------------------------------------------------------------
-#7
-(defun foo (x)
-  (declare (optimize speed (debug 0)))
-  (if (< x 0) x (foo (1- x))))
-
-SBCL generates a full call of FOO (but CMUCL does not).
-
-Partial explanation: CMUCL does generate a full (tail) call to FOO if
-*BLOCK-COMPILE* is NIL.  Maybe this is because in that case CMUCL doesn't 
-generate a temporary(?) function in its IR1-TRANSLATOR for %DEFUN?
---------------------------------------------------------------------------------
 #8
 (defun foo (d)
   (declare (optimize (speed 3) (safety 0) (debug 0)))
   (declare (type (double-float 0d0 1d0) d))
   (loop for i fixnum from 1 to 5
-     for x1 double-float = (sin d) ;;; !!!
-     do (loop for j fixnum from 1 to 4
-             sum x1 double-float)))
+        for x1 double-float = (sin d) ;;; !!!
+        do (loop for j fixnum from 1 to 4
+                 sum x1 double-float)))
 
 Without the marked declaration Python will use boxed representation for X1.
 
index d2a4c34..dca1fdd 100644 (file)
 
 (defun sb!kernel:%ldb (size posn integer)
   (ldb (byte size posn) integer))
+
+(defun sb!kernel:%dpb (newbyte size posn integer)
+  (dpb newbyte (byte size posn) integer))
+
+(defun sb!kernel:%with-array-data (array start end)
+  (assert (typep array '(simple-array * (*))))
+  (values array start end 0))
index 93aeb42..1c2296b 100644 (file)
                          (derive-node-type ref (make-single-value-type type))))))
            t))))))
 
+;;; FIXME: This is quite similar to ASSERT-NEW-DEFINITION.
 (defun assert-global-function-definition-type (name fun)
   (declare (type functional fun))
   (let ((type (info :function :type name))
         (where (info :function :where-from name)))
     (when (eq where :declared)
       (setf (leaf-type fun) type)
-      (assert-definition-type fun type
-                              :unwinnage-fun #'compiler-notify
-                              :where "proclamation"))))
+      (assert-definition-type
+       fun type
+       :unwinnage-fun #'compiler-notify
+       :where "proclamation"
+       :really-assert (not (awhen (info :function :info name)
+                             (ir1-attributep (fun-info-attributes it)
+                                             explicit-check)))))))
 \f
 ;;;; FIXME: Move to some other file.
 (defun check-catch-tag-type (tag)
index cc6cd91..3215e85 100644 (file)
 (defknown scale-float (float float-exponent) float
   (movable foldable unsafely-flushable explicit-check))
 (defknown float-radix (float) float-radix
-  (movable foldable flushable explicit-check))
+  (movable foldable flushable))
 (defknown float-sign (float &optional float) float
   (movable foldable flushable explicit-check))
 (defknown (float-digits float-precision) (float) float-digits
index d55bdeb..b7d218e 100644 (file)
     ((named-lambda)
      (let ((name (cadr thing)))
        (if (legal-fun-name-p name)
-          (let ((res (apply #'ir1-convert-lambda `(lambda ,@(cddr thing))
+          (let ((defined-fun-res (get-defined-fun name))
+                 (res (apply #'ir1-convert-lambda `(lambda ,@(cddr thing))
                             :source-name name
                             :debug-name nil
                             args)))
             (assert-global-function-definition-type name res)
+             (setf (defined-fun-functional defined-fun-res)
+                   res)
+             (unless (eq (defined-fun-inlinep defined-fun-res) :notinline)
+               (substitute-leaf res defined-fun-res))
             res)
           (apply #'ir1-convert-lambda `(lambda ,@(cddr thing))
                  :debug-name name args))))
index 3ee9825..d03560a 100644 (file)
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.2.37"
+"0.8.2.38"