[Sbcl-commits] CVS: sbcl/src/compiler ctype.lisp,1.25,1.26 fndb.lisp,1.79,1.80 ir1tran-lambda.lisp,1.6,1.7

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

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

Modified Files:
	ctype.lisp fndb.lisp ir1tran-lambda.lisp 
Log Message:
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.


Index: ctype.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ctype.lisp,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -d -r1.25 -r1.26
--- ctype.lisp	16 Jun 2003 14:18:17 -0000	1.25
+++ ctype.lisp	17 Aug 2003 17:17:07 -0000	1.26
@@ -759,15 +759,20 @@
                          (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)))))))
 
 ;;;; FIXME: Move to some other file.
 (defun check-catch-tag-type (tag)

Index: fndb.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/fndb.lisp,v
retrieving revision 1.79
retrieving revision 1.80
diff -u -d -r1.79 -r1.80
--- fndb.lisp	15 Aug 2003 08:21:07 -0000	1.79
+++ fndb.lisp	17 Aug 2003 17:17:07 -0000	1.80
@@ -344,7 +344,7 @@
 (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: ir1tran-lambda.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1tran-lambda.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- ir1tran-lambda.lisp	24 Jun 2003 04:36:38 -0000	1.6
+++ ir1tran-lambda.lisp	17 Aug 2003 17:17:07 -0000	1.7
@@ -910,11 +910,16 @@
     ((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))))