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* 0)
  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 (!define-thread-local *step-out* nil)
  32
  33 ;; These functions make no sense on the host, but putting them in
  34 ;; 'step.lisp' is too late, because 'step' is compiled in warm load,
  35 ;; but the REPL calls DISABLE-STEPPING right way.
  36 ;; Adding a file of target-only code for these isn't worth the trouble.
  37 #-sb-xc-host
  38 (symbol-macrolet ((place
  39                    #!+sb-thread (sb!thread::thread-stepping)
  40                    #!-sb-thread *stepping*))
  41   (defun (setf stepping) (new-value)
  42     (setf place new-value))
  43   (defun stepping-enabled-p ()
  44     (= place 1)))
  45
  46 #-sb-xc-host
  47 (defun enable-stepping ()
  48   (setf (stepping) 1))
  49 #-sb-xc-host
  50 (defun disable-stepping ()
  51   (setf (stepping) 0))
  52
  53
  54 (defmacro with-stepping-enabled (&body body)
  55   (let ((orig (gensym)))
  56     `(let ((,orig (stepping-enabled-p)))
  57        (unwind-protect
  58             (progn
  59               (enable-stepping)
  60               ,@body)
  61          (setf (stepping) (if ,orig 1 0))))))
  62
  63 (defmacro with-stepping-disabled (&body body)
  64   (let ((orig (gensym)))
  65     `(let ((,orig (stepping-enabled-p)))
  66        (unwind-protect
  67             (progn
  68               (disable-stepping)
  69               ,@body)
  70          (setf (stepping) (if ,orig 1 0))))))