X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fdebug.lisp;h=1ebba153adda539b8721b43447ebc6ba6ea4b33b;hb=0b5610d8a220a4b20cbeac958953ca4d67c00038;hp=80ae5cae7642fb56c91f49c1f3df42ce042c41f9;hpb=02ce4b1b927f1312c300047bd5a0db6663a1d2c6;p=sbcl.git diff --git a/src/code/debug.lisp b/src/code/debug.lisp index 80ae5ca..1ebba15 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -34,9 +34,8 @@ #!+sb-doc "This is T while in the debugger.") -(defvar *debug-command-level* 0 - #!+sb-doc - "Pushes and pops/exits inside the debugger change this.") +;;; nestedness inside debugger command loops +(defvar *debug-command-level* 0) (defvar *stack-top-hint* nil #!+sb-doc @@ -47,19 +46,22 @@ (defvar *current-frame* nil) -;;; the default for *DEBUG-PROMPT* -(defun debug-prompt () - (let ((*standard-output* *debug-io*)) - (terpri) - (prin1 (sb!di:frame-number *current-frame*)) - (dotimes (i *debug-command-level*) (princ "]")) - (princ " ") - (force-output))) - -(defparameter *debug-prompt* #'debug-prompt - #!+sb-doc - "a function of no arguments that prints the debugger prompt on *DEBUG-IO*") - +(defun debug-prompt (stream) + + ;; old behavior, will probably go away in sbcl-0.7.x + (format stream "~%~D" (sb!di:frame-number *current-frame*)) + (dotimes (i *debug-command-level*) + (write-char #\] stream)) + (write-char #\space stream) + + ;; planned new behavior, delayed since it will break ILISP + #+nil + (format stream + "~%~D~:[~;[~D~]] " + (sb!di:frame-number *current-frame*) + (> *debug-command-level* 1) + *debug-command-level*)) + (defparameter *debug-help-string* "The prompt is right square brackets, the number indicating how many recursive command loops you are in. @@ -124,8 +126,8 @@ Function and macro commands: #!+sb-doc "When true, list the code location type in the LIST-LOCATIONS command.") -;;; a list of the types of code-locations that should not be stepped to and -;;; should not be listed when listing breakpoints +;;; a list of the types of code-locations that should not be stepped +;;; to and should not be listed when listing breakpoints (defvar *bad-code-location-types* '(:call-site :internal-error)) (declaim (type list *bad-code-location-types*)) @@ -133,12 +135,12 @@ Function and macro commands: (defvar *possible-breakpoints*) (declaim (type list *possible-breakpoints*)) -;;; a list of the made and active breakpoints, each is a breakpoint-info -;;; structure +;;; a list of the made and active breakpoints, each is a +;;; BREAKPOINT-INFO structure (defvar *breakpoints* nil) (declaim (type list *breakpoints*)) -;;; a list of breakpoint-info structures of the made and active step +;;; a list of BREAKPOINT-INFO structures of the made and active step ;;; breakpoints (defvar *step-breakpoints* nil) (declaim (type list *step-breakpoints*)) @@ -163,8 +165,8 @@ Function and macro commands: (setf found t))) first-code-location)) -;;; Return a list of the next code-locations following the one passed. One of -;;; the *BAD-CODE-LOCATION-TYPES* will not be returned. +;;; Return a list of the next code-locations following the one passed. +;;; One of the *BAD-CODE-LOCATION-TYPES* will not be returned. (defun next-code-locations (code-location) (let ((debug-block (sb!di:code-location-debug-block code-location)) (block-code-locations nil)) @@ -199,11 +201,11 @@ Function and macro commands: (push code-location possible-breakpoints)))))) (nreverse possible-breakpoints))) -;;; Searches the info-list for the item passed (code-location, debug-function, -;;; or breakpoint-info). If the item passed is a debug function then kind will -;;; be compared if it was specified. The kind if also compared if a -;;; breakpoint-info is passed since it's in the breakpoint. The info structure -;;; is returned if found. +;;; Searches the info-list for the item passed (code-location, +;;; debug-function, or breakpoint-info). If the item passed is a debug +;;; function then kind will be compared if it was specified. The kind +;;; if also compared if a breakpoint-info is passed since it's in the +;;; breakpoint. The info structure is returned if found. (defun location-in-list (place info-list &optional (kind nil)) (when (breakpoint-info-p place) (setf kind (sb!di:breakpoint-kind (breakpoint-info-breakpoint place))) @@ -225,8 +227,9 @@ Function and macro commands: (eq kind (sb!di:breakpoint-kind y-breakpoint)))))))))) -;;; If Loc is an unknown location, then try to find the block start location. -;;; Used by source printing to some information instead of none for the user. +;;; If LOC is an unknown location, then try to find the block start +;;; location. Used by source printing to some information instead of +;;; none for the user. (defun maybe-block-start-location (loc) (if (sb!di:code-location-unknown-p loc) (let* ((block (sb!di:code-location-debug-block loc)) @@ -244,7 +247,7 @@ Function and macro commands: ;;;; the BREAKPOINT-INFO structure ;;; info about a made breakpoint -(defstruct breakpoint-info +(defstruct (breakpoint-info (:copier nil)) ;; where we are going to stop (place (required-argument) :type (or sb!di:code-location sb!di:debug-function)) @@ -256,12 +259,12 @@ Function and macro commands: ;; the function returned from sb!di:preprocess-for-eval. If result is ;; non-NIL, eval (each) print and print results. (condition #'identity :type function) - ;; the list of functions from sb!di:preprocess-for-eval to evaluate. Results - ;; are conditionally printed. Car of each element is the function, cdr is the - ;; form it goes with. + ;; the list of functions from sb!di:preprocess-for-eval to evaluate. + ;; Results are conditionally printed. Car of each element is the + ;; function, cdr is the form it goes with. (print nil :type list) - ;; the number used when listing the possible breakpoints within a function. - ;; Could also be a symbol such as start or end. + ;; the number used when listing the possible breakpoints within a + ;; function. Could also be a symbol such as start or end. (code-location-number (required-argument) :type (or symbol integer)) ;; the number used when listing the breakpoints active and to delete ;; breakpoints @@ -308,8 +311,8 @@ Function and macro commands: ;;;; MAIN-HOOK-FUNCTION for steps and breakpoints -;;; This must be passed as the hook function. It keeps track of where step -;;; breakpoints are. +;;; This must be passed as the hook function. It keeps track of where +;;; STEP breakpoints are. (defun main-hook-function (current-frame breakpoint &optional return-vals function-end-cookie) (setf *default-breakpoint-debug-function* @@ -444,8 +447,8 @@ Function and macro commands: (eval-when (:compile-toplevel :execute) -;;; This is a convenient way to express what to do for each type of lambda-list -;;; element. +;;; 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 @@ -483,13 +486,14 @@ Function and macro commands: (:print-object (lambda (x s) (print-unreadable-object (x s :type t) (write-string (unprintable-object-string x) - s))))) + s)))) + (:copier nil)) string) -;;; Print frame with verbosity level 1. If we hit a rest-arg, then +;;; 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. +;;; &REST arg's list of values. (defun print-frame-call-1 (frame) (let* ((d-fun (sb!di:frame-debug-function frame)) (loc (sb!di:frame-code-location frame)) @@ -510,12 +514,15 @@ Function and macro commands: (second ele) frame)) results)) (return)) - (push (make-unprintable-object "unavailable &REST arg") + (push (make-unprintable-object + "unavailable &REST argument") results))))) (sb!di:lambda-list-unavailable () (push (make-unprintable-object "lambda list unavailable") results))) - (prin1 (mapcar #'ensure-printable-object (nreverse results))) + (pprint-logical-block (*standard-output* nil) + (let ((x (nreverse (mapcar #'ensure-printable-object results)))) + (format t "(~@<~S~{ ~_~S~}~:>)" (first x) (rest x)))) (when (sb!di:debug-function-kind d-fun) (write-char #\[) (prin1 (sb!di:debug-function-kind d-fun)) @@ -532,12 +539,12 @@ Function and macro commands: (defun frame-call-arg (var location frame) (lambda-var-dispatch var location - (make-unprintable-object "unused arg") + (make-unprintable-object "unused argument") (sb!di:debug-var-value var frame) - (make-unprintable-object "unavailable arg"))) + (make-unprintable-object "unavailable argument"))) -;;; Prints a representation of the function call causing frame to -;;; exist. Verbosity indicates the level of information to output; +;;; Prints a representation of the function call causing FRAME to +;;; exist. VERBOSITY indicates the level of information to output; ;;; zero indicates just printing the debug-function's name, and one ;;; indicates displaying call-like, one-liner format with argument ;;; values. @@ -593,7 +600,7 @@ Function and macro commands: (let ((old-hook *debugger-hook*)) (when old-hook (let ((*debugger-hook* nil)) - (funcall hook condition hook)))) + (funcall old-hook condition old-hook)))) (sb!unix:unix-sigsetmask 0) ;; Elsewhere in the system, we use the SANE-PACKAGE function for @@ -611,14 +618,6 @@ reset to ~S." (with-standard-io-syntax (let* ((*debug-condition* condition) (*debug-restarts* (compute-restarts condition)) - ;; FIXME: The next two bindings seem flaky, violating the - ;; principle of least surprise. But in order to fix them, - ;; we'd need to go through all the i/o statements in the - ;; debugger, since a lot of them do their thing on - ;; *STANDARD-INPUT* and *STANDARD-OUTPUT* instead of - ;; *DEBUG-IO*. - (*standard-input* *debug-io*) ; in case of setq - (*standard-output* *debug-io*) ; '' '' '' '' ;; We want the i/o subsystem to be in a known, useful ;; state, regardless of where the debugger was invoked in ;; the program. WITH-STANDARD-IO-SYNTAX does some of that, @@ -639,22 +638,59 @@ reset to ~S." (*print-readably* nil) (*print-pretty* t) (*package* original-package)) - #!+sb-show (sb!conditions::show-condition *debug-condition* - *error-output*) + + ;; Before we start our own output, finish any pending output. + ;; Otherwise, if the user tried to track the progress of + ;; his program using PRINT statements, he'd tend to lose + ;; the last line of output or so, and get confused. + (flush-standard-output-streams) + + ;; The initial output here goes to *ERROR-OUTPUT*, because the + ;; initial output is not interactive, just an error message, + ;; and when people redirect *ERROR-OUTPUT*, they could + ;; reasonably expect to see error messages logged there, + ;; regardless of what the debugger does afterwards. (format *error-output* - "~2&debugger invoked on ~S of type ~S:~% " - '*debug-condition* + "~2&debugger invoked on condition of type ~S:~% " (type-of *debug-condition*)) (princ-debug-condition-carefully *error-output*) (terpri *error-output*) - (let (;; FIXME: like the bindings of *STANDARD-INPUT* and - ;; *STANDARD-OUTPUT* above.. + + ;; After the initial error/condition/whatever announcement to + ;; *ERROR-OUTPUT*, we become interactive, and should talk on + ;; *DEBUG-IO* from now on. (KLUDGE: This is a normative + ;; statement, not a description of reality.:-| There's a lot of + ;; older debugger code which was written to do i/o on whatever + ;; stream was in fashion at the time, and not all of it has + ;; been converted to behave this way. -- WHN 2000-11-16) + (let (;; FIXME: The first two bindings here seem wrong, + ;; violating the principle of least surprise, and making + ;; it impossible for the user to do reasonable things + ;; like using PRINT at the debugger prompt to send output + ;; to the program's ordinary (possibly + ;; redirected-to-a-file) *STANDARD-OUTPUT*, or using + ;; PEEK-CHAR or some such thing on the program's ordinary + ;; (possibly also redirected) *STANDARD-INPUT*. + (*standard-input* *debug-io*) + (*standard-output* *debug-io*) + ;; This seems reasonable: e.g. if the user has redirected + ;; *ERROR-OUTPUT* to some log file, it's probably wrong + ;; to send errors which occur in interactive debugging to + ;; that file, and right to send them to *DEBUG-IO*. (*error-output* *debug-io*)) (unless (typep condition 'step-condition) - (show-restarts *debug-restarts* *error-output*)) + (format *debug-io* + "~%~@~2%" + '*debug-condition*) + (show-restarts *debug-restarts* *debug-io*) + (terpri *debug-io*)) (internal-debug)))))) -(defun show-restarts (restarts &optional (s *error-output*)) +(defun show-restarts (restarts s) (when restarts (format s "~&restarts:~%") (let ((count 0) @@ -678,18 +714,17 @@ reset to ~S." (push name names-used)))) (incf count))))) -;;; This calls DEBUG-LOOP, performing some simple initializations before doing -;;; so. INVOKE-DEBUGGER calls this to actually get into the debugger. -;;; SB!CONDITIONS::ERROR-ERROR calls this in emergencies to get into a debug -;;; prompt as quickly as possible with as little risk as possible for stepping -;;; on whatever is causing recursive errors. +;;; This calls DEBUG-LOOP, performing some simple initializations +;;; before doing so. INVOKE-DEBUGGER calls this to actually get into +;;; the debugger. SB!KERNEL::ERROR-ERROR calls this in emergencies +;;; to get into a debug prompt as quickly as possible with as little +;;; risk as possible for stepping on whatever is causing recursive +;;; errors. (defun internal-debug () (let ((*in-the-debugger* t) (*read-suppress* nil)) (unless (typep *debug-condition* 'step-condition) - (clear-input *debug-io*) - (format *debug-io* - "~&Within the debugger, you can type HELP for help.~%")) + (clear-input *debug-io*)) #!-mp (debug-loop) #!+mp (sb!mp:without-scheduling (debug-loop)))) @@ -733,7 +768,8 @@ reset to ~S." (with-simple-restart (abort "Reduce debugger level (to debug level ~D)." level) - (funcall *debug-prompt*) + (debug-prompt *debug-io*) + (force-output *debug-io*) (let ((input (sb!int:get-stream-command *debug-io*))) (cond (input (let ((cmd-fun (debug-command-p @@ -762,20 +798,34 @@ reset to ~S." (t (funcall cmd-fun))))))))))))))) -(defvar *auto-eval-in-frame* t +;;; FIXME: As far as I know, the CMU CL X86 codebase has never +;;; supported access to the environment of the debugged function. It +;;; would be really, really nice to make that work! (Until then, +;;; non-NIL *AUTO-EVAL-IN-FRAME* seems to be useless, and as of +;;; sbcl-0.6.10 it even seemed to be actively harmful, since the +;;; debugger gets confused when trying to unwind the frames which +;;; arise in SIGINT interrupts. So it's set to NIL.) +(defvar *auto-eval-in-frame* nil #!+sb-doc - "When set (the default), evaluations in the debugger's command loop occur - relative to the current frame's environment without the need of debugger - forms that explicitly control this kind of evaluation.") + "When set, evaluations in the debugger's command loop occur relative + to the current frame's environment without the need of debugger + forms that explicitly control this kind of evaluation. In an ideal + world, the default would be T, but since unfortunately the X86 + debugger support isn't good enough to make this useful, the + default is NIL instead.") ;;; FIXME: We could probably use INTERACTIVE-EVAL for much of this logic. -(defun debug-eval-print (exp) - (setq +++ ++ ++ + + - - exp) +(defun debug-eval-print (expr) + (/noshow "entering DEBUG-EVAL-PRINT" expr) + (/noshow (fboundp 'compile)) + (/noshow (and (fboundp 'compile) *auto-eval-in-frame*)) + (setq +++ ++ ++ + + - - expr) (let* ((values (multiple-value-list (if (and (fboundp 'compile) *auto-eval-in-frame*) (sb!di:eval-in-frame *current-frame* -) (eval -)))) (*standard-output* *debug-io*)) + (/noshow "done with EVAL in DEBUG-EVAL-PRINT") (fresh-line) (if values (prin1 (car values))) (dolist (x (cdr values)) @@ -787,15 +837,13 @@ reset to ~S." (unless (boundp '*) (setq * nil) (fresh-line) - ;; FIXME: Perhaps this shouldn't be WARN (for fear of complicating - ;; the debugging situation?) but at least it should go to *ERROR-OUTPUT*. - ;; (And probably it should just be WARN.) + ;; FIXME: The way INTERACTIVE-EVAL does this seems better. (princ "Setting * to NIL (was unbound marker).")))) ;;;; debug loop functions -;;; These commands are functions, not really commands, so that users can get -;;; their hands on the values returned. +;;; These commands are functions, not really commands, so that users +;;; can get their hands on the values returned. (eval-when (:execute :compile-toplevel) @@ -824,8 +872,8 @@ reset to ~S." `(setf (sb!di:debug-var-value (car vars) *current-frame*) ,value-var)))) (t - ;; Since we have more than one, first see whether we have any - ;; variables that exactly match the specification. + ;; Since we have more than one, first see whether we have + ;; any variables that exactly match the specification. (let* ((name (etypecase name (symbol (symbol-name name)) (simple-string name))) @@ -847,8 +895,9 @@ reset to ~S." (:set `(setf (sb!di:debug-var-value (car vars) *current-frame*) ,value-var)))) - ;; If there weren't any exact matches, flame about ambiguity - ;; unless all the variables have the same name. + ;; If there weren't any exact matches, flame about + ;; ambiguity unless all the variables have the same + ;; name. ((and (not exact) (find-if-not #'(lambda (v) @@ -860,8 +909,8 @@ reset to ~S." (delete-duplicates vars :test #'string= :key #'sb!di:debug-var-symbol-name)))) - ;; All names are the same, so see whether the user ID'ed one of - ;; them. + ;; All names are the same, so see whether the user + ;; ID'ed one of them. (id-supplied (let ((v (find id vars :key #'sb!di:debug-var-id))) (unless v @@ -882,9 +931,11 @@ reset to ~S." ) ; EVAL-WHEN +;;; FIXME: This doesn't work. It would be real nice we could make it +;;; work! Alas, it doesn't seem to work in CMU CL X86 either.. (defun var (name &optional (id 0 id-supplied)) #!+sb-doc - "Returns a variable's value if possible. Name is a simple-string or symbol. + "Return a variable's value if possible. NAME is a simple-string or symbol. If it is a simple-string, it is an initial substring of the variable's name. If name is a symbol, it has the same name and package as the variable whose value this function returns. If the symbol is uninterned, then the variable @@ -903,11 +954,11 @@ reset to ~S." (defun (setf var) (value name &optional (id 0 id-supplied)) (define-var-operation :set value)) -;;; This returns the COUNT'th arg as the user sees it from args, the result of -;;; SB!DI:DEBUG-FUNCTION-LAMBDA-LIST. If this returns a 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. +;;; This returns the COUNT'th arg as the user sees it from args, the +;;; result of SB!DI:DEBUG-FUNCTION-LAMBDA-LIST. If this returns a +;;; 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. (declaim (ftype (function (index list)) nth-arg)) (defun nth-arg (count args) (let ((n count)) @@ -924,7 +975,8 @@ reset to ~S." :rest ((let ((var (second ele))) (lambda-var-dispatch var (sb!di:frame-code-location *current-frame*) - (error "unused REST-arg before n'th argument") + (error "unused &REST argument before n'th +argument") (dolist (value (sb!di:debug-var-value var *current-frame*) (error @@ -933,7 +985,7 @@ reset to ~S." (if (zerop n) (return-from nth-arg (values value nil)) (decf n))) - (error "invalid REST-arg before n'th argument"))))) + (error "invalid &REST argument before n'th argument"))))) (decf n)))) (defun arg (n) @@ -979,12 +1031,13 @@ reset to ~S." (push (cons new-name (cdr pair)) *debug-commands*)) new-name) -;;; This takes a symbol and uses its name to find a debugger command, using -;;; initial substring matching. It returns the command function if form -;;; identifies only one command, but if form is ambiguous, this returns a list -;;; of the command names. If there are no matches, this returns nil. Whenever -;;; the loop that looks for a set of possibilities encounters an exact name -;;; match, we return that command function immediately. +;;; This takes a symbol and uses its name to find a debugger command, +;;; using initial substring matching. It returns the command function +;;; if form identifies only one command, but if form is ambiguous, +;;; this returns a list of the command names. If there are no matches, +;;; this returns nil. Whenever the loop that looks for a set of +;;; possibilities encounters an exact name match, we return that +;;; command function immediately. (defun debug-command-p (form &optional other-commands) (if (or (symbolp form) (integerp form)) (let* ((name @@ -1021,25 +1074,25 @@ reset to ~S." ((not cmds) res) (setf (car cmds) (caar cmds)))))))) -;;; Returns a list of debug commands (in the same format as *debug-commands*) -;;; that invoke each active restart. +;;; Return a list of debug commands (in the same format as +;;; *debug-commands*) that invoke each active restart. ;;; -;;; Two commands are made for each restart: one for the number, and one for -;;; the restart name (unless it's been shadowed by an earlier restart of the -;;; same name). +;;; Two commands are made for each restart: one for the number, and +;;; one for the restart name (unless it's been shadowed by an earlier +;;; restart of the same name, or it is NIL). (defun make-restart-commands (&optional (restarts *debug-restarts*)) (let ((commands) (num 0)) ; better be the same as show-restarts! (dolist (restart restarts) (let ((name (string (restart-name restart)))) - (unless (find name commands :key #'car :test #'string=) - (let ((restart-fun - #'(lambda () - (invoke-restart-interactively restart)))) - (push (cons name restart-fun) commands) - (push (cons (format nil "~D" num) restart-fun) commands)))) - (incf num)) - commands)) + (let ((restart-fun + #'(lambda () (invoke-restart-interactively restart)))) + (push (cons (format nil "~d" num) restart-fun) commands) + (unless (or (null (restart-name restart)) + (find name commands :key #'car :test #'string=)) + (push (cons name restart-fun) commands)))) + (incf num)) + commands)) ;;;; frame-changing commands @@ -1061,9 +1114,9 @@ reset to ~S." (def-debug-command-alias "D" "DOWN") -;;; CMU CL had this command, but SBCL doesn't, since -;;; it's redundant with "FRAME 0", and it interferes with abbreviations -;;; for the TOPLEVEL restart. +;;; CMU CL had this command, but SBCL doesn't, since it's redundant +;;; with "FRAME 0", and it interferes with abbreviations for the +;;; TOPLEVEL restart. ;;;(def-debug-command "TOP" () ;;; (do ((prev *current-frame* lead) ;;; (lead (sb!di:frame-up *current-frame*) (sb!di:frame-up lead))) @@ -1122,7 +1175,7 @@ reset to ~S." (def-debug-command "RESTART" () (let ((num (read-if-available :prompt))) (when (eq num :prompt) - (show-restarts *debug-restarts*) + (show-restarts *debug-restarts* *debug-io*) (write-string "restart: ") (force-output) (setf num (read *standard-input*))) @@ -1161,8 +1214,8 @@ reset to ~S." (def-debug-command-alias "?" "HELP") (def-debug-command "ERROR" () - (format t "~A~%" *debug-condition*) - (show-restarts *debug-restarts*)) + (format *debug-io* "~A~%" *debug-condition*) + (show-restarts *debug-restarts* *debug-io*)) (def-debug-command "BACKTRACE" () (backtrace (read-if-available most-positive-fixnum))) @@ -1212,8 +1265,9 @@ reset to ~S." ;;;; source location printing -;;; We cache a stream to the last valid file debug source so that we won't have -;;; to repeatedly open the file. +;;; We cache a stream to the last valid file debug source so that we +;;; won't have to repeatedly open the file. +;;; ;;; KLUDGE: This sounds like a bug, not a feature. Opening files is fast ;;; in the 1990s, so the benefit is negligible, less important than the ;;; potential of extra confusion if someone changes the source during @@ -1236,16 +1290,17 @@ reset to ~S." *cached-readtable* nil)) sb!int:*before-save-initializations*) -;;; We also cache the last top-level form that we printed a source for so that -;;; we don't have to do repeated reads and calls to FORM-NUMBER-TRANSLATIONS. +;;; We also cache the last top-level form that we printed a source for +;;; so that we don't have to do repeated reads and calls to +;;; FORM-NUMBER-TRANSLATIONS. (defvar *cached-top-level-form-offset* nil) (declaim (type (or index null) *cached-top-level-form-offset*)) (defvar *cached-top-level-form*) (defvar *cached-form-number-translations*) -;;; Given a code location, return the associated form-number translations and -;;; the actual top-level form. We check our cache --- if there is a miss, we -;;; dispatch on the kind of the debug source. +;;; Given a code location, return the associated form-number +;;; translations and the actual top-level form. We check our cache --- +;;; if there is a miss, we dispatch on the kind of the debug source. (defun get-top-level-form (location) (let ((d-source (sb!di:code-location-debug-source location))) (if (and (eq d-source *cached-debug-source*) @@ -1262,9 +1317,9 @@ reset to ~S." (sb!di:form-number-translations res offset)) (setq *cached-top-level-form* res)))))) -;;; Locates the source file (if it still exists) and grabs the top-level form. -;;; If the file is modified, we use the top-level-form offset instead of the -;;; recorded character offset. +;;; Locate the source file (if it still exists) and grab the top-level +;;; form. If the file is modified, we use the top-level-form offset +;;; instead of the recorded character offset. (defun get-file-top-level-form (location) (let* ((d-source (sb!di:code-location-debug-source location)) (tlf-offset (sb!di:code-location-top-level-form-offset location)) @@ -1538,7 +1593,7 @@ reset to ~S." (if function (describe function) (format t "can't figure out the function for this frame")))) - + < ;;;; debug loop command utilities (defun read-prompting-maybe (prompt &optional (in *standard-input*)