1.0.28.41: make MAKE-ARRAY transforms co-operate with FILL better
[sbcl.git] / 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))
40
41 (defun enable-stepping ()
42   (setf (stepping) t))
43 (defun disable-stepping ()
44   (setf (stepping) nil))
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) ,orig)))))
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) ,orig)))))