From b6cb3d5b2e2a0d6e6c92a2f3d852051540660fef Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sun, 7 Oct 2001 22:10:02 +0000 Subject: [PATCH] 0.pre7.53: 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/. --- src/code/debug-info.lisp | 53 ++++---------- src/code/debug-int.lisp | 143 ++++++------------------------------- src/compiler/debug-dump.lisp | 122 ++----------------------------- src/compiler/target-disassem.lisp | 26 +++---- version.lisp-expr | 2 +- 5 files changed, 55 insertions(+), 291 deletions(-) diff --git a/src/code/debug-info.lisp b/src/code/debug-info.lisp index 07538a9..47f5c74 100644 --- a/src/code/debug-info.lisp +++ b/src/code/debug-info.lisp @@ -189,12 +189,12 @@ ;;; 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 @@ -225,38 +225,13 @@ ;;; 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). ;;;; debug source @@ -314,4 +289,4 @@ function (which would be useful info anyway). ;; 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)) diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 1474fad..68e6925 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -984,10 +984,10 @@ ;;;; 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))) @@ -997,24 +997,24 @@ ((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))))))))) @@ -1183,7 +1183,7 @@ (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) @@ -1303,8 +1303,7 @@ (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) @@ -1416,7 +1415,7 @@ (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. ;;; @@ -1625,111 +1624,15 @@ ;;;; 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)) ;;;; CODE-LOCATIONs diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp index 62671b8..7e6b4a0 100644 --- a/src/compiler/debug-dump.lisp +++ b/src/compiler/debug-dump.lisp @@ -405,8 +405,8 @@ (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))) @@ -531,107 +531,6 @@ (compute-debug-returns fun))))))) dfun)) -;;;; MINIMAL-DEBUG-FUNs - -;;; Return true if DFUN can be represented as a MINIMAL-DEBUG-FUN. -;;; DFUN is a cons ( . 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*)) - ;;;; full component dumping ;;; Compute the full form (simple-vector) function map. @@ -655,9 +554,6 @@ (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 @@ -668,19 +564,9 @@ (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))))) ;;; Write BITS out to BYTE-BUFFER in backend byte order. The length of ;;; BITS must be evenly divisible by eight. diff --git a/src/compiler/target-disassem.lisp b/src/compiler/target-disassem.lisp index 3f39d3c..ca5ca26 100644 --- a/src/compiler/target-disassem.lisp +++ b/src/compiler/target-disassem.lisp @@ -1068,9 +1068,9 @@ ;;;; 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)))) @@ -1311,7 +1311,7 @@ (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) @@ -1325,8 +1325,8 @@ :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 @@ -1380,7 +1380,7 @@ (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)) @@ -1398,18 +1398,18 @@ :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) diff --git a/version.lisp-expr b/version.lisp-expr index bdc7bee..cbe8013 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; 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" -- 1.7.10.4