Changeset 9725 for branches

Timestamp:

Jun 10, 2008, 5:53:33 AM (16 years ago)

Author:

marco baringer

Message:

Make sure printed list of restarts reflects currently available restarts.

If we want to print a list of restarts before the debugger prompt we need to
make sure that compute-restarts is called late enough that no new restarts will
be defined.

File:

• branches/working-0711/ccl/level-1/l1-readloop-lds.lisp (modified) (8 diffs)

branches/working-0711/ccl/level-1/l1-readloop-lds.lisp

@@ -96 +96 @@
 (define-toplevel-command :break q () "return to toplevel" (toplevel))
 (define-toplevel-command :break r () "list restarts"
-  (format t "~&   (:C <n>) can be used to invoke one of the following restarts in this break loop:")
-  (let* ((r (apply #'vector (compute-restarts *break-condition*))))
-    (dotimes (i (length r) (terpri))
-      (format *debug-io* "~&~d. ~a" i (svref r i)))))
-
-;;; From Marco Baringer 2003/03/18
+  (format *debug-io* "~&   (:C <n>) can be used to invoke one of the following restarts in this break loop:")
+  (display-restarts))
 
 (define-toplevel-command :break set (n frame value) "Set <n>th item of frame <frame> to <value>"
@@ -279 +275 @@
                        (output-stream *standard-output*)
                        (break-level *break-level*)
-                       (prompt-function #'(lambda (stream) (print-listener-prompt stream t))))
+                       (prompt-function #'(lambda (stream)
+                                            (when (and *show-available-restarts* *break-condition*)
+                                              (display-restarts)
+                                              (setf *show-available-restarts* nil))
+                                            (print-listener-prompt stream t))))
   (let* ((*break-level* break-level)
          (*last-break-level* break-level)
@@ -285 +285 @@
          *in-read-loop*
          *** ** * +++ ++ + /// // / -
-         (eof-value (cons nil nil)))
+         (eof-value (cons nil nil))
+         (*show-available-restarts* (and *show-restarts-on-break* *break-condition*)))
     (declare (dynamic-extent eof-value))
     (loop
@@ -565 +566 @@
 (defvar *break-loop-when-uninterruptable* t)
 (defvar *show-restarts-on-break* #+ccl-0711 t #-ccl-0711 nil)
+(defvar *show-available-restarts* nil)
 
 (defvar *error-reentry-count* 0)
@@ -611 +613 @@
            (*backtrace-contexts* (cons context *backtrace-contexts*)))
       (with-toplevel-commands :break
-        (if *show-restarts-on-break*
-          (let ((*print-circle* *error-print-circle*)
-                (*print-level* *backtrace-print-level*)
-                (*print-length* *backtrace-print-length*)
-                                        ;(*print-pretty* nil)
-                (*print-array* nil))
-            (format t "~&> Type :POP to abort, or :C <n> to invoke one of the following restarts:")
-            (let* ((r (apply #'vector (compute-restarts *break-condition*))))
-              (dotimes (i (length r) (terpri))
-                (format t "~&~d. ~a" i (svref r i)))))
-          (if *continuablep*
+        (if *continuablep*
             (let* ((*print-circle* *error-print-circle*)
                    (*print-level* *backtrace-print-level*)
@@ -629 +621 @@
               (format t "~&> Type :GO to continue, :POP to abort, :R for a list of available restarts.")
               (format t "~&> If continued: ~A~%" continue))
-            (format t "~&> Type :POP to abort, :R for a list of available restarts.~%")))
+            (format t "~&> Type :POP to abort, :R for a list of available restarts.~%"))
         (format t "~&> Type :? for other options.")
         (terpri)
@@ -641 +633 @@
                 (application-ui-operation *application*
                                           :enter-backtrace-context context)
-                  (read-loop :break-level (1+ *break-level*)
-                             :input-stream *debug-io*
-                             :output-stream *debug-io*))
+                (read-loop :break-level (1+ *break-level*)
+                           :input-stream *debug-io*
+                           :output-stream *debug-io*))
            (application-ui-operation *application* :exit-backtrace-context
                                      context)))))))
@@ -650 +642 @@
 
 (defun display-restarts (&optional (condition *break-condition*))
-  (let ((i 0))
-    (format t "~&[Pretend that these are buttons.]")
-    (dolist (r (compute-restarts condition) i)
-      (format t "~&~a : ~A" i r)
-      (setq i (%i+ i 1)))
-    (fresh-line nil)))
+  (loop
+    for restart in (compute-restarts condition)
+    for count upfrom 0
+    do (format *debug-io* "~&~D. ~A" count restart)
+    finally (fresh-line *debug-io*)))
 
 (defun select-restart (n &optional (condition *break-condition*))