From c2404a2f430ecf57897a795202625dff4764c18d Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sun, 3 Jul 2011 18:52:32 +0300 Subject: [PATCH] teach debugger about &MORE arguments LIST-LOCALS displays SB-DEBUG::MORE = (...list of more args...) in addition to the more-context and count. EVAL-IN-FRAME bindss SB-DEBUG::MORE when appropriate. --- NEWS | 1 + src/code/debug-info.lisp | 5 ++--- src/code/debug-int.lisp | 41 +++++++++++++++++++++++++++++++---------- src/code/debug.lisp | 18 ++++++++++++++---- src/compiler/debug-dump.lisp | 9 ++++++++- 5 files changed, 56 insertions(+), 18 deletions(-) diff --git a/NEWS b/NEWS index 1df6936..8f6c15c 100644 --- a/NEWS +++ b/NEWS @@ -12,6 +12,7 @@ changes relative to sbcl-1.0.49: * enhancement: constraint propagation is simplified (and sped up) when COMPILATION-SPEED > SPEED. * enhancement: SB-ALIEN exports alien type specifiers SIZE-T and OFF-T. + * enhancement: debugger understands &MORE arguments better. * optimization: extracting bits of a single-float on x86-64 has been optimized. (lp#555201) * optimization: MAP and MAP-INTO are more efficient for non-simple vectors, diff --git a/src/code/debug-info.lisp b/src/code/debug-info.lisp index bc09934..82ebf9d 100644 --- a/src/code/debug-info.lisp +++ b/src/code/debug-info.lisp @@ -32,9 +32,8 @@ ;;; SC-Offset of primary location (as var-length integer) ;;; [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-more-context-p #b00000001) +(def!constant compiled-debug-var-more-count-p #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) diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 9b973c0..f0e34f8 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -205,12 +205,13 @@ (defstruct (compiled-debug-var (:include debug-var) (:constructor make-compiled-debug-var - (symbol id alive-p sc-offset save-sc-offset)) + (symbol id alive-p sc-offset save-sc-offset info)) (:copier nil)) ;; storage class and offset (unexported) (sc-offset nil :type sb!c:sc-offset) ;; storage class and offset when saved somewhere - (save-sc-offset nil :type (or sb!c:sc-offset null))) + (save-sc-offset nil :type (or sb!c:sc-offset null)) + (info nil)) ;;;; frames @@ -1636,6 +1637,8 @@ register." (let* ((flags (geti)) (minimal (logtest sb!c::compiled-debug-var-minimal-p flags)) (deleted (logtest sb!c::compiled-debug-var-deleted-p flags)) + (more-context-p (logtest sb!c::compiled-debug-var-more-context-p flags)) + (more-count-p (logtest sb!c::compiled-debug-var-more-count-p flags)) (live (logtest sb!c::compiled-debug-var-environment-live flags)) (save (logtest sb!c::compiled-debug-var-save-loc-p flags)) @@ -1650,7 +1653,9 @@ register." id live sc-offset - save-sc-offset) + save-sc-offset + (cond (more-context-p :more-context) + (more-count-p :more-count))) buffer))))))) ;;;; CODE-LOCATIONs @@ -2374,12 +2379,10 @@ register." ;;; :unknown. Once we've called CODE-LOCATION-UNKNOWN-P, we know the ;;; live-set information has been cached in the code-location. (defun debug-var-validity (debug-var basic-code-location) - (etypecase debug-var - (compiled-debug-var - (compiled-debug-var-validity debug-var basic-code-location)) - ;; (There used to be more cases back before sbcl-0.7.0, when - ;; we did special tricks to debug the IR1 interpreter.) - )) + (compiled-debug-var-validity debug-var basic-code-location)) + +(defun debug-var-info (debug-var) + (compiled-debug-var-info debug-var)) ;;; This is the method for DEBUG-VAR-VALIDITY for COMPILED-DEBUG-VARs. ;;; For safety, make sure basic-code-location is what we think. @@ -2514,7 +2517,9 @@ register." (defun preprocess-for-eval (form loc) (declare (type code-location loc)) (let ((n-frame (gensym)) - (fun (code-location-debug-fun loc))) + (fun (code-location-debug-fun loc)) + (more-context nil) + (more-count nil)) (unless (debug-var-info-available fun) (debug-signal 'no-debug-vars :debug-fun fun)) (sb!int:collect ((binds) @@ -2522,17 +2527,33 @@ register." (do-debug-fun-vars (var fun) (let ((validity (debug-var-validity var loc))) (unless (eq validity :invalid) + (case (debug-var-info var) + (:more-context + (setf more-context var)) + (:more-count + (setf more-count var))) (let* ((sym (debug-var-symbol var)) (found (assoc sym (binds)))) (if found (setf (second found) :ambiguous) (binds (list sym validity var))))))) + (when (and more-context more-count) + (let ((more (assoc 'sb!debug::more (binds)))) + (if more + (setf (second more) :ambiguous) + (binds (list 'sb!debug::more :more more-context more-count))))) (dolist (bind (binds)) (let ((name (first bind)) (var (third bind))) (ecase (second bind) (:valid (specs `(,name (debug-var-value ',var ,n-frame)))) + (:more + (let ((count-var (fourth bind))) + (specs `(,name (multiple-value-list + (sb!c:%more-arg-values (debug-var-value ',var ,n-frame) + 0 + (debug-var-value ',count-var ,n-frame))))))) (:unknown (specs `(,name (debug-signal 'invalid-value :debug-var ',var diff --git a/src/code/debug.lisp b/src/code/debug.lisp index deb0be9..5a5b0f3 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -1267,19 +1267,29 @@ and LDB (the low-level debugger). See also ENABLE-DEBUGGER." (location (sb!di:frame-code-location *current-frame*)) (prefix (read-if-available nil)) (any-p nil) - (any-valid-p nil)) + (any-valid-p nil) + (more-context nil) + (more-count nil)) (dolist (v (sb!di:ambiguous-debug-vars - d-fun - (if prefix (string prefix) ""))) + d-fun + (if prefix (string prefix) ""))) (setf any-p t) (when (eq (sb!di:debug-var-validity v location) :valid) (setf any-valid-p t) + (case (sb!di::debug-var-info v) + (:more-context + (setf more-context (sb!di:debug-var-value v *current-frame*))) + (:more-count + (setf more-count (sb!di:debug-var-value v *current-frame*)))) (format *debug-io* "~S~:[#~W~;~*~] = ~S~%" (sb!di:debug-var-symbol v) (zerop (sb!di:debug-var-id v)) (sb!di:debug-var-id v) (sb!di:debug-var-value v *current-frame*)))) - + (when (and more-context more-count) + (format *debug-io* "~S = ~S~%" + 'more + (multiple-value-list (sb!c:%more-arg-values more-context 0 more-count)))) (cond ((not any-p) (format *debug-io* diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp index 6633b3f..2b3d604 100644 --- a/src/compiler/debug-dump.lisp +++ b/src/compiler/debug-dump.lisp @@ -352,7 +352,8 @@ (let* ((name (leaf-debug-name var)) (save-tn (and tn (tn-save-tn tn))) (kind (and tn (tn-kind tn))) - (flags 0)) + (flags 0) + (info (lambda-var-arg-info var))) (declare (type index flags)) (when minimal (setq flags (logior flags compiled-debug-var-minimal-p)) @@ -369,6 +370,12 @@ (setq flags (logior flags compiled-debug-var-save-loc-p))) (unless (or (zerop id) minimal) (setq flags (logior flags compiled-debug-var-id-p))) + (when info + (case (arg-info-kind info) + (:more-context + (setq flags (logior flags compiled-debug-var-more-context-p))) + (:more-count + (setq flags (logior flags compiled-debug-var-more-count-p))))) (vector-push-extend flags buffer) (unless minimal (vector-push-extend name buffer) -- 1.7.10.4