- ((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)))
-
- (if (external-entry-point-p fun)
- (setf (compiled-debug-fun-returns dfun) :standard)
- (let ((info (tail-set-info (lambda-tail-set fun))))
- (when info
- (cond ((eq (return-info-kind info) :unknown)
- (setf (compiled-debug-fun-returns dfun)
- :standard))
- ((/= level 0)
- (setf (compiled-debug-fun-returns dfun)
- (compute-debug-returns fun)))))))
+ ((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 (>= 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))
+ (setf (compiled-debug-fun-tlf-number dfun) (find-tlf-number fun)))
+
+ (if (xep-p fun)
+ (setf (compiled-debug-fun-returns dfun) :standard)
+ (let ((info (tail-set-info (lambda-tail-set fun))))
+ (when info
+ (cond ((eq (return-info-kind info) :unknown)
+ (setf (compiled-debug-fun-returns dfun)
+ :standard))
+ ((/= level 0)
+ (setf (compiled-debug-fun-returns dfun)
+ (compute-debug-returns fun)))))))