X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug.lisp;h=9852810e3bbf85b38c300fdba69b0426ad710e90;hb=f7faed97898dd0e94a18b0d1fca03aaa0fe24ab0;hp=5a5b0f375e438a4201aa9ee574be24e2219180b6;hpb=c2404a2f430ecf57897a795202625dff4764c18d;p=sbcl.git

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index 5a5b0f3..9852810 100644
--- a/src/code/debug.lisp
+++ b/src/code/debug.lisp
@@ -191,9 +191,14 @@ Other commands:
 In the debugger, the current frame is indicated by the prompt. COUNT
 is how many frames to show."
   (fresh-line stream)
-  (map-backtrace (lambda (frame)
-                   (print-frame-call frame stream :number t))
-                 :count count)
+  (let ((*suppress-print-errors* (if (subtypep 'serious-condition *suppress-print-errors*)
+                                     *suppress-print-errors*
+                                     'serious-condition))
+        (*print-circle* t))
+    (handler-bind ((print-not-readable #'print-unreadably))
+        (map-backtrace (lambda (frame)
+                         (print-frame-call frame stream :number t))
+                       :count count)))
   (fresh-line stream)
   (values))
 
@@ -413,21 +418,20 @@ thread, NIL otherwise."
           ;; For the function arguments, we can just print normally.
           (let ((*print-length* nil)
                 (*print-level* nil))
-            (prin1 (ensure-printable-object name) stream))
-          ;; 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.
-          (let ((print-args (ensure-printable-object args))
-                ;; Special case *PRINT-PRETTY* for eval frames: if
-                ;; *PRINT-LINES* is 1, turn off pretty-printing.
-                (*print-pretty*
-                 (if (and (eql 1 *print-lines*)
-                          (member name '(eval simple-eval-in-lexenv)))
-                     nil
-                     *print-pretty*)))
-            (if (listp print-args)
-                (format stream "~{ ~_~S~}" print-args)
-                (format stream " ~S" print-args))))
+            (prin1 name stream))
+          ;; 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. Special case *PRINT-PRETTY* for eval frames:
+          ;; if *PRINT-LINES* is 1, turn off pretty-printing.
+          (let ((*print-pretty*
+                  (if (and (eql 1 *print-lines*)
+                           (member name '(eval simple-eval-in-lexenv)))
+                      nil
+                      *print-pretty*))))
+          (if (listp args)
+              (format stream "~{ ~_~S~}" args)
+              (format stream " ~S" args)))
         (when kind
           (format stream "[~S]" kind))))
   (when (>= verbosity 2)
@@ -583,7 +587,7 @@ reset to ~S."
   ;; definitely preferred, because the FORMAT alternative was acting odd.
   (pprint-logical-block (stream nil)
     (format stream
-            "debugger invoked on a ~S~@[ in thread ~A~]: ~2I~_~A"
+            "debugger invoked on a ~S~@[ in thread ~_~A~]: ~2I~_~A"
             (type-of condition)
             #!+sb-thread sb!thread:*current-thread*
             #!-sb-thread nil
@@ -1601,15 +1605,33 @@ and LDB (the low-level debugger).  See also ENABLE-DEBUGGER."
 
 (!def-debug-command "RESTART-FRAME" ()
   (if (frame-has-debug-tag-p *current-frame*)
-      (let* ((call-list (frame-call-as-list *current-frame*))
-             (fun (fdefinition (car call-list))))
-        (unwind-to-frame-and-call *current-frame*
-                                  (lambda ()
-                                    (apply fun (cdr call-list)))))
+      (multiple-value-bind (fname args) (frame-call *current-frame*)
+        (multiple-value-bind (fun arglist ok)
+            (if (and (legal-fun-name-p fname) (fboundp fname))
+                (values (fdefinition fname) args t)
+                (values (sb!di:debug-fun-fun (sb!di:frame-debug-fun *current-frame*))
+                        (frame-args-as-list *current-frame*)
+                        nil))
+          (when (and fun
+                     (or ok
+                         (y-or-n-p "~@<No global function for the frame, but we ~
+                                    do have access to a function object that we ~
+                                    can try to call -- but if it is normally part ~
+                                    of a closure, then this is NOT going to end well.~_~_~
+                                    Try it anyways?~:@>")))
+            (unwind-to-frame-and-call *current-frame*
+                                      (lambda ()
+                                        ;; Ensure TCO.
+                                        (declare (optimize (debug 0)))
+                                        (apply fun arglist))))
+          (format *debug-io*
+              "Can't restart ~S: no function for frame."
+              *current-frame*)))
       (format *debug-io*
-              "~@<can't find a tag for this frame ~
-                 ~2I~_(hint: try increasing the DEBUG optimization quality ~
-                 and recompiling)~:@>")))
+              "~@<Can't restart ~S: tag not found. ~
+               ~2I~_(hint: try increasing the DEBUG optimization quality ~
+               and recompiling)~:@>"
+              *current-frame*)))
 
 (defun frame-has-debug-tag-p (frame)
   #!+unwind-to-frame-and-call-vop