Update of /cvsroot/sbcl/sbcl/src/code In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26159/src/code Modified Files: Tag: debugectomy_branch debug-info.lisp debug-int.lisp debug.lisp interr.lisp room.lisp target-load.lisp target-misc.lisp Log Message: 0.8.21.34.debugectomy.1: "First rule of field surgery: remove all dead tissue." * remove *compiled-debug-fun* cache. * remove vestigial remains of IR1 interpreter debugging. * remove cacheing from DB-DI::DEBUG-FUN. * don't dump identifying information for &MORE arguments, as it isn't used anyhow. * don't dump SUPPLIED-P information for lambda-lists, as it isn't used anyhow. * don't dump information to identify between optional and required arguments in the debugger, as it isn't used anyhow. * merge SB-DI::COMPILED-DEBUG-VAR into SB-DI::DEBUG-VAR. * merge SB-DI::COMPILED-FRAME into SB-DI::FRAME. * merge SB-DI::COMPILED-DEBUG-BLOCk into SB-DI::DEBUG-BLOCK. * merge SB-DI::COMPILED-CODE-LOCATION into SB-DI::CODE-LOCATION. * rename SB-C::COMPILED-DEBUG-* to SB-C::COMPILER-DEBUG-*. Index: debug-info.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/debug-info.lisp,v retrieving revision 1.19 retrieving revision 1.19.2.1 diff -u -d -r1.19 -r1.19.2.1 --- debug-info.lisp 1 Mar 2005 10:21:30 -0000 1.19 +++ debug-info.lisp 12 Apr 2005 05:20:29 -0000 1.19.2.1 @@ -33,13 +33,13 @@ ;;; [If has save SC, SC-OFFSET of save location (as var-length integer)] ;;; FIXME: The first two are no longer used in SBCL. -;;;(defconstant compiled-debug-var-uninterned #b00000001) -;;;(defconstant compiled-debug-var-packaged #b00000010) -(def!constant compiled-debug-var-environment-live #b00000100) -(def!constant compiled-debug-var-save-loc-p #b00001000) -(def!constant compiled-debug-var-id-p #b00010000) -(def!constant compiled-debug-var-minimal-p #b00100000) -(def!constant compiled-debug-var-deleted-p #b01000000) +;;;(defconstant compiler-debug-var-uninterned #b00000001) +;;;(defconstant compiler-debug-var-packaged #b00000010) +(def!constant compiler-debug-var-environment-live #b00000100) +(def!constant compiler-debug-var-save-loc-p #b00001000) +(def!constant compiler-debug-var-id-p #b00010000) +(def!constant compiler-debug-var-minimal-p #b00100000) +(def!constant compiler-debug-var-deleted-p #b01000000) ;;;; compiled debug blocks ;;;; @@ -57,11 +57,11 @@ ;;;; ...more <kind, delta, top level form offset, form-number, live-set> ;;;; tuples... -(defconstant-eqx compiled-debug-block-nsucc-byte (byte 2 0) #'equalp) -(def!constant compiled-debug-block-elsewhere-p #b00000100) +(defconstant-eqx compiler-debug-block-nsucc-byte (byte 2 0) #'equalp) +(def!constant compiler-debug-block-elsewhere-p #b00000100) -(defconstant-eqx compiled-code-location-kind-byte (byte 3 0) #'equalp) -(defparameter *compiled-code-location-kinds* +(defconstant-eqx code-location-kind-byte (byte 3 0) #'equalp) +(defparameter *code-location-kinds* #(:unknown-return :known-return :internal-error :non-local-exit :block-start :call-site :single-value-return :non-local-entry)) @@ -69,7 +69,7 @@ (def!struct (debug-fun (:constructor nil))) -(def!struct (compiled-debug-fun (:include debug-fun) +(def!struct (compiler-debug-fun (:include debug-fun) #-sb-xc-host (:pure t)) ;; KLUDGE: Courtesy of more than a decade of, ah, organic growth in ;; CMU CL, there are two distinct -- but coupled -- mechanisms to @@ -96,7 +96,7 @@ ;; ;; Each entry is: ;; * a FLAGS value, which is a FIXNUM with various - ;; COMPILED-DEBUG-FUN-FOO bits set + ;; COMPILER-DEBUG-FUN-FOO bits set ;; * the symbol which names this variable, unless debug info ;; is minimal ;; * the variable ID, when it has one @@ -104,7 +104,7 @@ ;; * SC-offset of save location, if it has one (vars nil :type (or simple-vector null)) ;; a vector of the packed binary representation of the - ;; COMPILED-DEBUG-BLOCKs in this function, in the order that the + ;; COMPILER-DEBUG-BLOCKs in this function, in the order that the ;; blocks were emitted. The first block is the start of the ;; function. This slot may be NIL to save space. ;; @@ -190,7 +190,7 @@ ;;; ;;; 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 +;;; COMPILER-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: @@ -273,7 +273,7 @@ ;; *** is complete. (source nil :type list)) -(def!struct (compiled-debug-info +(def!struct (compiler-debug-info (:include debug-info) #-sb-xc-host (:pure t)) ;; a SIMPLE-VECTOR of alternating DEBUG-FUN objects and fixnum Index: debug-int.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/debug-int.lisp,v retrieving revision 1.92 retrieving revision 1.92.2.1 diff -u -d -r1.92 -r1.92.2.1 --- debug-int.lisp 9 Apr 2005 21:28:39 -0000 1.92 +++ debug-int.lisp 12 Apr 2005 05:20:29 -0000 1.92.2.1 @@ -181,15 +181,22 @@ ;;; These exist for caching data stored in packed binary form in ;;; compiler DEBUG-FUNs. -(defstruct (debug-var (:constructor nil) - (:copier nil)) +(defstruct (debug-var + (:constructor make-debug-var + (symbol id alive-p sc-offset save-sc-offset)) + (:copier nil)) ;; the name of the variable (symbol (missing-arg) :type symbol) [...1356 lines suppressed...] @@ -3310,13 +3073,9 @@ ;;; the arguments are in place; or if that location can't be ;;; determined due to a lack of debug information, return NIL. (defun debug-fun-start-location (debug-fun) - (etypecase debug-fun - (compiled-debug-fun - (code-location-from-pc debug-fun - (sb!c::compiled-debug-fun-start-pc - (compiled-debug-fun-compiler-debug-fun - debug-fun)) - nil)) - ;; (There used to be more cases back before sbcl-0.7.0, when - ;; we did special tricks to debug the IR1 interpreter.) - )) + (code-location-from-pc debug-fun + (sb!c::compiler-debug-fun-start-pc + (compiled-debug-fun-compiler-debug-fun + debug-fun)) + nil)) + Index: debug.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/debug.lisp,v retrieving revision 1.77 retrieving revision 1.77.2.1 diff -u -d -r1.77 -r1.77.2.1 --- debug.lisp 20 Mar 2005 09:03:40 -0000 1.77 +++ debug.lisp 12 Apr 2005 05:20:29 -0000 1.77.2.1 @@ -190,23 +190,19 @@ ;;;; frame printing -(eval-when (:compile-toplevel :execute) - ;;; This is a convenient way to express what to do for each type of ;;; lambda-list element. (sb!xc:defmacro lambda-list-element-dispatch (element &key - required - optional + simple rest keyword deleted) `(etypecase ,element (sb!di:debug-var - ,@required) + ,@simple) (cons (ecase (car ,element) - (:optional ,@optional) (:rest ,@rest) (:keyword ,@keyword))) (symbol @@ -221,8 +217,6 @@ ,valid) (t ,other))))) -) ; EVAL-WHEN - ;;; This is used in constructing arg lists for debugger printing when ;;; the arg list is unavailable, some arg is unavailable or unused, etc. (defstruct (unprintable-object @@ -243,9 +237,7 @@ (progn (dolist (ele (sb!di:debug-fun-lambda-list debug-fun)) (lambda-list-element-dispatch ele - :required ((push (frame-call-arg ele loc frame) reversed-result)) - :optional ((push (frame-call-arg (second ele) loc frame) - reversed-result)) + :simple ((push (frame-call-arg ele loc frame) reversed-result)) :keyword ((push (second ele) reversed-result) (push (frame-call-arg (third ele) loc frame) reversed-result)) @@ -267,7 +259,7 @@ (sb!di:lambda-list-unavailable () (make-unprintable-object "unavailable lambda list"))))) -(legal-fun-name-p '(lambda ())) + (defvar *show-entry-point-details* nil) (defun clean-xep (name args) @@ -317,11 +309,30 @@ (let ((debug-fun (sb!di:frame-debug-fun frame))) (multiple-value-bind (name args) (clean-name-and-args (sb!di:debug-fun-name debug-fun) - (frame-args-as-list frame)) + (frame-args-as-list frame)) (values name args (when *show-entry-point-details* (sb!di:debug-fun-kind debug-fun))))))) +(defun frame-vars (frame) + (labels ((clean-vars-by-name (name vars) + (if (and (consp name) (not *show-entry-point-details*)) + (case (first name) + ((sb!c::xep sb!c::tl-xep) + (nth-value 1 (clean-xep name vars))) + ((sb!c::hairy-arg-processor + sb!c::varargs-entry sb!c::&optional-processor) + (clean-vars-by-name (second name) vars)) + (t + vars)) + vars))) + (let* ((dfun (sb!di:frame-debug-fun frame)) + (loc (sb!di:frame-code-location frame)) + (vars (loop for var across (sb!di::debug-fun-debug-vars dfun) + when (eq :valid (sb!di:debug-var-validity var loc)) + collect var))) + (clean-vars-by-name (sb!di:debug-fun-name dfun) vars)))) + (defun ensure-printable-object (object) (handler-case (with-open-stream (out (make-broadcast-stream)) @@ -900,8 +911,7 @@ (dolist (ele args (error "The argument specification ~S is out of range." n)) (lambda-list-element-dispatch ele - :required ((if (zerop n) (return (values ele t)))) - :optional ((if (zerop n) (return (values (second ele) t)))) + :simple ((if (zerop n) (return (values ele t)))) :keyword ((cond ((zerop n) (return (values (second ele) nil))) ((zerop (decf n)) @@ -1158,7 +1168,6 @@ (zerop (sb!di:debug-var-id v)) (sb!di:debug-var-id v) (sb!di:debug-var-value v *current-frame*)))) - (cond ((not any-p) (format *debug-io* Index: interr.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/interr.lisp,v retrieving revision 1.32 retrieving revision 1.32.2.1 diff -u -d -r1.32 -r1.32.2.1 --- interr.lisp 14 Mar 2005 09:54:47 -0000 1.32 +++ interr.lisp 12 Apr 2005 05:20:29 -0000 1.32.2.1 @@ -375,8 +375,8 @@ (/show0 "null frame") (values "<error finding interrupted name -- null frame>" nil)) (/show0 "at head of DO loop") - (when (and (sb!di::compiled-frame-p frame) - (sb!di::compiled-frame-escaped frame)) + (when (and (sb!di::frame-p frame) + (sb!di::frame-escaped frame)) (sb!di:flush-frames-above frame) (/show0 "returning from within DO loop") (return (values (sb!di:debug-fun-name Index: room.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/room.lisp,v retrieving revision 1.32 retrieving revision 1.32.8.1 diff -u -d -r1.32 -r1.32.8.1 --- room.lisp 6 Jan 2005 12:47:58 -0000 1.32 +++ room.lisp 12 Apr 2005 05:20:29 -0000 1.32.8.1 @@ -641,7 +641,7 @@ (let ((dinfo (%code-debug-info obj))) (format stream "~&Code object: ~S~%" (if dinfo - (sb!c::compiled-debug-info-name dinfo) + (sb!c::compiler-debug-info-name dinfo) "No debug info.")))) (#.symbol-header-widetag (format stream "~&~S~%" obj)) Index: target-load.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/target-load.lisp,v retrieving revision 1.39 retrieving revision 1.39.2.1 diff -u -d -r1.39 -r1.39.2.1 --- target-load.lisp 9 Mar 2005 04:23:12 -0000 1.39 +++ target-load.lisp 12 Apr 2005 05:20:30 -0000 1.39.2.1 @@ -260,9 +260,9 @@ (format t "stuff: ~S~%" stuff) (format t " : ~S ~S ~S ~S~%" - (sb!c::compiled-debug-info-p dbi) + (sb!c::compiler-debug-info-p dbi) (sb!c::debug-info-p dbi) - (sb!c::compiled-debug-info-name dbi) + (sb!c::compiler-debug-info-name dbi) tto) (format t " loading to the dynamic space~%")) Index: target-misc.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/target-misc.lisp,v retrieving revision 1.20 retrieving revision 1.20.2.1 diff -u -d -r1.20 -r1.20.2.1 --- target-misc.lisp 1 Mar 2005 10:21:32 -0000 1.20 +++ target-misc.lisp 12 Apr 2005 05:20:30 -0000 1.20.2.1 @@ -29,7 +29,7 @@ (code (sb!di::fun-code-header fun)) (info (sb!kernel:%code-debug-info code))) (if info - (let ((source (first (sb!c::compiled-debug-info-source info)))) + (let ((source (first (sb!c::compiler-debug-info-source info)))) (cond ((and (eq (sb!c::debug-source-from source) :lisp) (eq (sb!c::debug-source-info source) fun)) (values (svref (sb!c::debug-source-name source) 0) |