From ef11b09c41b1e344212f6a363892a849af7ff94e Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Thu, 12 Sep 2002 14:10:01 +0000 Subject: [PATCH] 0.7.7.22: added BACKTRACE-AS-LIST --- doc/sbcl.1 | 10 +++--- package-data-list.lisp-expr | 2 +- src/code/debug.lisp | 76 ++++++++++++++++++++++++++++--------------- src/pcl/boot.lisp | 6 +++- version.lisp-expr | 10 +++--- 5 files changed, 67 insertions(+), 37 deletions(-) diff --git a/doc/sbcl.1 b/doc/sbcl.1 index 908f9a1..942f0f8 100644 --- a/doc/sbcl.1 +++ b/doc/sbcl.1 @@ -267,9 +267,11 @@ Supported runtime options are .TP 3 .B --core Run the specified Lisp core file instead of the default. (See the FILES -section.) Note that if the Lisp core file is a user-created core file, it may -run a nonstandard toplevel which does not recognize the standard toplevel -options. +section for the standard core, or the system documentation for +SB-INT:SAVE-LISP-AND-DIE for information about how to create a +custom core.) Note that if the Lisp core file is a user-created core +file, it may run a nonstandard toplevel which does not recognize the +standard toplevel options. .TP 3 .B --noinform Suppress the printing of any banner or other informational message at @@ -285,7 +287,7 @@ Runtime options, including any --end-runtime-options option, are stripped out of the command line before the Lisp toplevel logic gets a chance to see it. -Supported toplevel options for the standard SBCL core are +The toplevel options supported by the standard SBCL core are .TP 3 .B --sysinit Load filename instead of the default system-wide initialization file. diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index b074a2e..9445a75 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -339,7 +339,7 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*." "*FLUSH-DEBUG-ERRORS*" "*IN-THE-DEBUGGER*" "*TRACE-INDENTATION-STEP*" "*MAX-TRACE-INDENTATION*" "*TRACE-FRAME*" "*TRACED-FUN-LIST*" - "ARG" "BACKTRACE" "INTERNAL-DEBUG" "VAR" + "ARG" "BACKTRACE" "BACKTRACE-AS-LIST" "INTERNAL-DEBUG" "VAR" "*PRINT-LOCATION-KIND*" "*ONLY-BLOCK-START-LOCATIONS*" "*STACK-TOP-HINT*" "*TRACE-VALUES*" "DO-DEBUG-COMMAND" diff --git a/src/code/debug.lisp b/src/code/debug.lisp index 19f3896..ec3d3b2 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -464,6 +464,20 @@ Other commands: (print-frame-call frame :number t)) (fresh-line *standard-output*) (values)) + +(defun backtrace-as-list (&optional (count most-positive-fixnum)) + #!+sb-doc "Return a list representing the current BACKTRACE." + (do ((reversed-result nil) + (frame (if *in-the-debugger* *current-frame* (sb!di:top-frame)) + (sb!di:frame-down frame)) + (count count (1- count))) + ((or (null frame) (zerop count)) + (nreverse reversed-result)) + (push (frame-call-as-list frame) reversed-result))) + +(defun frame-call-as-list (frame) + (cons (sb!di:debug-fun-name (sb!di:frame-debug-fun frame)) + (frame-args-as-list frame))) ;;;; frame printing @@ -511,44 +525,51 @@ Other commands: (:copier nil)) string) -;;; Print FRAME with verbosity level 1. If we hit a &REST arg, then -;;; print as many of the values as possible, punting the loop over -;;; lambda-list variables since any other arguments will be in the -;;; &REST arg's list of values. -(defun print-frame-call-1 (frame) +;;; Extract the function argument values for a debug frame. +(defun frame-args-as-list (frame) (let ((debug-fun (sb!di:frame-debug-fun frame)) (loc (sb!di:frame-code-location frame)) - (reversed-args nil)) - - ;; Construct function arguments in REVERSED-ARGS. + (reversed-result nil)) (handler-case - (dolist (ele (sb!di:debug-fun-lambda-list debug-fun)) - (lambda-list-element-dispatch ele - :required ((push (frame-call-arg ele loc frame) reversed-args)) - :optional ((push (frame-call-arg (second ele) loc frame) - reversed-args)) - :keyword ((push (second ele) reversed-args) - (push (frame-call-arg (third ele) loc frame) - reversed-args)) - :deleted ((push (frame-call-arg ele loc frame) reversed-args)) - :rest ((lambda-var-dispatch (second ele) loc + (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)) + :keyword ((push (second ele) reversed-result) + (push (frame-call-arg (third ele) loc frame) + reversed-result)) + :deleted ((push (frame-call-arg ele loc frame) reversed-result)) + :rest ((lambda-var-dispatch (second ele) loc nil (progn - (setf reversed-args + (setf reversed-result (append (reverse (sb!di:debug-var-value (second ele) frame)) - reversed-args)) + reversed-result)) (return)) (push (make-unprintable-object "unavailable &REST argument") - reversed-args))))) + reversed-result))))) + ;; As long as we do an ordinary return (as opposed to SIGNALing + ;; a CONDITION) from the DOLIST above: + (nreverse reversed-result)) (sb!di:lambda-list-unavailable () - (push (make-unprintable-object "lambda list unavailable") - reversed-args))) + :lambda-list-unavailable)))) + +;;; Print FRAME with verbosity level 1. If we hit a &REST arg, then +;;; print as many of the values as possible, punting the loop over +;;; lambda-list variables since any other arguments will be in the +;;; &REST arg's list of values. +(defun print-frame-call-1 (frame) + (let ((debug-fun (sb!di:frame-debug-fun frame)) + (loc (sb!di:frame-code-location frame))) (pprint-logical-block (*standard-output* nil :prefix "(" :suffix ")") - (let ((args (nreverse (mapcar #'ensure-printable-object reversed-args)))) + (let ((args (mapcar #'ensure-printable-object + (frame-args-as-list frame)))) ;; Since we go to some trouble to make nice informative function ;; names like (PRINT-OBJECT :AROUND (CLOWN T)), let's make sure ;; that they aren't truncated by *PRINT-LENGTH* and *PRINT-LEVEL*. @@ -992,6 +1013,10 @@ reset to ~S." ;;; potential DEBUG-VAR from the lambda-list, then the second value is ;;; T. If this returns a keyword symbol or a value from a rest arg, ;;; then the second value is NIL. +;;; +;;; FIXME: There's probably some way to merge the code here with +;;; FRAME-ARGS-AS-LIST. (A fair amount of logic is already shared +;;; through LAMBDA-LIST-ELEMENT-DISPATCH, but I suspect more could be.) (declaim (ftype (function (index list)) nth-arg)) (defun nth-arg (count args) (let ((n count)) @@ -1008,8 +1033,7 @@ reset to ~S." :rest ((let ((var (second ele))) (lambda-var-dispatch var (sb!di:frame-code-location *current-frame*) - (error "unused &REST argument before n'th -argument") + (error "unused &REST argument before n'th argument") (dolist (value (sb!di:debug-var-value var *current-frame*) (error diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index 0954011..1c9b4fe 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -239,7 +239,11 @@ bootstrapping. (flet ((ensure (arg ok) (unless ok (error - "invalid argument ~S in the generic function lambda list ~S" + ;; (s/invalid/non-ANSI-conforming/ because the old PCL + ;; implementation allowed this, so people got used to + ;; it, and maybe this phrasing will help them to guess + ;; why their program which worked under PCL no longer works.) + "~@" arg lambda-list)))) (multiple-value-bind (required optional restp rest keyp keys allowp auxp aux morep more-context more-count) diff --git a/version.lisp-expr b/version.lisp-expr index 26981f3..21303f6 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -13,9 +13,9 @@ ;;; ;;; Conventionally a string like "0.6.6", with three numeric fields, ;;; is used for released versions, and a string like "0.6.5.12", with -;;; four numeric fields, is used for versions which aren't released -;;; but correspond only to CVS tags or snapshots. (And occasionally -;;; for internal versions, especially for internal versions off the -;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) +;;; four numeric fields, is used for CVS 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.7.7.21" +"0.7.7.22" -- 1.7.10.4