0.8.2.38:

        * 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.

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.
 
   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:
 
 268: "wrong free declaration scope"
   The following code must signal type error:
 

diff --git a/OPTIMIZATIONS b/OPTIMIZATIONS
index 2806884..3b6ebe1 100644 (file)
--- a/OPTIMIZATIONS
+++ b/OPTIMIZATIONS
@@ -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)))
 --------------------------------------------------------------------------------
                 (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
 #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.
 
 
 Without the marked declaration Python will use boxed representation for X1.
 

diff --git a/src/code/cross-misc.lisp b/src/code/cross-misc.lisp
index d2a4c34..dca1fdd 100644 (file)
--- a/src/code/cross-misc.lisp
+++ b/src/code/cross-misc.lisp
@@ -137,3 +137,10 @@
 
 (defun sb!kernel:%ldb (size posn integer)
   (ldb (byte size posn) integer))
 
 (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))

diff --git a/src/compiler/ctype.lisp b/src/compiler/ctype.lisp
index 93aeb42..1c2296b 100644 (file)
--- a/src/compiler/ctype.lisp
+++ b/src/compiler/ctype.lisp
@@ -759,15 +759,20 @@
                          (derive-node-type ref (make-single-value-type type))))))
            t))))))
 
                          (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)
 (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)
 \f
 ;;;; FIXME: Move to some other file.
 (defun check-catch-tag-type (tag)

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index cc6cd91..3215e85 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -344,7 +344,7 @@
 (defknown scale-float (float float-exponent) float
   (movable foldable unsafely-flushable explicit-check))
 (defknown float-radix (float) float-radix
 (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
 (defknown float-sign (float &optional float) float
   (movable foldable flushable explicit-check))
 (defknown (float-digits float-precision) (float) float-digits

diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp
index d55bdeb..b7d218e 100644 (file)
--- a/src/compiler/ir1tran-lambda.lisp
+++ b/src/compiler/ir1tran-lambda.lisp
@@ -910,11 +910,16 @@
     ((named-lambda)
      (let ((name (cadr thing)))
        (if (legal-fun-name-p name)
     ((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)
                             :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))))
             res)
           (apply #'ir1-convert-lambda `(lambda ,@(cddr thing))
                  :debug-name name args))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 3ee9825..d03560a 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -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".)
 ;;; 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"