src/code/early-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")
  17
  18 ;; Used for controlling whether the stepper is enabled / disabled when
  19 ;; building without SB-THREAD. With SB-THREAD, a slot in the thread
  20 ;; structure is used instead. (See EMIT-SINGLE-STEP-TEST in
  21 ;; src/compiler/x86/call.lisp).
  22 #!-sb-thread
  23 (defvar *stepping* nil)
  24
  25 ;; Used for implementing the STEP-OUT restart. The step-wrapper will
  26 ;; bind this to :MAYBE, before calling the wrapped code. When
  27 ;; unwinding, the wrapper will check whether it's been set to T. If
  28 ;; so, it'll re-enable the stepper. This is a tri-state variable (NIL,
  29 ;; :MAYBE, T) so that the debugger can detect in advance whether the
  30 ;; OUT debugger command will actually have a wrapper to step out to.
  31 (defvar *step-out* nil)
  32
  33 (symbol-macrolet ((place
  34                    #!+sb-thread (sb!thread::thread-stepping)
  35                    #!-sb-thread *stepping*))
  36   (defun (setf stepping) (new-value)
  37     (setf place new-value))
  38   (defun stepping-enabled-p ()
  39     (= place 1)))
  40
  41 (defun enable-stepping ()
  42   (setf (stepping) 1))
  43 (defun disable-stepping ()
  44   (setf (stepping) 0))
  45
  46
  47 (defmacro with-stepping-enabled (&body body)
  48   (let ((orig (gensym)))
  49     `(let ((,orig (stepping-enabled-p)))
  50        (unwind-protect
  51             (progn
  52               (enable-stepping)
  53               ,@body)
  54          (setf (stepping) (if ,orig 1 0))))))
  55
  56 (defmacro with-stepping-disabled (&body body)
  57   (let ((orig (gensym)))
  58     `(let ((,orig (stepping-enabled-p)))
  59        (unwind-protect
  60             (progn
  61               (disable-stepping)
  62               ,@body)
  63          (setf (stepping) (if ,orig 1 0))))))