- (move-continuation-result node block locs cont)))))))
-
-;;; Reset the stack pointer to the start of the specified unknown-values
-;;; continuation (discarding it and all values globs on top of it.)
-(defoptimizer (%pop-values ir2-convert) ((continuation) node block)
- (let ((2cont (continuation-info (continuation-value continuation))))
- (assert (eq (ir2-continuation-kind 2cont) :unknown))
- (vop reset-stack-pointer node block
- (first (ir2-continuation-locs 2cont)))))
-
-;;; Deliver the values TNs to Cont using Move-Continuation-Result.
+ (move-lvar-result node block locs lvar)))))))
+
+;;; Reset the stack pointer to the start of the specified
+;;; unknown-values lvar (discarding it and all values globs on top of
+;;; it.)
+(defoptimizer (%pop-values ir2-convert) ((%lvar) node block)
+ (let* ((lvar (lvar-value %lvar))
+ (2lvar (lvar-info lvar)))
+ (cond ((eq (ir2-lvar-kind 2lvar) :unknown)
+ (vop reset-stack-pointer node block
+ (first (ir2-lvar-locs 2lvar))))
+ ((lvar-dynamic-extent lvar)
+ #!+stack-grows-downward-not-upward
+ (vop reset-stack-pointer node block
+ (ir2-lvar-stack-pointer 2lvar))
+ #!-stack-grows-downward-not-upward
+ (vop %%pop-dx node block
+ (first (ir2-lvar-locs 2lvar))))
+ (t (bug "Trying to pop a not stack-allocated LVAR ~S."
+ lvar)))))
+
+(defoptimizer (%nip-values ir2-convert) ((last-nipped last-preserved
+ &rest moved)
+ node block)
+ (let* ( ;; pointer immediately after the nipped block
+ (after (lvar-value last-nipped))
+ (2after (lvar-info after))
+ ;; pointer to the first nipped word
+ (first (lvar-value last-preserved))
+ (2first (lvar-info first))
+
+ (moved-tns (loop for lvar-ref in moved
+ for lvar = (lvar-value lvar-ref)
+ for 2lvar = (lvar-info lvar)
+ ;when 2lvar
+ collect (first (ir2-lvar-locs 2lvar)))))
+ (aver (or (eq (ir2-lvar-kind 2after) :unknown)
+ (lvar-dynamic-extent after)))
+ (aver (eq (ir2-lvar-kind 2first) :unknown))
+ (when *check-consistency*
+ ;; we cannot move stack-allocated DX objects
+ (dolist (moved-lvar moved)
+ (aver (eq (ir2-lvar-kind (lvar-info (lvar-value moved-lvar)))
+ :unknown))))
+ (flet ((nip-aligned (nipped)
+ (vop* %%nip-values node block
+ (nipped
+ (first (ir2-lvar-locs 2first))
+ (reference-tn-list moved-tns nil))
+ ((reference-tn-list moved-tns t))))
+ #!-stack-grows-downward-not-upward
+ (nip-unaligned (nipped)
+ (vop* %%nip-dx node block
+ (nipped
+ (first (ir2-lvar-locs 2first))
+ (reference-tn-list moved-tns nil))
+ ((reference-tn-list moved-tns t)))))
+ (cond ((eq (ir2-lvar-kind 2after) :unknown)
+ (nip-aligned (first (ir2-lvar-locs 2after))))
+ ((lvar-dynamic-extent after)
+ #!+stack-grows-downward-not-upward
+ (nip-aligned (ir2-lvar-stack-pointer 2after))
+ #!-stack-grows-downward-not-upward
+ (nip-unaligned (ir2-lvar-stack-pointer 2after)))
+ (t
+ (bug "Trying to nip a not stack-allocated LVAR ~S." after))))))
+
+;;; Deliver the values TNs to LVAR using MOVE-LVAR-RESULT.