(declare (type clambda fun))
(dolist (var (lambda-vars fun))
(when (leaf-refs var)
- (let* ((type (if (lambda-var-indirect var)
- *backend-t-primitive-type*
+ (let* (ptype-info
+ (type (if (lambda-var-indirect var)
+ (if (lambda-var-explicit-value-cell var)
+ *backend-t-primitive-type*
+ (or (first
+ (setf ptype-info
+ (primitive-type-indirect-cell-type
+ (primitive-type (leaf-type var)))))
+ *backend-t-primitive-type*))
(primitive-type (leaf-type var))))
- (temp (make-normal-tn type))
+ (res (make-normal-tn type))
(node (lambda-bind fun))
- (res (if (or (and let-p (policy node (< debug 3)))
- (policy node (zerop debug))
- (policy node (= speed 3)))
- temp
- (physenv-debug-live-tn temp (lambda-physenv fun)))))
+ (debug-variable-p (not (or (and let-p (policy node (< debug 3)))
+ (policy node (zerop debug))
+ (policy node (= speed 3))))))
+ (cond
+ ((and (lambda-var-indirect var)
+ (not (lambda-var-explicit-value-cell var)))
+ ;; Force closed-over indirect LAMBDA-VARs without explicit
+ ;; VALUE-CELLs to the stack, and make sure that they are
+ ;; live over the dynamic contour of the physenv.
+ (setf (tn-sc res) (if ptype-info
+ (second ptype-info)
+ (sc-or-lose 'sb!vm::control-stack)))
+ (physenv-live-tn res (lambda-physenv fun)))
+
+ (debug-variable-p
+ (physenv-debug-live-tn res (lambda-physenv fun))))
+
(setf (tn-leaf res) var)
(setf (leaf-info var) res))))
(values))
;;; -- It appears to be more efficient to use the standard convention,
;;; since there are no non-TR local calls that could benefit from
;;; a non-standard convention.
+;;; -- We're compiling with RETURN-FROM-FRAME instrumentation, which
+;;; only works (on x86 and x86-64) for the standard convention.
(defun use-standard-returns (tails)
(declare (type tail-set tails))
(let ((funs (tail-set-funs tails)))
(or (and (find-if #'xep-p funs)
(find-if #'has-full-call-use funs))
+ (some (lambda (fun) (policy fun (>= insert-debug-catch 2))) funs)
(block punt
(dolist (fun funs t)
(dolist (ref (leaf-refs fun))