X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fdebug.lisp;h=cf7f9dbc5d760a5f2eebdbf1d4f9ab19038dc4df;hb=f409f90c5e8c4c87ed9fa6efdc0e5c1952d94602;hp=3fa6b09fa54cce81b34190a2cefe308765e468bd;hpb=650499e7ae935d53cc1e0de6fc73e10dca5be253;p=sbcl.git

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index 3fa6b09..cf7f9db 100644
--- a/src/code/debug.lisp
+++ b/src/code/debug.lisp
@@ -71,6 +71,7 @@
   "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*)
@@ -446,9 +447,10 @@ Other commands:
 ;;; 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))
 
 ;;;; BACKTRACE
@@ -650,6 +652,9 @@ Other commands:
       (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
@@ -703,6 +708,7 @@ reset to ~S."
 	   (*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.
@@ -747,6 +753,10 @@ reset to ~S."
        ;; 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
@@ -773,7 +783,8 @@ reset to ~S."
 		     '*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)
@@ -781,7 +792,8 @@ reset to ~S."
 		 "~&(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))
@@ -814,8 +826,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))))
+    (funcall *debug-loop-fun*)))
 
 ;;;; DEBUG-LOOP
 
@@ -826,7 +837,7 @@ reset to ~S."
   "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*))
@@ -862,33 +873,20 @@ reset to ~S."
 				    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)