;;; nestedness inside debugger command loops
(defvar *debug-command-level* 0)
-(defvar *stack-top-hint* nil
- #!+sb-doc
- "If this is bound before the debugger is invoked, it is used as the stack
- top by the debugger.")
+;;; If this is bound before the debugger is invoked, it is used as the
+;;; stack top by the debugger.
+(defvar *stack-top-hint* nil)
+
(defvar *stack-top* nil)
(defvar *real-stack-top* nil)
(defvar *current-frame* nil)
+;;; Beginner-oriented help messages are important because you end up
+;;; in the debugger whenever something bad happens, or if you try to
+;;; get out of the system with Ctrl-C or (EXIT) or EXIT or whatever.
+;;; But after memorizing them the wasted screen space gets annoying..
+(defvar *debug-beginner-help-p* t
+ "Should the debugger display beginner-oriented help messages?")
+
(defun debug-prompt (stream)
;; old behavior, will probably go away in sbcl-0.7.x
(setf next-list (next-code-locations (first next-list))))
next-list)))
-;;; Returns a list of code-locations of the possible breakpoints of the
+;;; Return a list of code-locations of the possible breakpoints of the
;;; debug-function passed.
(defun possible-breakpoints (debug-function)
(let ((possible-breakpoints nil))
(push code-location possible-breakpoints))))))
(nreverse possible-breakpoints)))
-;;; Searches the info-list for the item passed (code-location,
+;;; Search 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
:type (or sb!di:code-location sb!di:debug-function))
;; the breakpoint returned by sb!di:make-breakpoint
(breakpoint (required-argument) :type sb!di:breakpoint)
- ;; the function returned from sb!di:preprocess-for-eval. If result is
+ ;; the function returned from SB!DI:PREPROCESS-FOR-EVAL. If result is
;; non-NIL, drop into the debugger.
(break #'identity :type function)
;; the function returned from sb!di:preprocess-for-eval. If result is
(*standard-output* *debug-io*))
#!+sb-doc
"Show a listing of the call stack going down from the current frame. In the
- debugger, the current frame is indicated by the prompt. Count is how many
+ debugger, the current frame is indicated by the prompt. COUNT is how many
frames to show."
(fresh-line *standard-output*)
(do ((frame (if *in-the-debugger* *current-frame* (sb!di:top-frame))
(defvar *debug-restarts*)
(defvar *debug-condition*)
-;;; Print *DEBUG-CONDITION*, taking care to avoid recursive invocation
-;;; of the debugger in case of a problem (e.g. a bug in the PRINT-OBJECT
-;;; method for *DEBUG-CONDITION*).
-(defun princ-debug-condition-carefully (stream)
- (handler-case (princ *debug-condition* stream)
- (error (condition)
- (format stream
- " (caught ~S when trying to print ~S)"
- (type-of condition)
- '*debug-condition*)))
- *debug-condition*)
-
(defun invoke-debugger (condition)
#!+sb-doc
"Enter the debugger."
;; the last line of output or so, and get confused.
(flush-standard-output-streams)
- ;; The initial output here goes to *ERROR-OUTPUT*, because the
+ ;; (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 condition of type ~S:~% "
- (type-of *debug-condition*))
- (princ-debug-condition-carefully *error-output*)
- (terpri *error-output*)
+ ;; regardless of what the debugger does afterwards.)
+ (handler-case
+ (format *error-output*
+ "~2&~@<debugger invoked on condition of type ~S: ~
+ ~2I~_~A~:>~%"
+ (type-of *debug-condition*)
+ *debug-condition*)
+ (error (condition)
+ (format *error-output*
+ "~&(caught ~S trying to print ~S when entering debugger)~%"
+ (type-of condition)
+ '*debug-condition*)))
;; After the initial error/condition/whatever announcement to
;; *ERROR-OUTPUT*, we become interactive, and should talk on
;; that file, and right to send them to *DEBUG-IO*.
(*error-output* *debug-io*))
(unless (typep condition 'step-condition)
- (format *debug-io*
- "~%~@<Within the debugger, you can type HELP for help. At ~
- any command prompt (within the debugger or not) you can ~
- type (SB-EXT:QUIT) to terminate the SBCL executable. ~
- The condition which caused the debugger to be entered ~
- is bound to ~S.~:@>~2%"
- '*debug-condition*)
- (show-restarts *debug-restarts* *debug-io*)
- (terpri *debug-io*))
+ (when *debug-beginner-help-p*
+ (format *debug-io*
+ "~%~@<Within the debugger, you can type HELP for help. ~
+ At any command prompt (within the debugger or not) you ~
+ can type (SB-EXT:QUIT) to terminate the SBCL ~
+ executable. The condition which caused the debugger to ~
+ be entered is bound to ~S. You can suppress this ~
+ message by clearing ~S.~:@>~2%"
+ '*debug-condition*
+ '*debug-beginner-help-p*))
+ (show-restarts *debug-restarts* *debug-io*))
(internal-debug))))))
(defun show-restarts (restarts s)
(t
(funcall cmd-fun)))))))))))))))
-;;; 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, 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 (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 -))))
+ (let* ((values (multiple-value-list (eval -)))
(*standard-output* *debug-io*))
(/noshow "done with EVAL in DEBUG-EVAL-PRINT")
(fresh-line)
;;;(!def-debug-command "QUIT" ()
;;; (throw 'sb!impl::top-level-catcher nil))
-;;; CMU CL supported this GO debug command, but SBCL doesn't -- just
-;;; type the CONTINUE restart name.
+;;; 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).
+
;;;(!def-debug-command "GO" ()
;;; (continue *debug-condition*)
;;; (error "There is no restart named CONTINUE."))
;; desperate holdout is running this on a dumb terminal somewhere,
;; we tell him where to find the message stored as a string.
(format *debug-io*
- "~&~a~2%(The HELP string is stored in ~S.)~%"
+ "~&~A~2%(The HELP string is stored in ~S.)~%"
*debug-help-string*
'*debug-help-string*))
(defvar *cached-readtable* nil)
(declaim (type (or readtable null) *cached-readtable*))
-(pushnew #'(lambda ()
- (setq *cached-debug-source* nil *cached-source-stream* nil
- *cached-readtable* nil))
- sb!int:*before-save-initializations*)
+(pushnew (lambda ()
+ (setq *cached-debug-source* nil *cached-source-stream* nil
+ *cached-readtable* nil))
+ *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
(if function
(describe function)
(format t "can't figure out the function for this frame"))))
-\f<
+\f
;;;; debug loop command utilities
(defun read-prompting-maybe (prompt &optional (in *standard-input*)
projects / sbcl.git / blobdiff