0.8.1.3:

        > 13:17:03 <Xhosa> dan`b how does sbcl compile closures?
        Usually good enough :-(

        * Fixed bugcase 258: deny inline-expanding when expansion
          references a deleted or let-converted function.

diff --git a/BUGS b/BUGS
index 97a6721..a4ed57f 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -1039,19 +1039,7 @@ WORKAROUND:
   callees.)
 
 258:
-  Compiler fails on
-
-    (defun u-b-sra (ad0)
-      (declare (special *foo* *bar*))
-      (declare (optimize (safety 3) (speed 2) (space 1) (debug 1)))
-      (labels ((c.frob (x)
-                 (random x))
-               (ad.frob (ad)
-                 (mapcar #'c.frob ad)))
-        (declare (inline c.frob ad.frob))
-        (list (the list ad0)
-              (funcall (if (listp ad0) #'ad.frob #'print) ad0)
-              (funcall (if (listp ad0) #'ad.frob #'print) (reverse ad0)))))
+  (fixed in 0.8.1.3)
 
 DEFUNCT CATEGORIES OF BUGS
   IR1-#:

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 3242c40..71ec219 100644 (file)
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -557,6 +557,8 @@
 ;;; functional instead.
 (defun reference-leaf (start cont leaf)
   (declare (type continuation start cont) (type leaf leaf))
+  (when (functional-p leaf)
+    (assure-functional-live-p leaf))
   (let* ((type (lexenv-find leaf type-restrictions))
          (leaf (or (and (defined-fun-p leaf)
                         (not (eq (defined-fun-inlinep leaf)
@@ -848,30 +850,7 @@
 ;;; are converting inline expansions for local functions during
 ;;; optimization.
 (defun ir1-convert-local-combination (start cont form functional)
-
-  ;; The test here is for "when LET converted", as a translation of
-  ;; the old CMU CL comments into code. Unfortunately, the old CMU CL
-  ;; comments aren't specific enough to tell whether the correct
-  ;; translation is FUNCTIONAL-SOMEWHAT-LETLIKE-P or
-  ;; FUNCTIONAL-LETLIKE-P or what. The old CMU CL code assumed that
-  ;; any non-null FUNCTIONAL-KIND meant that the function "had been
-  ;; LET converted", which might even be right, but seems fragile, so
-  ;; we try to be pickier.
-  (when (or
-        ;; looks LET-converted
-        (functional-somewhat-letlike-p functional)
-        ;; It's possible for a LET-converted function to end up
-        ;; deleted later. In that case, for the purposes of this
-        ;; analysis, it is LET-converted: LET-converted functionals
-        ;; are too badly trashed to expand them inline, and deleted
-        ;; LET-converted functionals are even worse.
-        (eql (functional-kind functional) :deleted))
-    (throw 'locall-already-let-converted functional))
-  ;; Any other non-NIL KIND value is a case we haven't found a
-  ;; justification for, and at least some such values (e.g. :EXTERNAL
-  ;; and :TOPLEVEL) seem obviously wrong.
-  (aver (null (functional-kind functional)))
-
+  (assure-functional-live-p functional)
   (ir1-convert-combination start
                           cont
                           form

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 74f5a20..90de784 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -1602,6 +1602,20 @@
                              *inline-expansion-limit*))
           nil)
          (t t))))
+
+;;; Make sure that FUNCTIONAL is not let-converted or deleted.
+(defun assure-functional-live-p (functional)
+  (declare (type functional functional))
+  (when (and (or
+              ;; looks LET-converted
+              (functional-somewhat-letlike-p functional)
+              ;; It's possible for a LET-converted function to end up
+              ;; deleted later. In that case, for the purposes of this
+              ;; analysis, it is LET-converted: LET-converted functionals
+              ;; are too badly trashed to expand them inline, and deleted
+              ;; LET-converted functionals are even worse.
+              (eql (functional-kind functional) :deleted)))
+    (throw 'locall-already-let-converted functional)))
 \f
 ;;;; careful call
 

diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp
index d9905d0..d5e660e 100644 (file)
--- a/tests/compiler.impure-cload.lisp
+++ b/tests/compiler.impure-cload.lisp
@@ -117,5 +117,27 @@
                '((1 2 3) (7 14 21) (21 14 7))))
 
 (delete-package :bug148)
+
+;;; bug 258
+(defpackage :bug258 (:use :cl))
+(in-package :bug258)
+
+(defun u-b-sra (ad0)
+  (declare (special *foo* *bar*))
+  (declare (optimize (safety 3) (speed 2) (space 1) (debug 1)))
+  (labels ((c.frob (x)
+             (1- x))
+           (ad.frob (ad)
+             (mapcar #'c.frob ad)))
+    (declare (inline c.frob ad.frob))
+    (list (the list ad0)
+          (funcall (if (listp ad0) #'ad.frob #'print) ad0)
+          (funcall (if (listp ad0) #'ad.frob #'print) (reverse ad0)))))
+
+(assert (equal (u-b-sra '(4 9 7))
+               '((4 9 7) (3 8 6) (6 8 3))))
+
+(delete-package :bug258)
+
 \f
 (sb-ext:quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index a4b2a36..3f70143 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".)
-"0.8.1.2"
+"0.8.1.3"