Commit 85c1cf85 authored by Daniel Barlow's avatar Daniel Barlow
Browse files

0.8.4.26

	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
parent 99a5e197
Loading
Loading
Loading
Loading
+6 −10
Original line number Diff line number Diff line
@@ -24,7 +24,7 @@
;;; 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")
@@ -80,20 +80,16 @@ Returns a DEFINITION-SOURCE object"))

;; Internal-only, don't call this directly
(defun find-function-definition-source (o)
  (let* ((name (sb-vm::%simple-fun-name o))
	 (debug-info
  (let* ((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))))
    ;; 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
+3 −2
Original line number Diff line number Diff line
@@ -524,10 +524,11 @@
	   (setf (compiled-debug-fun-arguments dfun)
		 (compute-args fun var-locs))))

    (when (>= level 2)
    (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-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)
+1 −1
Original line number Diff line number Diff line
@@ -17,4 +17,4 @@
;;; 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".)
"0.8.4.25"
"0.8.4.26"