(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))))
\f
;;;; continuation use hacking
(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))))
;;; 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))
(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))))
\f
;;; Return a new LEXENV just like DEFAULT except for the specified
;;; slot values. Values for the alist slots are NCONCed to the
(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)
(push ref (leaf-refs leaf))
(delete-ref ref)
(setf (ref-leaf ref) leaf)
+ (setf (leaf-ever-used leaf) t)
(let ((ltype (leaf-type leaf)))
(if (fun-type-p ltype)
(setf (node-derived-type ref) ltype)
(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"))