From: Juho Snellman <jsnell@iki.fi>
Date: Wed, 20 Sep 2006 18:05:02 +0000 (+0000)
Subject: 0.9.16.44:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=6fedcdf1b31e40855fec7845d8bce5ad8beeaaf1;p=sbcl.git

0.9.16.44:
        Stepper tweaks:

        * Inhibit stepping while calling the stepper hook.
        * Make the body of STEP steppable
        * Signal a STEP-FINISHED-CONDITION when STEP returns
---

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 4013273..569a836 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -709,7 +709,7 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
                "WITH-TIMEOUT" "TIMEOUT"
 
                ;; stepping interface
-               "STEP-CONDITION" "STEP-FORM-CONDITION"
+               "STEP-CONDITION" "STEP-FORM-CONDITION" "STEP-FINISHED-CONDITION"
                "STEP-VALUES-CONDITION" "STEP-VARIABLE-CONDITION"
                "STEP-CONDITION-FORM" "STEP-CONDITION-RESULT"
                "STEP-CONTINUE" "STEP-NEXT" "STEP-INTO"
diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index c59ccb4..098ec4e 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -1226,6 +1226,15 @@ single-stepping information after executing a form.
 STEP-CONDITION-FORM holds the form, and STEP-CONDITION-RESULT holds
 the values returned by the form as a list. No associated restarts."))
 
+(define-condition step-finished-condition (step-condition)
+  ()
+  (:report
+   (lambda (condition stream)
+     (declare (ignore condition))
+     (format stream "Returning from STEP")))
+  #!+sb-doc
+  (:documentation "Condition signaled when STEP returns."))
+
 
 ;;;; restart definitions
 
diff --git a/src/code/step.lisp b/src/code/step.lisp
index 314d10c..8d1affe 100644
--- a/src/code/step.lisp
+++ b/src/code/step.lisp
@@ -41,6 +41,11 @@
   (signal 'step-values-condition :form form :result values)
   (values-list values))
 
+(defun step-finished ()
+  (restart-case
+      (signal 'step-finished-condition)
+    (continue ())))
+
 (defvar *step-help* "The following commands are available at the single
 stepper's prompt:
 
@@ -76,6 +81,10 @@ stepper's prompt:
     (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.
 *STEPPER-HOOK* is bound to NIL prior to calling the bound function
@@ -84,9 +93,10 @@ with the STEP-CONDITION as argument.")
 (defun invoke-stepper (condition)
   (when (and (stepping-enabled-p)
              *stepper-hook*)
-    (let ((hook *stepper-hook*)
-          (*stepper-hook* nil))
-      (funcall hook condition))))
+    (with-stepping-disabled
+      (let ((hook *stepper-hook*)
+            (*stepper-hook* nil))
+        (funcall hook condition)))))
 
 (defmacro step (form)
   #+sb-doc
@@ -95,9 +105,13 @@ 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."
   `(locally
-       (declare (optimize (sb-c:insert-step-conditions 0)))
+       (declare (optimize debug (sb-c:insert-step-conditions 0)))
      (format t "Single stepping. Type ? for help.~%")
      (let ((*step-out* :maybe))
-       (with-stepping-enabled
-         (locally (declare (optimize (sb-c:insert-step-conditions 3)))
-           ,form)))))
+       (unwind-protect
+            (with-stepping-enabled
+              (multiple-value-prog1
+                  (locally (declare (optimize (sb-c:insert-step-conditions 3)))
+                    ,form)
+                (step-finished)))))))
+
diff --git a/version.lisp-expr b/version.lisp-expr
index 84d37cc..69c2d85 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.16.43"
+"0.9.16.44"