X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fir1tran-lambda.lisp;h=d55bdebd740730b9468e3da4c4f6db068d710ad3;hb=506253505641855dc8bb87033f7af894904f848b;hp=8ed628368b4d754dac2a47b3c48479af881c77fd;hpb=ff57884e206ac28660af6af34315bc9b81697f57;p=sbcl.git

diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp
index 8ed6283..d55bdeb 100644
--- a/src/compiler/ir1tran-lambda.lisp
+++ b/src/compiler/ir1tran-lambda.lisp
@@ -285,13 +285,11 @@
 
   (let* ((bind (make-bind))
 	 (lambda (make-lambda :vars vars
-			      :bind bind
-			      :%source-name source-name
-			      :%debug-name debug-name))
+                  :bind bind
+                  :%source-name source-name
+                  :%debug-name debug-name))
 	 (result (or result (make-continuation))))
 
-    (continuation-starts-block result)
-
     ;; just to check: This function should fail internal assertions if
     ;; we didn't set up a valid debug name above.
     ;;
@@ -302,7 +300,7 @@
 
     (setf (lambda-home lambda) lambda)
     (collect ((svars)
-	      (new-venv nil cons))
+             (new-venv nil cons))
 
       (dolist (var vars)
 	;; As far as I can see, LAMBDA-VAR-HOME should never have
@@ -324,27 +322,28 @@
 	(setf (bind-lambda bind) lambda)
 	(setf (node-lexenv bind) *lexenv*)
 
-	(let ((cont1 (make-continuation))
-	      (cont2 (make-continuation)))
-	  (continuation-starts-block cont1)
-	  (link-node-to-previous-continuation bind cont1)
-	  (use-continuation bind cont2)
-	  (ir1-convert-special-bindings cont2 result body
-					aux-vars aux-vals (svars)))
-
-	(let ((block (continuation-block result)))
-	  (when block
-	    (let ((return (make-return :result result :lambda lambda))
-		  (tail-set (make-tail-set :funs (list lambda)))
-		  (dummy (make-continuation)))
-	      (setf (lambda-tail-set lambda) tail-set)
-	      (setf (lambda-return lambda) return)
-	      (setf (continuation-dest result) return)
-              (flush-continuation-externally-checkable-type result)
-	      (setf (block-last block) return)
-	      (link-node-to-previous-continuation return result)
-	      (use-continuation return dummy))
-	    (link-blocks block (component-tail *current-component*))))))
+	(let ((block (continuation-starts-block result)))
+	  (let ((return (make-return :result result :lambda lambda))
+                (tail-set (make-tail-set :funs (list lambda)))
+                (dummy (make-continuation)))
+            (setf (lambda-tail-set lambda) tail-set)
+            (setf (lambda-return lambda) return)
+            (setf (continuation-dest result) return)
+            (flush-continuation-externally-checkable-type result)
+            (setf (block-last block) return)
+            (link-node-to-previous-continuation return result)
+            (use-continuation return dummy))
+          (link-blocks block (component-tail *current-component*)))
+
+        (with-component-last-block (*current-component*
+                                    (continuation-block result))
+          (let ((cont1 (make-continuation))
+                (cont2 (make-continuation)))
+            (continuation-starts-block cont1)
+            (link-node-to-previous-continuation bind cont1)
+            (use-continuation bind cont2)
+            (ir1-convert-special-bindings cont2 result body
+                                          aux-vars aux-vals (svars))))))
 
     (link-blocks (component-head *current-component*) (node-block bind))
     (push lambda (component-new-functionals *current-component*))