"Should the debugger display beginner-oriented help messages?")
(defun debug-prompt (stream)
+ (sb!thread::get-foreground)
(format stream
"~%~W~:[~;[~W~]] "
(sb!di:frame-number *current-frame*)
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.)")
\f
;;; This is used to communicate to DEBUG-LOOP that we are at a step breakpoint.
(define-condition step-condition (simple-condition) ())
;;; ANSI specifies that this macro shall exist, even if only as a
;;; trivial placeholder like this.
(defmacro step (form)
- "a trivial placeholder implementation of the CL:STEP macro required by
- the ANSI spec"
- `(progn
+ "This is a trivial placeholder implementation of the CL:STEP macro required
+ by the ANSI spec, simply expanding to `(LET () ,FORM). A more featureful
+ version would be welcome, we just haven't written it."
+ `(let ()
,form))
\f
;;;; BACKTRACE
(let ((*debugger-hook* nil))
(funcall old-hook condition old-hook))))
+ ;; If we're a background thread and *background-threads-wait-for-debugger*
+ ;; is NIL, this will invoke a restart
+
;; Note: CMU CL had (SB-UNIX:UNIX-SIGSETMASK 0) here. I deleted it
;; around sbcl-0.7.8.5 (by which time it had mutated to have a
;; #!-SUNOS prefix and a FIXME note observing that it wasn't needed
(*readtable* *debug-readtable*)
(*print-readably* nil)
(*package* original-package)
+ (background-p nil)
(*print-pretty* original-print-pretty))
;; Before we start our own output, finish any pending output.
;; 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)
+
+ (setf background-p
+ (sb!thread::debugger-wait-until-foreground-thread *debug-io*))
+ (unwind-protect
(let (;; FIXME: Rebinding *STANDARD-OUTPUT* here seems wrong,
;; violating the principle of least surprise, and making
;; it impossible for the user to do reasonable things
'*debug-condition*
'*debug-beginner-help-p*))
(show-restarts *debug-restarts* *debug-io*))
- (internal-debug))))))
+ (internal-debug))
+ (when background-p (sb!thread::release-foreground)))))))
(defun show-restarts (restarts s)
(cond ((null restarts)
"~&(no restarts: If you didn't do this on purpose, ~
please report it as a bug.)~%"))
(t
- (format s "~&restarts:~%")
+ (format s "~&restarts (invokable by number or by ~
+ possibly-abbreviated name):~%")
(let ((count 0)
(names-used '(nil))
(max-name-len 0))
(*read-suppress* nil))
(unless (typep *debug-condition* 'step-condition)
(clear-input *debug-io*))
- #!-mp (debug-loop)
- #!+mp (sb!mp:without-scheduling (debug-loop))))
+ (funcall *debug-loop-fun*)))
\f
;;;; DEBUG-LOOP
"When set, avoid calling INVOKE-DEBUGGER recursively when errors occur while
executing in the debugger.")
-(defun debug-loop ()
+(defun debug-loop-fun ()
(let* ((*debug-command-level* (1+ *debug-command-level*))
(*real-stack-top* (sb!di:top-frame))
(*stack-top* (or *stack-top-hint* *real-stack-top*))
level)
(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
- (sb!int:stream-command-name input)
- restart-commands)))
- (cond
- ((not cmd-fun)
- (error "unknown stream-command: ~S" input))
- ((consp cmd-fun)
- (error "ambiguous debugger command: ~S" cmd-fun))
- (t
- (apply cmd-fun
- (sb!int:stream-command-args input))))))
+ (let* ((exp (read *debug-io*))
+ (cmd-fun (debug-command-p exp restart-commands)))
+ (cond ((not cmd-fun)
+ (debug-eval-print exp))
+ ((consp cmd-fun)
+ (format t "~&Your command, ~S, is ambiguous:~%"
+ exp)
+ (dolist (ele cmd-fun)
+ (format t " ~A~%" ele)))
(t
- (let* ((exp (read *debug-io*))
- (cmd-fun (debug-command-p exp
- restart-commands)))
- (cond ((not cmd-fun)
- (debug-eval-print exp))
- ((consp cmd-fun)
- (format t
- "~&Your command, ~S, is ambiguous:~%"
- exp)
- (dolist (ele cmd-fun)
- (format t " ~A~%" ele)))
- (t
- (funcall cmd-fun)))))))))))))))
+ (funcall cmd-fun))))))))))))
+
+(defvar *debug-loop-fun* #'debug-loop-fun
+ "a function taking no parameters that starts the low-level debug loop")
;;; FIXME: We could probably use INTERACTIVE-EVAL for much of this logic.
(defun debug-eval-print (expr)
(!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 "~@<can't find a tag for this frame ~
+ ~2I~_(hint: try increasing the DEBUG optimization quality ~
+ and recompiling)~:@>"))))
\f
;;;; debug loop command utilities
projects / sbcl.git / blobdiff