deleted dead code related to MINIMAL-DEBUG-FUNs..
..find . -name *.lisp | xargs egrep -i 'uncompact-function-map'
..and 'make-uncompacted-debug-fun'
..and '\*uncompacted-function-maps\*'
..and 'debug-fun-minimal-p'
..and 'dump-1-minimal-dfun'
..and 'minimal-debug'
..also s/get-debug-info-function-map/debug-info-function-map/
Then in the spirit of renaming object-of-type-FUNCTION to FUN,
as begun in 0.pre7.52, s/function-map/fun-map/.
;;; debug-info format can represent any function at level 0, and any fixed-arg
;;; function at level 1.
;;;
-;;; In the minimal format, the debug functions and function map are packed into
-;;; a single byte-vector which is placed in the
-;;; COMPILED-DEBUG-INFO-FUNCTION-MAP. Because of this, all functions in a
-;;; component must be representable in minimal format for any function to
-;;; actually be dumped in minimal format. The vector is a sequence of records
-;;; in this format:
+;;; In the minimal format, the debug functions and function map are
+;;; packed into a single byte-vector which is placed in the
+;;; COMPILED-DEBUG-INFO-FUN-MAP. Because of this, all functions in a
+;;; component must be representable in minimal format for any function
+;;; to actually be dumped in minimal format. The vector is a sequence
+;;; of records in this format:
;;; name representation + kind + return convention (single byte)
;;; bit flags (single byte)
;;; setf, nfp, variables
;;; from the previous function's elsewhere code start. (i.e. the
;;; encoding is the same as for code-start-pc.)
-#|
-### For functions with XEPs, name could be represented more simply and
-compactly as some sort of info about with how to find the function-entry that
-this is a function for. Actually, you really hardly need any info. You can
-just chain through the functions in the component until you find the right one.
-Well, I guess you need to at least know which function is an XEP for the real
-function (which would be useful info anyway).
-|#
-
-;;; The following are definitions of bit-fields in the first byte of
-;;; the minimal debug function:
-(defconstant minimal-debug-fun-name-symbol 0)
-(defconstant minimal-debug-fun-name-packaged 1)
-(defconstant minimal-debug-fun-name-uninterned 2)
-(defconstant minimal-debug-fun-name-component 3)
-(defconstant-eqx minimal-debug-fun-name-style-byte (byte 2 0) #'equalp)
-(defconstant-eqx minimal-debug-fun-kind-byte (byte 3 2) #'equalp)
-(defparameter *minimal-debug-fun-kinds*
- #(nil :optional :external :top-level :cleanup))
-(defconstant minimal-debug-fun-returns-standard 0)
-(defconstant minimal-debug-fun-returns-specified 1)
-(defconstant minimal-debug-fun-returns-fixed 2)
-(defconstant-eqx minimal-debug-fun-returns-byte (byte 2 5) #'equalp)
-
-;;; The following are bit-flags in the second byte of the minimal debug
-;;; function:
-;;; * If true, wrap (SETF ...) around the name.
-(defconstant minimal-debug-fun-setf-bit (ash 1 0))
-;;; * If true, there is a NFP.
-(defconstant minimal-debug-fun-nfp-bit (ash 1 1))
-;;; * If true, variables (hence arguments) have been dumped.
-(defconstant minimal-debug-fun-variables-bit (ash 1 2))
+;;; ### For functions with XEPs, name could be represented more simply
+;;; and compactly as some sort of info about with how to find the
+;;; FUNCTION-ENTRY that this is a function for. Actually, you really
+;;; hardly need any info. You can just chain through the functions in
+;;; the component until you find the right one. Well, I guess you need
+;;; to at least know which function is an XEP for the real function
+;;; (which would be useful info anyway).
\f
;;;; debug source
;; always careful to put our code in low memory. Is that how it
;; works? Would this break if we used a more general memory map? --
;; WHN 20000120
- (function-map (required-argument) :type simple-vector :read-only t))
+ (fun-map (required-argument) :type simple-vector :read-only t))
\f
;;;; frame utilities
-;;; This returns a COMPILED-DEBUG-FUN for code and pc. We fetch
-;;; the SB!C::DEBUG-INFO and run down its function-map to get a
-;;; SB!C::COMPILED-DEBUG-FUN from the pc. The result only needs
-;;; to reference the component, for function constants, and the
+;;; This returns a COMPILED-DEBUG-FUN for code and pc. We fetch the
+;;; SB!C::DEBUG-INFO and run down its FUN-MAP to get a
+;;; SB!C::COMPILED-DEBUG-FUN from the pc. The result only needs to
+;;; reference the component, for function constants, and the
;;; SB!C::COMPILED-DEBUG-FUN.
(defun debug-fun-from-pc (component pc)
(let ((info (%code-debug-info component)))
((eq info :bogus-lra)
(make-bogus-debug-fun "function end breakpoint"))
(t
- (let* ((function-map (get-debug-info-function-map info))
- (len (length function-map)))
- (declare (simple-vector function-map))
+ (let* ((fun-map (get-debug-info-fun-map info))
+ (len (length fun-map)))
+ (declare (type simple-vector fun-map))
(if (= len 1)
- (make-compiled-debug-fun (svref function-map 0) component)
+ (make-compiled-debug-fun (svref fun-map 0) component)
(let ((i 1)
(elsewhere-p
(>= pc (sb!c::compiled-debug-fun-elsewhere-pc
- (svref function-map 0)))))
+ (svref fun-map 0)))))
(declare (type sb!int:index i))
(loop
(when (or (= i len)
(< pc (if elsewhere-p
(sb!c::compiled-debug-fun-elsewhere-pc
- (svref function-map (1+ i)))
- (svref function-map i))))
+ (svref fun-map (1+ i)))
+ (svref fun-map i))))
(return (make-compiled-debug-fun
- (svref function-map (1- i))
+ (svref fun-map (1- i))
component)))
(incf i 2)))))))))
(and (sb!c::compiled-debug-fun-p x)
(eq (sb!c::compiled-debug-fun-name x) name)
(eq (sb!c::compiled-debug-fun-kind x) nil)))
- (get-debug-info-function-map
+ (get-debug-info-fun-map
(%code-debug-info component)))))
(if res
(make-compiled-debug-fun res component)
(compiled-debug-fun (compiled-debug-fun-lambda-list debug-fun))
(bogus-debug-fun nil)))
-;;; Note: If this has to compute the lambda list, it caches it in
-;;; DEBUG-FUN.
+;;; Note: If this has to compute the lambda list, it caches it in DEBUG-FUN.
(defun compiled-debug-fun-lambda-list (debug-fun)
(let ((lambda-list (debug-fun-%lambda-list debug-fun)))
(cond ((eq lambda-list :unparsed)
(make-array 20 :adjustable t :fill-pointer t))
(defvar *other-parsing-buffer*
(make-array 20 :adjustable t :fill-pointer t))
-;;; PARSE-DEBUG-BLOCKS, PARSE-DEBUG-VARS and UNCOMPACT-FUNCTION-MAP
+;;; PARSE-DEBUG-BLOCKS and PARSE-DEBUG-VARS
;;; use this to unpack binary encoded information. It returns the
;;; values returned by the last form in body.
;;;
\f
;;;; unpacking minimal debug functions
-(eval-when (:compile-toplevel :execute)
-
-;;; sleazoid "macro" to keep our indentation sane in UNCOMPACT-FUNCTION-MAP
-(sb!xc:defmacro make-uncompacted-debug-fun ()
- '(sb!c::make-compiled-debug-fun
- :name
- (let ((base (ecase (ldb sb!c::minimal-debug-fun-name-style-byte
- options)
- (#.sb!c::minimal-debug-fun-name-symbol
- (intern (sb!c::read-var-string map i)
- (sb!c::compiled-debug-info-package info)))
- (#.sb!c::minimal-debug-fun-name-packaged
- (let ((pkg (sb!c::read-var-string map i)))
- (intern (sb!c::read-var-string map i) pkg)))
- (#.sb!c::minimal-debug-fun-name-uninterned
- (make-symbol (sb!c::read-var-string map i)))
- (#.sb!c::minimal-debug-fun-name-component
- (sb!c::compiled-debug-info-name info)))))
- (if (logtest flags sb!c::minimal-debug-fun-setf-bit)
- `(setf ,base)
- base))
- :kind (svref sb!c::*minimal-debug-fun-kinds*
- (ldb sb!c::minimal-debug-fun-kind-byte options))
- :variables
- (when vars-p
- (let ((len (sb!c::read-var-integer map i)))
- (prog1 (subseq map i (+ i len))
- (incf i len))))
- :arguments (when vars-p :minimal)
- :returns
- (ecase (ldb sb!c::minimal-debug-fun-returns-byte options)
- (#.sb!c::minimal-debug-fun-returns-standard
- :standard)
- (#.sb!c::minimal-debug-fun-returns-fixed
- :fixed)
- (#.sb!c::minimal-debug-fun-returns-specified
- (with-parsing-buffer (buf)
- (dotimes (idx (sb!c::read-var-integer map i))
- (vector-push-extend (sb!c::read-var-integer map i) buf))
- (result buf))))
- :return-pc (sb!c::read-var-integer map i)
- :old-fp (sb!c::read-var-integer map i)
- :nfp (when (logtest flags sb!c::minimal-debug-fun-nfp-bit)
- (sb!c::read-var-integer map i))
- :start-pc
- (progn
- (setq code-start-pc (+ code-start-pc (sb!c::read-var-integer map i)))
- (+ code-start-pc (sb!c::read-var-integer map i)))
- :elsewhere-pc
- (setq elsewhere-pc (+ elsewhere-pc (sb!c::read-var-integer map i)))))
-
-) ; EVAL-WHEN
-
-;;; Return a normal function map derived from a minimal debug info
-;;; function map. This involves looping parsing MINIMAL-DEBUG-FUNs and
-;;; then building a vector out of them.
-;;;
-;;; FIXME: This and its helper macro just above become dead code now
-;;; that we no longer use compacted function maps.
-(defun uncompact-function-map (info)
- (declare (type sb!c::compiled-debug-info info))
-
- ;; (This is stubified until we solve the problem of representing
- ;; debug information in a way which plays nicely with package renaming.)
- (error "FIXME: dead code UNCOMPACT-FUNCTION-MAP (was stub)")
-
- (let* ((map (sb!c::compiled-debug-info-function-map info))
- (i 0)
- (len (length map))
- (code-start-pc 0)
- (elsewhere-pc 0))
- (declare (type (simple-array (unsigned-byte 8) (*)) map))
- (sb!int:collect ((res))
- (loop
- (when (= i len) (return))
- (let* ((options (prog1 (aref map i) (incf i)))
- (flags (prog1 (aref map i) (incf i)))
- (vars-p (logtest flags
- sb!c::minimal-debug-fun-variables-bit))
- (dfun (make-uncompacted-debug-fun)))
- (res code-start-pc)
- (res dfun)))
-
- (coerce (cdr (res)) 'simple-vector))))
-
-;;; a map from minimal DEBUG-INFO function maps to unpacked
-;;; versions thereof
-(defvar *uncompacted-function-maps* (make-hash-table :test 'eq))
-
-;;; Return a FUNCTION-MAP for a given COMPILED-DEBUG-info object. If
-;;; the info is minimal, and has not been parsed, then parse it.
-;;;
-;;; FIXME: Now that we no longer use the MINIMAL-DEBUG-FUN
-;;; representation, calls to this function can be replaced by calls to
-;;; the bare COMPILED-DEBUG-INFO-FUNCTION-MAP slot accessor function,
-;;; and this function and everything it calls become dead code which
-;;; can be deleted.
-(defun get-debug-info-function-map (info)
+;;; Return a FUN-MAP for a given COMPILED-DEBUG-INFO object.
+(defun get-debug-info-fun-map (info)
(declare (type sb!c::compiled-debug-info info))
- (let ((map (sb!c::compiled-debug-info-function-map info)))
- (if (simple-vector-p map)
- map
- (or (gethash map *uncompacted-function-maps*)
- (setf (gethash map *uncompacted-function-maps*)
- (uncompact-function-map info))))))
+ (let ((map (sb!c::compiled-debug-info-fun-map info)))
+ ;; The old CMU CL had various hairy possibilities here, but in
+ ;; SBCL we only use this one, right?
+ (aver (simple-vector-p map))
+ ;; So it's easy..
+ map))
\f
;;;; CODE-LOCATIONs
(dump-1-variable fun var (leaf-info var) 0 t buffer))
(coerce buffer 'simple-vector)))
-;;; Return Var's relative position in the function's variables (determined
-;;; from the Var-Locs hashtable.) If Var is deleted, then return DELETED.
+;;; Return VAR's relative position in the function's variables (determined
+;;; from the VAR-LOCS hashtable). If VAR is deleted, then return DELETED.
(defun debug-location-for (var var-locs)
(declare (type lambda-var var) (type hash-table var-locs))
(let ((res (gethash var var-locs)))
(compute-debug-returns fun)))))))
dfun))
\f
-;;;; MINIMAL-DEBUG-FUNs
-
-;;; Return true if DFUN can be represented as a MINIMAL-DEBUG-FUN.
-;;; DFUN is a cons (<start offset> . C-D-F).
-(defun debug-fun-minimal-p (dfun)
- (declare (type cons dfun))
- (let ((dfun (cdr dfun)))
- (and (member (compiled-debug-fun-arguments dfun) '(:minimal nil))
- (null (compiled-debug-fun-blocks dfun)))))
-
-;;; Dump a packed binary representation of a DFUN into *BYTE-BUFFER*.
-;;; PREV-START and START are the byte offsets in the code where the
-;;; previous function started and where this one starts.
-;;; PREV-ELSEWHERE is the previous function's elsewhere PC.
-(defun dump-1-minimal-dfun (dfun prev-start start prev-elsewhere)
- (declare (type compiled-debug-fun dfun)
- (type index prev-start start prev-elsewhere))
- (let* ((name (compiled-debug-fun-name dfun))
- (setf-p (and (consp name) (eq (car name) 'setf)
- (consp (cdr name)) (symbolp (cadr name))))
- (base-name (if setf-p (cadr name) name))
- (pkg (when (symbolp base-name)
- (symbol-package base-name)))
- (name-rep
- (cond ((stringp base-name)
- minimal-debug-fun-name-component)
- ((not pkg)
- minimal-debug-fun-name-uninterned)
- ((eq pkg (sane-package))
- minimal-debug-fun-name-symbol)
- (t
- minimal-debug-fun-name-packaged))))
- (aver (or (atom name) setf-p))
- (let ((options 0))
- (setf (ldb minimal-debug-fun-name-style-byte options) name-rep)
- (setf (ldb minimal-debug-fun-kind-byte options)
- (position-or-lose (compiled-debug-fun-kind dfun)
- *minimal-debug-fun-kinds*))
- (setf (ldb minimal-debug-fun-returns-byte options)
- (etypecase (compiled-debug-fun-returns dfun)
- ((member :standard) minimal-debug-fun-returns-standard)
- ((member :fixed) minimal-debug-fun-returns-fixed)
- (vector minimal-debug-fun-returns-specified)))
- (vector-push-extend options *byte-buffer*))
-
- (let ((flags 0))
- (when setf-p
- (setq flags (logior flags minimal-debug-fun-setf-bit)))
- (when (compiled-debug-fun-nfp dfun)
- (setq flags (logior flags minimal-debug-fun-nfp-bit)))
- (when (compiled-debug-fun-variables dfun)
- (setq flags (logior flags minimal-debug-fun-variables-bit)))
- (vector-push-extend flags *byte-buffer*))
-
- (when (eql name-rep minimal-debug-fun-name-packaged)
- (write-var-string (package-name pkg) *byte-buffer*))
- (unless (stringp base-name)
- (write-var-string (symbol-name base-name) *byte-buffer*))
-
- (let ((vars (compiled-debug-fun-variables dfun)))
- (when vars
- (let ((len (length vars)))
- (write-var-integer len *byte-buffer*)
- (dotimes (i len)
- (vector-push-extend (aref vars i) *byte-buffer*)))))
-
- (let ((returns (compiled-debug-fun-returns dfun)))
- (when (vectorp returns)
- (let ((len (length returns)))
- (write-var-integer len *byte-buffer*)
- (dotimes (i len)
- (write-var-integer (aref returns i) *byte-buffer*)))))
-
- (write-var-integer (compiled-debug-fun-return-pc dfun)
- *byte-buffer*)
- (write-var-integer (compiled-debug-fun-old-fp dfun)
- *byte-buffer*)
- (when (compiled-debug-fun-nfp dfun)
- (write-var-integer (compiled-debug-fun-nfp dfun)
- *byte-buffer*))
- (write-var-integer (- start prev-start) *byte-buffer*)
- (write-var-integer (- (compiled-debug-fun-start-pc dfun) start)
- *byte-buffer*)
- (write-var-integer (- (compiled-debug-fun-elsewhere-pc dfun)
- prev-elsewhere)
- *byte-buffer*)))
-
-;;; Return a byte-vector holding all the debug functions for a
-;;; component in the packed binary MINIMAL-DEBUG-FUN format.
-(defun compute-minimal-debug-funs (dfuns)
- (declare (list dfuns))
- (setf (fill-pointer *byte-buffer*) 0)
- (let ((prev-start 0)
- (prev-elsewhere 0))
- (dolist (dfun dfuns)
- (let ((start (car dfun))
- (elsewhere (compiled-debug-fun-elsewhere-pc (cdr dfun))))
- (dump-1-minimal-dfun (cdr dfun) prev-start start prev-elsewhere)
- (setq prev-start start prev-elsewhere elsewhere))))
- (copy-seq *byte-buffer*))
-\f
;;;; full component dumping
;;; Compute the full form (simple-vector) function map.
(declare (type component component))
(collect ((dfuns))
(let ((var-locs (make-hash-table :test 'eq))
- ;; FIXME: What is *BYTE-BUFFER* for? Has it become dead code
- ;; now that we no longer use MINIMAL-DEBUG-FUN
- ;; representation?
(*byte-buffer* (make-array 10
:element-type '(unsigned-byte 8)
:fill-pointer 0
(block-label (node-block (lambda-bind fun))))
(compute-1-debug-fun fun var-locs))))
(let* ((sorted (sort (dfuns) #'< :key #'car))
- ;; FIXME: CMU CL had
- ;; (IF (EVERY #'DEBUG-FUN-MINIMAL-P SORTED)
- ;; (COMPUTE-MINIMAL-DEBUG-FUNS SORTED)
- ;; (COMPUTE-DEBUG-FUN-MAP SORTED))
- ;; here. We've gotten rid of the MINIMAL-DEBUG-FUN
- ;; case in SBCL because the minimal representation
- ;; couldn't be made to transform properly under package
- ;; renaming. Now that that case is gone, a lot of code is
- ;; dead, and once everything is known to work, the dead
- ;; code should be deleted.
- (function-map (compute-debug-fun-map sorted)))
+ (fun-map (compute-debug-fun-map sorted)))
(make-compiled-debug-info :name (component-name component)
- :function-map function-map)))))
+ :fun-map fun-map)))))
\f
;;; Write BITS out to BYTE-BUFFER in backend byte order. The length of
;;; BITS must be evenly divisible by eight.
\f
;;;; stuff to use debugging-info to augment the disassembly
-(defun code-function-map (code)
+(defun code-fun-map (code)
(declare (type sb!kernel:code-component code))
- (sb!di::get-debug-info-function-map (sb!kernel:%code-debug-info code)))
+ (sb!di::get-debug-info-fun-map (sb!kernel:%code-debug-info code)))
(defstruct (location-group (:copier nil))
(locations #() :type (vector (or list fixnum))))
(defun get-function-segments (function)
(declare (type compiled-function function))
(let* ((code (fun-code function))
- (function-map (code-function-map code))
+ (fun-map (code-fun-map code))
(fname (sb!kernel:%function-name function))
(sfcache (make-source-form-cache)))
(let ((first-block-seen-p nil)
:debug-fun df
:source-form-cache sfcache)
segments))))
- (dotimes (fmap-index (length function-map))
- (let ((fmap-entry (aref function-map fmap-index)))
+ (dotimes (fmap-index (length fun-map))
+ (let ((fmap-entry (aref fun-map fmap-index)))
(etypecase fmap-entry
(integer
(when first-block-seen-p
(type length length))
(let ((segments nil))
(when code
- (let ((function-map (code-function-map code))
+ (let ((fun-map (code-fun-map code))
(sfcache (make-source-form-cache)))
(let ((last-offset 0)
(last-debug-fun nil))
:debug-fun df
:source-form-cache sfcache)
segments)))))
- (dotimes (fmap-index (length function-map))
- (let ((fmap-entry (aref function-map fmap-index)))
- (etypecase fmap-entry
+ (dotimes (fun-map-index (length fun-map))
+ (let ((fun-map-entry (aref fun-map fun-map-index)))
+ (etypecase fun-map-entry
(integer
- (add-seg last-offset (- fmap-entry last-offset)
+ (add-seg last-offset (- fun-map-entry last-offset)
last-debug-fun)
(setf last-debug-fun nil)
- (setf last-offset fmap-entry))
+ (setf last-offset fun-map-entry))
(sb!c::compiled-debug-fun
(setf last-debug-fun
- (sb!di::make-compiled-debug-fun fmap-entry
- code))))))
+ (sb!di::make-compiled-debug-fun fun-map-entry
+ code))))))
(when last-debug-fun
(add-seg last-offset
(- (code-inst-area-length code) last-offset)
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.pre7.52"
+"0.pre7.53"
projects / sbcl.git / commitdiff