X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug.lisp;h=0e33618d699a43b9bb43bf3cef4d247efd062a99;hb=2db3b6b4cb740d5b6512459c223859f747807b09;hp=67c791fee8322b037a660d4c122a180f378937c7;hpb=7c5a7fb9e1fb0ade9e31de3ffdf02252669c3d4c;p=sbcl.git

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index 67c791f..0e33618 100644
--- a/src/code/debug.lisp
+++ b/src/code/debug.lisp
@@ -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
 
@@ -1670,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 "~@<can't find a tag for this frame ~
+                   ~2I~_(hint: try increasing the DEBUG optimization quality ~
+                   and recompiling)~:@>"))))
 
 ;;;; debug loop command utilities