X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1util.lisp;h=946c32b4ae9d8ed20338524525f3c82f0378f49d;hb=b0642df835dc2fca3e4cf47aff978ecdc88799d5;hp=4988282cc8a56abd23719c8f214c7d1da728822f;hpb=25e76ec2b1083ac6a4bba42af7ad7b5a8239f2b8;p=sbcl.git

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 4988282..946c32b 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -37,17 +37,19 @@
 	   (type (or cleanup null) cleanup))
   (setf (component-reanalyze (block-component block1)) t)
   (with-ir1-environment-from-node node
-    (let* ((start (make-continuation))
-	   (block (continuation-starts-block start))
-	   (cont (make-continuation))
-	   (*lexenv* (if cleanup
-			 (make-lexenv :cleanup cleanup)
-			 *lexenv*)))
-      (change-block-successor block1 block2 block)
-      (link-blocks block block2)
-      (ir1-convert start cont form)
-      (setf (block-last block) (continuation-use cont))
-      block)))
+    (with-component-last-block (*current-component*
+                                (block-next (component-head *current-component*)))
+      (let* ((start (make-continuation))
+             (block (continuation-starts-block start))
+             (cont (make-continuation))
+             (*lexenv* (if cleanup
+                           (make-lexenv :cleanup cleanup)
+                           *lexenv*)))
+        (change-block-successor block1 block2 block)
+        (link-blocks block block2)
+        (ir1-convert start cont form)
+        (setf (block-last block) (continuation-use cont))
+        block))))
 
 ;;;; continuation use hacking
 
@@ -190,16 +192,16 @@
   (ecase (continuation-kind cont)
     (:unused
      (aver (not (continuation-block cont)))
-     (let* ((head (component-head *current-component*))
-	    (next (block-next head))
-	    (new-block (make-block cont)))
+     (let* ((next (component-last-block *current-component*))
+            (prev (block-prev next))
+            (new-block (make-block cont)))
        (setf (block-next new-block) next
-	     (block-prev new-block) head
-	     (block-prev next) new-block
-	     (block-next head) new-block
-	     (continuation-block cont) new-block
-	     (continuation-use cont) nil
-	     (continuation-kind cont) :block-start)
+             (block-prev new-block) prev
+             (block-prev next) new-block
+             (block-next prev) new-block
+             (continuation-block cont) new-block
+             (continuation-use cont) nil
+             (continuation-kind cont) :block-start)
        new-block))
     (:block-start
      (continuation-block cont))))
@@ -210,7 +212,7 @@
 ;;;    CONT of LAST in its block, then we make it the start of a new
 ;;;    deleted block.
 ;;; -- If the continuation is :INSIDE-BLOCK inside a block, then we
-;;;    split the block using Node-Ends-Block, which makes the
+;;;    split the block using NODE-ENDS-BLOCK, which makes the
 ;;;    continuation be a :BLOCK-START.
 (defun ensure-block-start (cont)
   (declare (type continuation cont))
@@ -382,6 +384,11 @@
 (defun continuation-home-lambda (cont)
   (the clambda
     (continuation-home-lambda-or-null cont)))
+
+#!-sb-fluid (declaim (inline continuation-single-value-p))
+(defun continuation-single-value-p (cont)
+  (not (typep (continuation-dest cont)
+              '(or creturn exit mv-combination))))
 
 ;;; Return a new LEXENV just like DEFAULT except for the specified
 ;;; slot values. Values for the alist slots are NCONCed to the
@@ -554,7 +561,7 @@
 (defun make-empty-component ()
   (let* ((head (make-block-key :start nil :component nil))
 	 (tail (make-block-key :start nil :component nil))
-	 (res (make-component :head head :tail tail)))
+	 (res (make-component head tail)))
     (setf (block-flag head) t)
     (setf (block-flag tail) t)
     (setf (block-component head) res)
@@ -1506,8 +1513,3 @@
 
   (let ((action (event-info-action info)))
     (when action (funcall action node))))
-
-;;; It should be in locall.lisp, but is used before in ir1opt.lisp.
-(define-optimization-quality verify-arg-count
-    (if (zerop safety) 0 3)
-  ("no" "maybe" "yes" "yes"))