X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug.lisp;h=014103c51b622d7664018a449905d23b1275ce2e;hb=f3491f128307938cc56367f739b8fbf9e5d503b6;hp=deb0be912195c0013dc5a876768061e9ecdcb5df;hpb=bddb383d464b924f1066f1733fe8e2407e7d9283;p=sbcl.git

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index deb0be9..014103c 100644
--- a/src/code/debug.lisp
+++ b/src/code/debug.lisp
@@ -1267,19 +1267,29 @@ and LDB (the low-level debugger).  See also ENABLE-DEBUGGER."
               (location (sb!di:frame-code-location *current-frame*))
               (prefix (read-if-available nil))
               (any-p nil)
-              (any-valid-p nil))
+              (any-valid-p nil)
+              (more-context nil)
+              (more-count nil))
           (dolist (v (sb!di:ambiguous-debug-vars
-                        d-fun
-                        (if prefix (string prefix) "")))
+                      d-fun
+                      (if prefix (string prefix) "")))
             (setf any-p t)
             (when (eq (sb!di:debug-var-validity v location) :valid)
               (setf any-valid-p t)
+              (case (sb!di::debug-var-info v)
+                (:more-context
+                 (setf more-context (sb!di:debug-var-value v *current-frame*)))
+                (:more-count
+                 (setf more-count (sb!di:debug-var-value v *current-frame*))))
               (format *debug-io* "~S~:[#~W~;~*~]  =  ~S~%"
                       (sb!di:debug-var-symbol v)
                       (zerop (sb!di:debug-var-id v))
                       (sb!di:debug-var-id v)
                       (sb!di:debug-var-value v *current-frame*))))
-
+          (when (and more-context more-count)
+            (format *debug-io* "~S  =  ~S~%"
+                    'more
+                    (multiple-value-list (sb!c:%more-arg-values more-context 0 more-count))))
           (cond
            ((not any-p)
             (format *debug-io*
@@ -1591,15 +1601,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