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 (defun step-form (form args)
  19   (restart-case
  20       (signal 'step-form-condition
  21               :form form
  22               :args args)
  23     (step-continue ()
  24       :report "Resume normal execution"
  25       (disable-stepping)
  26       (setf *step-out* nil))
  27     (step-out ()
  28       :report "Resume stepping after returning from this function"
  29       (disable-stepping)
  30       (setf *step-out* t)
  31       nil)
  32     (step-next ()
  33       :report "Step over call"
  34       nil)
  35     (step-into ()
  36       :report "Step into call"
  37       t)))
  38
  39 (defun step-values (form &rest values)
  40   (declare (dynamic-extent values))
  41   (signal 'step-values-condition :form form :result values)
  42   (values-list values))
  43
  44 (defun step-finished ()
  45   (restart-case
  46       (signal 'step-finished-condition)
  47     (continue ())))
  48
  49 (defvar *step-help* "The following commands are available at the single
  50 stepper's prompt:
  51
  52  S: Step into the current expression.
  53  N: Evaluate the current expression without stepping.
  54  C: Evaluate to finish without stepping.
  55  Q: Abort evaluation.
  56  B: Backtrace.
  57  ?: Display this message.
  58 ")
  59
  60 (defgeneric single-step (condition))
  61
  62 (defmethod single-step ((condition step-values-condition))
  63   (let ((values (step-condition-result condition)))
  64     (format *debug-io* "; ~A => ~:[#<no value>~;~{~S~^, ~}~]~%"
  65             (step-condition-form condition)
  66             values values)))
  67
  68 (defmethod single-step ((condition step-form-condition))
  69   (let ((form (step-condition-form condition))
  70         (args (step-condition-args condition)))
  71     (let ((*print-circle* t)
  72           (*print-pretty* t)
  73           (*print-readably* nil))
  74       (format *debug-io*
  75               "; Evaluating call:~%~<; ~@;  ~A~:>~%~
  76                ; ~:[With arguments:~%~<; ~@;~{  ~S~^~%~}~:>~;With unknown arguments~]~%"
  77               (list form)
  78               (eq args :unknown)
  79               (list args)))
  80     (finish-output *debug-io*)
  81     (let ((*stack-top-hint* (sb-di::find-stepped-frame)))
  82       (invoke-debugger condition))))
  83
  84 ;;; In the TTY debugger we're not interested in STEP returning
  85 (defmethod single-step ((condition step-finished-condition))
  86   (values))
  87
  88 (defvar *stepper-hook* 'single-step
  89   #+sb-doc "Customization hook for alternative single-steppers.
  90 *STEPPER-HOOK* is bound to NIL prior to calling the bound function
  91 with the STEP-CONDITION as argument.")
  92
  93 (defun invoke-stepper (condition)
  94   (when (and (stepping-enabled-p)
  95              *stepper-hook*)
  96     (with-stepping-disabled
  97       (let ((hook *stepper-hook*)
  98             (*stepper-hook* nil))
  99         (funcall hook condition)))))
 100
 101 (defmacro step (form)
 102   #+sb-doc
 103   "The form is evaluated with single stepping enabled. Function calls
 104 outside the lexical scope of the form can be stepped into only if the
 105 functions in question have been compiled with sufficient DEBUG policy
 106 to be at least partially steppable."
 107   `(locally
 108        (declare (optimize debug (sb-c:insert-step-conditions 0)))
 109      (format t "Single stepping. Type ? for help.~%")
 110      (let ((*step-out* :maybe))
 111        (unwind-protect
 112             (with-stepping-enabled
 113               (multiple-value-prog1
 114                   (locally (declare (optimize (sb-c:insert-step-conditions 3)))
 115                     ,form)
 116                 (step-finished)))))))
 117