:form (let ((direct-file-info (source-info-file-info info)))
(when (eq :lisp (file-info-name direct-file-info))
- (let ((form (elt (file-info-forms direct-file-info) 0)))
- ;; The form COMPILE saves may include gunk
- ;; from %SIMPLE-EVAL -- this gets rid of that.
- (sb!impl::eval-lambda-source-lambda form))))
+ (elt (file-info-forms direct-file-info) 0)))
:function function)))
;;; Given an arbitrary sequence, coerce it to an unsigned vector if
(let* ((name (leaf-debug-name var))
(save-tn (and tn (tn-save-tn tn)))
(kind (and tn (tn-kind tn)))
- (flags 0))
+ (flags 0)
+ (info (lambda-var-arg-info var)))
(declare (type index flags))
(when minimal
(setq flags (logior flags compiled-debug-var-minimal-p))
(setq flags (logior flags compiled-debug-var-save-loc-p)))
(unless (or (zerop id) minimal)
(setq flags (logior flags compiled-debug-var-id-p)))
+ (when info
+ (case (arg-info-kind info)
+ (:more-context
+ (setq flags (logior flags compiled-debug-var-more-context-p)))
+ (:more-count
+ (setq flags (logior flags compiled-debug-var-more-count-p)))))
(vector-push-extend flags buffer)
(unless minimal
(vector-push-extend name buffer)
(if (and od (eq (optional-dispatch-main-entry od) fun))
(let ((actual-vars (lambda-vars fun))
(saw-optional nil))
- (dolist (arg (optional-dispatch-arglist od))
- (let ((info (lambda-var-arg-info arg))
- (actual (pop actual-vars)))
- (cond (info
- (case (arg-info-kind info)
- (:keyword
- (res (arg-info-key info)))
- (:rest
- (res 'rest-arg))
- (:more-context
- (res 'more-arg))
- (:optional
- (unless saw-optional
- (res 'optional-args)
- (setq saw-optional t))))
- (res (debug-location-for actual var-locs))
- (when (arg-info-supplied-p info)
- (res 'supplied-p)
- (res (debug-location-for (pop actual-vars) var-locs))))
- (t
- (res (debug-location-for actual var-locs)))))))
+ (labels ((one-arg (arg)
+ (let ((info (lambda-var-arg-info arg))
+ (actual (pop actual-vars)))
+ (cond (info
+ (case (arg-info-kind info)
+ (:keyword
+ (res (arg-info-key info)))
+ (:rest
+ (let ((more (arg-info-default info)))
+ (cond ((and (consp more) (third more))
+ (one-arg (first (arg-info-default info)))
+ (one-arg (second (arg-info-default info)))
+ (return-from one-arg))
+ (more
+ (setf (arg-info-default info) t)))
+ (res 'rest-arg)))
+ (:more-context
+ (res 'more-arg))
+ (:optional
+ (unless saw-optional
+ (res 'optional-args)
+ (setq saw-optional t))))
+ (res (debug-location-for actual var-locs))
+ (when (arg-info-supplied-p info)
+ (res 'supplied-p)
+ (res (debug-location-for (pop actual-vars) var-locs))))
+ (t
+ (res (debug-location-for actual var-locs)))))))
+ (dolist (arg (optional-dispatch-arglist od))
+ (one-arg arg))))
(dolist (var (lambda-vars fun))
(res (debug-location-for var var-locs)))))