X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fdebug.lisp;h=0e33618d699a43b9bb43bf3cef4d247efd062a99;hb=6ef051b23f4b54081aaf119ba8be523c4e014b80;hp=c582585726e3acb09bb0f260707df338720656b1;hpb=4217a388a178099c43202df208c78ca81e0d9d1f;p=sbcl.git diff --git a/src/code/debug.lisp b/src/code/debug.lisp index c582585..0e33618 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -78,9 +78,9 @@ *debug-command-level*)) (defparameter *debug-help-string* -"The prompt is square brackets, with number(s) indicating the current control - stack level and, if you've entered the debugger recursively, how deeply - recursed you are. +"The debug prompt is square brackets, with number(s) indicating the current + control stack level and, if you've entered the debugger recursively, how + deeply recursed you are. Any command -- including the name of a restart -- may be uniquely abbreviated. The debugger rebinds various special variables for controlling i/o, sometimes to defaults (much like WITH-STANDARD-IO-SYNTAX does) and sometimes to @@ -94,8 +94,8 @@ Getting in and out of the debugger: RESTART invokes restart numbered as shown (prompt if not given). ERROR prints the error condition and restart cases. The number of any restart, or its name, or a unique abbreviation for its - name, is a valid command, and is the same as using RESTART to invoke that - restart. + name, is a valid command, and is the same as using RESTART to invoke + that restart. Changing frames: U up frame D down frame @@ -122,17 +122,20 @@ Breakpoints and steps: STEP [n] Step to the next location or step n times. Function and macro commands: - (SB-DEBUG:DEBUG-RETURN expression) - Exit the debugger, returning expression's values from the current frame. (SB-DEBUG:ARG n) Return the n'th argument in the current frame. (SB-DEBUG:VAR string-or-symbol [id]) Returns the value of the specified variable in the current frame. Other commands: - SLURP Discard all pending input on *STANDARD-INPUT*. (This can be - useful when the debugger was invoked to handle an error in - deeply nested input syntax, and now the reader is confused.)") + RETURN expr + [EXPERIMENTAL] Return the values resulting from evaluation of expr + from the current frame, if this frame was compiled with a sufficiently + high DEBUG optimization quality. + SLURP + Discard all pending input on *STANDARD-INPUT*. (This can be + useful when the debugger was invoked to handle an error in + deeply nested input syntax, and now the reader is confused.)") ;;; This is used to communicate to DEBUG-LOOP that we are at a step breakpoint. (define-condition step-condition (simple-condition) ()) @@ -557,19 +560,17 @@ Other commands: (nreverse reversed-result)) (sb!di:lambda-list-unavailable () - :lambda-list-unavailable)))) + (make-unprintable-object "unavailable lambda list"))))) ;;; 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))) + (let ((debug-fun (sb!di:frame-debug-fun frame))) (pprint-logical-block (*standard-output* nil :prefix "(" :suffix ")") - (let ((args (mapcar #'ensure-printable-object - (frame-args-as-list frame)))) + (let ((args (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*. @@ -577,7 +578,9 @@ Other commands: (*print-level* nil)) (prin1 (ensure-printable-object (sb!di:debug-fun-name debug-fun)))) ;; For the function arguments, we can just print normally. - (format t "~{ ~_~S~}" args))) + (if (listp args) + (format t "~{ ~_~S~}" args) + (format t " ~S" args)))) (when (sb!di:debug-fun-kind debug-fun) (write-char #\[) @@ -811,8 +814,7 @@ reset to ~S." (*read-suppress* nil)) (unless (typep *debug-condition* 'step-condition) (clear-input *debug-io*)) - #!-mp (debug-loop) - #!+mp (sb!mp:without-scheduling (debug-loop)))) + (debug-loop))) ;;;; DEBUG-LOOP @@ -855,7 +857,7 @@ reset to ~S." (let ((level *debug-command-level*) (restart-commands (make-restart-commands))) (with-simple-restart (abort - "Reduce debugger level (to debug level ~W)." + "~@" level) (debug-prompt *debug-io*) (force-output *debug-io*) @@ -1239,9 +1241,8 @@ reset to ~S." ;;; (throw 'sb!impl::toplevel-catcher nil)) ;;; CMU CL supported this GO debug command, but SBCL doesn't -- in -;;; SBCL you just type the CONTINUE restart name instead (or "RESTART -;;; CONTINUE", that's OK too). - +;;; SBCL you just type the CONTINUE restart name instead (or "C" or +;;; "RESTART CONTINUE", that's OK too). ;;;(!def-debug-command "GO" () ;;; (continue *debug-condition*) ;;; (error "There is no restart named CONTINUE.")) @@ -1671,6 +1672,24 @@ reset to ~S." (!def-debug-command "SLURP" () (loop while (read-char-no-hang *standard-input*))) + +(!def-debug-command "RETURN" (&optional + (return (read-prompting-maybe + "return: "))) + (let ((tag (find-if (lambda (x) + (and (typep (car x) 'symbol) + (not (symbol-package (car x))) + (string= (car x) "SB-DEBUG-CATCH-TAG"))) + (sb!di::frame-catches *current-frame*)))) + (if tag + (throw (car tag) + (funcall (sb!di:preprocess-for-eval + return + (sb!di:frame-code-location *current-frame*)) + *current-frame*)) + (format t "~@")))) ;;;; debug loop command utilities