X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug.lisp;h=7ce7153918114c710e8a19af9045ff8b0b90d30f;hb=69d60b456b07a0256f08df0d02484f361ce5737c;hp=62a2d7131c98434b0ae8353c7fafb349b5adf17b;hpb=7916fca47a2a508fc5e39d60b47821d3f9b5d634;p=sbcl.git diff --git a/src/code/debug.lisp b/src/code/debug.lisp index 62a2d71..7ce7153 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -101,11 +101,13 @@ SB-DEBUG:*FLUSH-DEBUG-ERRORS* controls whether errors at the debug prompt to debugger. 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. + TOPLEVEL, TOP exits debugger and returns to top level REPL + 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: UP up frame DOWN down frame @@ -268,29 +270,44 @@ is how many frames to show." (legal-fun-name-p '(lambda ())) (defvar *show-entry-point-details* nil) +(defun clean-xep (name args) + (values (second name) + (if (consp args) + (let ((count (first args)) + (real-args (rest args))) + (if (fixnump count) + (subseq real-args 0 + (min count (length real-args))) + real-args)) + args))) + +(defun clean-&more-processor (name args) + (values (second name) + (if (consp args) + (let* ((more (last args 2)) + (context (first more)) + (count (second more))) + (append + (butlast args 2) + (if (fixnump count) + (multiple-value-list + (sb!c:%more-arg-values context 0 count)) + (list + (make-unprintable-object "more unavailable arguments"))))) + args))) + (defun frame-call (frame) (labels ((clean-name-and-args (name args) (if (and (consp name) (not *show-entry-point-details*)) + ;; FIXME: do we need to deal with + ;; HAIRY-FUNCTION-ENTRY here? I can't make it or + ;; &AUX-BINDINGS appear in backtraces, so they are + ;; left alone for now. --NS 2005-02-28 (case (first name) ((sb!c::xep sb!c::tl-xep) - (clean-name-and-args - (second name) - (let ((count (first args)) - (real-args (rest args))) - (subseq real-args 0 (min count (length real-args)))))) + (clean-xep name args)) ((sb!c::&more-processor) - (clean-name-and-args - (second name) - (let* ((more (last args 2)) - (context (first more)) - (count (second more))) - (append (butlast args 2) - (multiple-value-list - (sb!c:%more-arg-values context 0 count)))))) - ;; FIXME: do we need to deal with - ;; HAIRY-FUNCTION-ENTRY here? I can't make it or - ;; &AUX-BINDINGS appear in backtraces, so they are - ;; left alone for now. --NS 2005-02-28 + (clean-&more-processor name args)) ((sb!c::hairy-arg-processor sb!c::varargs-entry sb!c::&optional-processor) (clean-name-and-args (second name) args)) @@ -361,7 +378,7 @@ is how many frames to show." (sb!di:debug-condition (ignore) ignore) (error (c) - (format stream "error finding source: ~A" c)))))) + (format stream "~&error finding source: ~A" c)))))) ;;;; INVOKE-DEBUGGER @@ -560,7 +577,7 @@ reset to ~S." (unless (typep condition 'step-condition) (when *debug-beginner-help-p* (format *debug-io* - "~%~@~2%")) (show-restarts *debug-restarts* *debug-io*)) (internal-debug)) @@ -661,6 +678,10 @@ reset to ~S." (incf max-name-len 3)) (dolist (restart restarts) (let ((name (restart-name restart))) + ;; FIXME: maybe it would be better to display later names + ;; in parens instead of brakets, not just omit them fully. + ;; Call BREAK, call BREAK in the debugger, and tell me + ;; it's not confusing looking. --NS 20050310 (cond ((member name names-used) (format s "~& ~2D: ~V@T~A~%" count max-name-len restart)) (t @@ -705,7 +726,7 @@ reset to ~S." (princ condition *debug-io*) (/show0 "handling d-c by THROWing DEBUG-LOOP-CATCHER") (throw 'debug-loop-catcher nil)))) - (fresh-line *debug-io*) + (terpri *debug-io*) (print-frame-call *current-frame* *debug-io* :verbosity 2) (loop (catch 'debug-loop-catcher @@ -1027,16 +1048,6 @@ 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. -;;;(!def-debug-command "TOP" () -;;; (do ((prev *current-frame* lead) -;;; (lead (sb!di:frame-up *current-frame*) (sb!di:frame-up lead))) -;;; ((null lead) -;;; (setf *current-frame* prev) -;;; (print-frame-call prev *debug-io*)))) - (!def-debug-command "BOTTOM" () (do ((prev *current-frame* lead) (lead (sb!di:frame-down *current-frame*) (sb!di:frame-down lead))) @@ -1070,21 +1081,11 @@ reset to ~S." ;;;; commands for entering and leaving the debugger -;;; CMU CL supported this QUIT debug command, but SBCL provides this -;;; functionality with a restart instead. (The QUIT debug command was -;;; removed because it's confusing to have "quit" mean two different -;;; things in the system, "restart the top level REPL" in the debugger -;;; and "terminate the Lisp system" as the SB-EXT:QUIT function.) -;;; -;;;(!def-debug-command "QUIT" () -;;; (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 "C" or -;;; "RESTART CONTINUE", that's OK too). -;;;(!def-debug-command "GO" () -;;; (continue *debug-condition*) -;;; (error "There is no restart named CONTINUE.")) +(!def-debug-command "TOPLEVEL" () + (throw 'toplevel-catcher nil)) + +;;; make T safe +(!def-debug-command-alias "TOP" "TOPLEVEL") (!def-debug-command "RESTART" () (/show0 "doing RESTART debug-command")