From: Stas Boukarev <stassats@gmail.com>
Date: Sun, 19 May 2013 16:37:27 +0000 (+0400)
Subject: Make ir1-convert-hairy-lambda safe for non-local exits.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=ae026fe85fef157ff42d6655e5f5e4eef74709f1;p=sbcl.git

Make ir1-convert-hairy-lambda safe for non-local exits.

The function it calls may throw a tag, locall-already-let-converted,
which will leave a partially initialized optional-dispatch structure
in new-functionals of the current component, which may cause problems
down the line.

Fixes lp#1180992.

Also add a test-case for f3a2cd.. "Add a stub for %other-pointer-p.".
---

diff --git a/NEWS b/NEWS
index d9c5615..2b413ca 100644
--- a/NEWS
+++ b/NEWS
@@ -53,6 +53,8 @@ changes relative to sbcl-1.1.7:
     codegen errors: type checks are inserted as necessary. (lp#1177703)
   * bug fix: Unsigned modular arithmetic is correctly converted into signed
     modular arithemtic (mostly to exploit fixnum-width VOPs). (lp#1026634)
+  * bug fix: a combination of inlined local function with &optional and
+    recursion no longer causes undescriptive compiler errors. (lp#1180992)
   * optimization: faster ISQRT on fixnums and small bignums
   * optimization: faster and smaller INTEGER-LENGTH on fixnums on x86-64.
   * optimization: On x86-64, the number of multi-byte NOP instructions used
diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp
index 10e2b08..ce06727 100644
--- a/src/compiler/ir1tran-lambda.lisp
+++ b/src/compiler/ir1tran-lambda.lisp
@@ -911,10 +911,13 @@
                                                ,*current-path*))))
         (min (or (position-if #'lambda-var-arg-info vars) (length vars))))
     (aver-live-component *current-component*)
-    (push res (component-new-functionals *current-component*))
     (ir1-convert-hairy-args res () () () () vars nil body aux-vars aux-vals
                             source-name debug-name nil post-binding-lexenv
                             system-lambda)
+    ;; ir1-convert-hairy-args can throw 'locall-already-let-converted
+    ;; push optional-dispatch into the current component only after it
+    ;; normally returned
+    (push res (component-new-functionals *current-component*))
     (setf (optional-dispatch-min-args res) min)
     (setf (optional-dispatch-max-args res)
           (+ (1- (length (optional-dispatch-entry-points res))) min))
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 6e1d150..7cced51 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -4465,3 +4465,14 @@
                   (let ((hash #xD13CCD13))
                     (setf hash (logand most-positive-word
                                        (ash hash 5)))))))
+
+(with-test (:name (local-&optional-recursive-inline :bug-1180992))
+  (compile nil
+           `(lambda ()
+              (labels ((called (&optional a))
+                       (recursed (&optional b)
+                         (called)
+                         (recursed)))
+                (declare (inline recursed called))
+                (recursed)))))
+
diff --git a/tests/seq.pure.lisp b/tests/seq.pure.lisp
index 78d9b27..ab38ed6 100644
--- a/tests/seq.pure.lisp
+++ b/tests/seq.pure.lisp
@@ -377,3 +377,7 @@
                                          (declare (optimize safety))
                                          (elt args 0))))
                          sb-kernel:index-too-large-error)))
+
+(with-test (:name do-sequence-on-literals)
+  (assert (= (sequence:dosequence (e #(1 2 3)) (return e))
+             1)))