1.1.13: will be tagged as "sbcl-1.1.13"

[sbcl.git] / src / code / step.lisp

diff --git a/src/code/step.lisp b/src/code/step.lisp
index a7222b3..43a4801 100644 (file)
--- a/src/code/step.lisp
+++ b/src/code/step.lisp
@@ -15,23 +15,42 @@
 
 (in-package "SB-IMPL") ; in warm SBCL
 
-(defvar *step-help* "The following commands are available at the single
-stepper's prompt:
+(defun step-form (form args)
+  (restart-case
+      (signal 'step-form-condition
+              :form form
+              :args args)
+    (step-continue ()
+      :report "Resume normal execution"
+      (disable-stepping)
+      (setf *step-out* nil))
+    (step-out ()
+      :report "Resume stepping after returning from this function"
+      (ecase *step-out*
+        ((nil)
+         (error "Can't STEP-OUT: No STEP-IN on the call-stack"))
+        ((t :maybe)
+         (disable-stepping)
+         (setf *step-out* t)))
+      nil)
+    (step-next ()
+      :report "Step over call"
+      nil)
+    (step-into ()
+      :report "Step into call"
+      t)))
 
- S: Step into the current expression.
- N: Evaluate the current expression without stepping.
- C: Evaluate to finish without stepping.
- Q: Abort evaluation.
- B: Backtrace.
- ?: Display this message.
-")
+(defun step-values (form &rest values)
+  (declare (truly-dynamic-extent values))
+  (signal 'step-values-condition :form form :result values)
+  (values-list values))
 
-(defgeneric single-step (condition))
+(defun step-finished ()
+  (restart-case
+      (signal 'step-finished-condition)
+    (continue ())))
 
-(defmethod single-step ((condition step-variable-condition))
-  (format *debug-io* "; ~A => ~S~%"
-          (step-condition-form condition)
-          (step-condition-result condition)))
+(defgeneric single-step (condition))
 
 (defmethod single-step ((condition step-values-condition))
   (let ((values (step-condition-result condition)))
@@ -40,25 +59,24 @@ stepper's prompt:
             values values)))
 
 (defmethod single-step ((condition step-form-condition))
-  (let ((form (step-condition-form condition)))
-    (loop
-     (format *debug-io* "; form ~A~%STEP] " form)
-     (finish-output *debug-io*)
-     (let ((line (read-line *debug-io*)))
-       (if (plusp (length line))
-           (case (char-upcase (schar line 0))
-             (#\B
-              (backtrace))
-             (#\Q
-              (abort condition))
-             (#\C
-              (step-continue condition))
-             (#\N
-              (step-next condition))
-             (#\S
-              (step-into condition))
-             (#\?
-              (write-line *step-help* *debug-io*))))))))
+  (let ((form (step-condition-form condition))
+        (args (step-condition-args condition)))
+    (let ((*print-circle* t)
+          (*print-pretty* t)
+          (*print-readably* nil))
+      (format *debug-io*
+              "; Evaluating call:~%~<; ~@;  ~A~:>~%~
+               ; ~:[With arguments:~%~<; ~@;~{  ~S~^~%~}~:>~;With unknown arguments~]~%"
+              (list form)
+              (eq args :unknown)
+              (list args)))
+    (finish-output *debug-io*)
+    (let ((*stack-top-hint* (sb-di::find-stepped-frame)))
+      (invoke-debugger condition))))
+
+;;; In the TTY debugger we're not interested in STEP returning
+(defmethod single-step ((condition step-finished-condition))
+  (values))
 
 (defvar *stepper-hook* 'single-step
   #+sb-doc "Customization hook for alternative single-steppers.
@@ -66,10 +84,12 @@ stepper's prompt:
 with the STEP-CONDITION as argument.")
 
 (defun invoke-stepper (condition)
-  (when (and *stepping* *stepper-hook*)
-    (let ((hook *stepper-hook*)
-          (*stepper-hook* nil))
-      (funcall hook condition))))
+  (when (and (stepping-enabled-p)
+             *stepper-hook*)
+    (with-stepping-disabled
+      (let ((hook *stepper-hook*)
+            (*stepper-hook* nil))
+        (funcall hook condition)))))
 
 (defmacro step (form)
   #+sb-doc
@@ -77,9 +97,14 @@ with the STEP-CONDITION as argument.")
 outside the lexical scope of the form can be stepped into only if the
 functions in question have been compiled with sufficient DEBUG policy
 to be at least partially steppable."
-  `(let ((*stepping* t)
-         (*step* t))
-    (declare (optimize (sb-c:insert-step-conditions 0)))
-    (format t "Single stepping. Type ? for help.~%")
-    (locally (declare (optimize (sb-c:insert-step-conditions 3)))
-      ,form)))
+  `(locally
+    (declare (optimize debug (sb-c:insert-step-conditions 0)))
+     ;; Allow stepping out of the STEP form.
+     (let ((*step-out* :maybe))
+       (unwind-protect
+            (with-stepping-enabled
+              (multiple-value-prog1
+                  (locally (declare (optimize (sb-c:insert-step-conditions 3)))
+                    ,form)
+                (step-finished)))))))
+