Innie? Outie?
Take the first debug-fun from the fun-map vector in debug-info
instead of looking for one with a matching name, which may not
exist. We only want it for the top-level form number anyway
compiler/debug-dump.lisp; write the tlf number at all debug
quality levels. 0 would take up just as much space as n does
anyway
;;; 5) would be nice to have some interface to the compiler that lets us
;;; fake the filename and position, for use with C-M-x
;;; 5) would be nice to have some interface to the compiler that lets us
;;; fake the filename and position, for use with C-M-x
-(declaim (optimize (debug 3)))
+(declaim (optimize (debug 1)))
(defpackage :sb-introspect
(:use "CL")
(defpackage :sb-introspect
(:use "CL")
;; Internal-only, don't call this directly
(defun find-function-definition-source (o)
;; Internal-only, don't call this directly
(defun find-function-definition-source (o)
- (let* ((name (sb-vm::%simple-fun-name o))
- (debug-info
(sb-kernel:%code-debug-info
(sb-kernel:fun-code-header(sb-kernel::%closure-fun o))))
(debug-source
(car (sb-c::compiled-debug-info-source debug-info)))
(sb-kernel:%code-debug-info
(sb-kernel:fun-code-header(sb-kernel::%closure-fun o))))
(debug-source
(car (sb-c::compiled-debug-info-source debug-info)))
- (debug-fun
- (loop for debug-fun
- across (sb-c::compiled-debug-info-fun-map debug-info)
- when (and (sb-c::debug-fun-p debug-fun)
- (eql (sb-c::compiled-debug-fun-name debug-fun) name))
- return debug-fun))
+ (debug-fun (elt (sb-c::compiled-debug-info-fun-map debug-info) 0))
(tlf (and debug-fun (sb-c::compiled-debug-fun-tlf-number debug-fun))))
(tlf (and debug-fun (sb-c::compiled-debug-fun-tlf-number debug-fun))))
- ;; FIXME why only the first debug-source? can there be >1?
+ ;; HAZARDOUS ASSUMPTION: in CMUCL it's possible to get >1 debug-source
+ ;; for a debug-info (one per file). In SBCL the function that builds
+ ;; debug-sources always produces singleton lists
(sb-int:aver (not (cdr (sb-c::compiled-debug-info-source debug-info))))
(make-definition-source
:pathname
(sb-int:aver (not (cdr (sb-c::compiled-debug-info-source debug-info))))
(make-definition-source
:pathname
(setf (compiled-debug-fun-arguments dfun)
(compute-args fun var-locs))))
(setf (compiled-debug-fun-arguments dfun)
(compute-args fun var-locs))))
(multiple-value-bind (blocks tlf-num) (compute-debug-blocks fun var-locs)
(setf (compiled-debug-fun-tlf-number dfun) tlf-num)
(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-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)
(if (xep-p fun)
(setf (compiled-debug-fun-returns dfun) :standard)
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)