0.9.13.30
[sbcl.git] / src / code / step.lisp
1 ;;;; single stepper for SBCL
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
11
12 ;;;; Single stepping works by having compiler insert STEP-CONDITION
13 ;;;; signalling forms into code compiled at high debug settings, and
14 ;;;; having a handler for them at the toplevel.
15
16 (in-package "SB-IMPL") ; in warm SBCL
17
18 (defvar *step-help* "The following commands are available at the single
19 stepper's prompt:
20
21  S: Step into the current expression.
22  N: Evaluate the current expression without stepping.
23  C: Evaluate to finish without stepping.
24  Q: Abort evaluation.
25  ?: Display this message.
26 ")
27
28 (defgeneric single-step (condition))
29
30 (defmethod single-step ((condition step-variable-condition))
31   (format *debug-io* "; ~A => ~S~%"
32           (step-condition-form condition)
33           (step-condition-result condition)))
34
35 (defmethod single-step ((condition step-values-condition))
36   (let ((values (step-condition-result condition)))
37     (format *debug-io* "; ~A => ~:[#<no value>~;~{~S~^, ~}~]~%"
38             (step-condition-form condition)
39             values values)))
40
41 (defmethod single-step ((condition step-form-condition))
42   (let ((form (step-condition-form condition)))
43     (loop
44      (format *debug-io* "; form ~A~%STEP] " form)
45      (finish-output *debug-io*)
46      (let ((line (read-line *debug-io*)))
47        (if (plusp (length line))
48            (case (char-upcase (schar line 0))
49              (#\Q
50               (abort condition))
51              (#\C
52               (step-continue condition))
53              (#\N
54               (step-next condition))
55              (#\S
56               (step-into condition))
57              (#\?
58               (write-line *step-help* *debug-io*))))))))
59
60 (defvar *stepper-hook* #'single-step
61   #+sb-doc "Customization hook for alternative single-steppers.
62 *STEPPER-HOOK* is bound to NIL prior to calling the bound function
63 with the STEP-CONDITION as argument.")
64
65 (defun invoke-stepper (condition)
66   (when (and *stepping* *stepper-hook*)
67     (let ((hook *stepper-hook*)
68           (*stepper-hook* nil))
69       (funcall hook condition))))
70
71 (defmacro step (form)
72   #+sb-doc
73   "The form is evaluated with single stepping enabled. Function calls
74 outside the lexical scope of the form can be stepped into only if the
75 functions in question have been compiled with sufficient DEBUG policy
76 to be at least partially steppable."
77   `(let ((*stepping* t)
78          (*step* t))
79     (declare (optimize (sb-c:insert-step-conditions 0)))
80     (format t "Single stepping. Type ? for help.~%")
81     (locally (declare (optimize (sb-c:insert-step-conditions 3)))
82       ,form)))