- (actual-level (policy (lambda-bind fun) debug))
- (level (if #!+sb-dyncount *collect-dynamic-statistics*
- #!-sb-dyncount nil
- (max actual-level 2)
- actual-level)))
- (cond ((zerop level))
- ((and (<= level 1)
- (let ((od (lambda-optional-dispatch fun)))
- (or (not od)
- (not (eq (optional-dispatch-main-entry od) fun)))))
- (setf (compiled-debug-fun-variables dfun)
- (compute-minimal-variables fun))
- (setf (compiled-debug-fun-arguments dfun) :minimal))
- (t
- (setf (compiled-debug-fun-variables dfun)
- (compute-variables fun level var-locs))
- (setf (compiled-debug-fun-arguments dfun)
- (compute-arguments fun var-locs))))
-
- (when (>= level 2)
- (multiple-value-bind (blocks tlf-num) (compute-debug-blocks fun var-locs)
- (setf (compiled-debug-fun-tlf-number dfun) tlf-num)
- (setf (compiled-debug-fun-blocks dfun) blocks)))
+ (actual-level (policy (lambda-bind fun) compute-debug-fun))
+ (level (if #!+sb-dyncount *collect-dynamic-statistics*
+ #!-sb-dyncount nil
+ (max actual-level 2)
+ actual-level))
+ (toplevel-p (eq :toplevel (compiled-debug-fun-kind dfun))))
+ (cond ((or (zerop level) toplevel-p))
+ ((and (<= level 1)
+ (let ((od (lambda-optional-dispatch fun)))
+ (or (not od)
+ (not (eq (optional-dispatch-main-entry od) fun)))))
+ (setf (compiled-debug-fun-vars dfun)
+ (compute-minimal-vars fun))
+ (setf (compiled-debug-fun-arguments dfun) :minimal))
+ (t
+ (setf (compiled-debug-fun-vars dfun)
+ (compute-vars fun level var-locs))
+ (setf (compiled-debug-fun-arguments dfun)
+ (compute-args fun var-locs))))
+
+ (if (and (>= level 2) (not toplevel-p))
+ (multiple-value-bind (blocks tlf-num)
+ (compute-debug-blocks fun var-locs)
+ (setf (compiled-debug-fun-tlf-number dfun) tlf-num)
+ (setf (compiled-debug-fun-blocks dfun) blocks))
+ (setf (compiled-debug-fun-tlf-number dfun) (find-tlf-number fun)))