0.8.16.41:

        * Partial workaround for the bug 262: inline expansion of a
          local function is canceled by conversion of RETURN-FROM,
          referring a deleted CTRAN. (Fixes bug reported by Peter
          Denno on sbcl-devel.)

diff --git a/BUGS b/BUGS
index 2ee474b..b9e6f93 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -861,26 +861,12 @@ WORKAROUND:
   b. The same for CSUBTYPEP.
 
 262: "yet another bug in inline expansion of local functions"
-  Compiler fails on
-
-    (defun foo (x y)
-      (declare (integer x y))
-      (+ (block nil
-            (flet ((xyz (u)
-                     (declare (integer u))
-                     (if (> (1+ (the unsigned-byte u)) 0)
-                         (+ 1 u)
-                         (return (+ 38 (cos (/ u 78)))))))
-              (declare (inline xyz))
-              (return-from foo
-                (* (funcall (eval #'xyz) x)
-                   (if (> x 30)
-                       (funcall (if (> x 5) #'xyz #'identity)
-                                (+ x 13))
-                       38)))))
-         (sin (* x y))))
-
-  Urgh... It's time to write IR1-copier.
+  During inline expansion of a local function Python can try to
+  reference optimized away objects (functions, variables, CTRANs from
+  tags and blocks), which later may lead to problems. Some of the
+  cases are worked around by forbidding expansion in such cases, but
+  the better way would be to reimplement inline expansion by copying
+  IR1 structures.
 
 266:
   David Lichteblau provided (sbcl-devel 2003-06-01) a patch to fix

diff --git a/NEWS b/NEWS
index 86daf61..45c3c84 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -48,6 +48,10 @@ changes in sbcl-0.8.17 relative to sbcl-0.8.16:
     specialized array element types.
   * FORMAT compile-time argument count checking has been enhanced.
     (report from Bruno Haible for CMUCL)
+  * a partial workaround for the bug 262: the compiler does not try to
+    inline-expand a local function doing RETURN-FROM from a deleted
+    BLOCK. (thanks to Peter Denno for the bug report and to David
+    Wragg for the simple test case)
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** RENAME-PACKAGE allows all package designators as new package
        names.

diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp
index 6fdb4ac..594999d 100644 (file)
--- a/src/compiler/ir1-translators.lisp
+++ b/src/compiler/ir1-translators.lisp
@@ -109,11 +109,14 @@
   (ctran-starts-block next)
   (let* ((found (or (lexenv-find name blocks)
                    (compiler-error "return for unknown block: ~S" name)))
+         (exit-ctran (second found))
         (value-ctran (make-ctran))
          (value-lvar (make-lvar))
         (entry (first found))
         (exit (make-exit :entry entry
                          :value value-lvar)))
+    (when (ctran-deleted-p exit-ctran)
+      (throw 'locall-already-let-converted exit-ctran))
     (push exit (entry-exits entry))
     (setf (lvar-dest value-lvar) exit)
     (ir1-convert start value-ctran value-lvar value)
@@ -121,7 +124,7 @@
     (let ((home-lambda (ctran-home-lambda-or-null start)))
       (when home-lambda
        (push entry (lambda-calls-or-closes home-lambda))))
-    (use-continuation exit (second found) (third found))))
+    (use-continuation exit exit-ctran (third found))))
 
 ;;; Return a list of the segments of a TAGBODY. Each segment looks
 ;;; like (<tag> <form>* (go <next tag>)). That is, we break up the

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 5126c04..a5e8c16 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -1330,15 +1330,21 @@
               (setf (node-prev node) nil)
               t)))))))
 
+;;; Return true if CTRAN has been deleted, false if it is still a valid
+;;; part of IR1.
+(defun ctran-deleted-p (ctran)
+  (declare (type ctran ctran))
+  (let ((block (ctran-block ctran)))
+    (or (not (block-component block))
+        (block-delete-p block))))
+
 ;;; Return true if NODE has been deleted, false if it is still a valid
 ;;; part of IR1.
 (defun node-deleted (node)
   (declare (type node node))
   (let ((prev (node-prev node)))
-    (not (and prev
-             (let ((block (ctran-block prev)))
-               (and (block-component block)
-                    (not (block-delete-p block))))))))
+    (or (not prev)
+        (ctran-deleted-p prev))))
 
 ;;; Delete all the blocks and functions in COMPONENT. We scan first
 ;;; marking the blocks as DELETE-P to prevent weird stuff from being

diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index f1c7feb..18d051b 100644 (file)
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -378,7 +378,7 @@
           (inline-expansion-ok call))
       (let* ((end (component-last-block (node-component call)))
              (pred (block-prev end)))
-        (multiple-value-bind (losing-local-functional converted-lambda)
+        (multiple-value-bind (losing-local-object converted-lambda)
             (catch 'locall-already-let-converted
               (with-ir1-environment-from-node call
                 (let ((*lexenv* (functional-lexenv original-functional)))
@@ -389,12 +389,18 @@
                                         "local inline "
                                         (leaf-debug-name
                                          original-functional)))))))
-          (cond (losing-local-functional
-                 (let ((*compiler-error-context* call))
-                   (compiler-notify "couldn't inline expand because expansion ~
-                                     calls this LET-converted local function:~
-                                     ~%  ~S"
-                                    (leaf-debug-name losing-local-functional)))
+          (cond (losing-local-object
+                 (if (functional-p losing-local-object)
+                     (let ((*compiler-error-context* call))
+                       (compiler-notify "couldn't inline expand because expansion ~
+                                         calls this LET-converted local function:~
+                                         ~%  ~S"
+                                        (leaf-debug-name losing-local-object)))
+                     (let ((*compiler-error-context* call))
+                       (compiler-notify "implementation limitation: couldn't inline ~
+                                         expand because expansion refers to ~
+                                         the optimized away object ~S."
+                                        losing-local-object)))
                  (loop for block = (block-next pred) then (block-next block)
                        until (eq block end)
                        do (setf (block-delete-p block) t))

diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp
index bdd3550..9a2d2f6 100644 (file)
--- a/tests/compiler.impure-cload.lisp
+++ b/tests/compiler.impure-cload.lisp
@@ -382,5 +382,14 @@
    (defvar caar))
 (defun srctran-lisp1-2 (caar) (funcall (sb-ext:truly-the function caar) 1))
 (assert (eql (funcall (eval #'srctran-lisp1-2) #'identity) 1))
+
+;;; partial bug 262: reference of deleted CTRAN (in RETURN-FROM)
+;;; during inline expansion. Bug report by Peter Denno, simplified
+;;; test case by David Wragg.
+(defun bug262-return-from (x &aux (y nil))
+  (labels ((foo-a (z) (return-from bug262-return-from z))
+           (foo-b (z) (foo-a z)))
+    (declare (inline foo-a))
+    (foo-a x)))
 \f
 (sb-ext:quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index dd72d77..e78f60f 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.16.40"
+"0.8.16.41"