1 ;;;; compiler parts of the single stepper
3 ;;;; This software is part of the SBCL system. See the README file for
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.
14 ;;; Local stepping control: STEP binds this to T, and when forms are
15 ;;; being skipped this is bound to NIL down the stack to prevent
16 ;;; signalling of STEP-CONDITIONs.
19 ;;; Global stepping control: STEP binds this to T, and when the
20 ;;; restart to continue without stepping is selected this is set to
21 ;;; NIL to prevent the *STEPPER-HOOK* from being called.
22 (defvar *stepping* nil)
24 (defun step-form (form source-path pathname)
27 (signal 'step-form-condition
29 :source-path source-path
32 (setf *stepping* nil))
38 (defun step-variable (symbol value)
40 (signal 'step-variable-condition :form symbol :result value))
43 (defun step-values (form values)
45 (signal 'step-values-condition :form form :result values))
48 (defun insert-step-conditions (form)
50 (optimize (insert-step-conditions
51 ,(policy *lexenv* insert-step-conditions))))
54 ;;; Flag to control instrumentation function call arguments.
55 (defvar *step-arguments-p* nil)
57 (defun ir1-convert-step (start next result form)
58 (let ((form-string (let ((*print-pretty* t)
59 (*print-readably* nil))
60 (prin1-to-string form))))
63 (ir1-convert start next result
64 `(locally (declare (optimize (insert-step-conditions 0)))
65 (step-variable ,form-string ,form))))
67 (let* ((*step-arguments-p* (policy *lexenv* (= insert-step-conditions 3)))
68 (step-form `(step-form ,form-string
69 ',(source-path-original-source *current-path*)
70 *compile-file-pathname*))
71 (values-form `(,(car form)
72 ,@(if *step-arguments-p*
73 (mapcar #'insert-step-conditions (cdr form))
75 (ir1-convert start next result
76 `(locally (declare (optimize (insert-step-conditions 0)))
77 ,(if *step-arguments-p*
78 `(let ((*step* ,step-form))
79 (step-values ,form-string (multiple-value-list ,values-form)))
80 `(progn ,step-form ,values-form)))))))))
82 (defun step-form-p (form)
83 #+sb-xc-host (declare (ignore form))
85 (flet ((step-symbol-p (symbol)
86 (not (member (symbol-package symbol)
88 ;; KLUDGE: packages we're not interested in stepping.
89 (mapcar #'find-package '(sb!c sb!int sb!impl sb!kernel sb!pcl)))))))
90 (let ((lexenv *lexenv*))
91 (and (policy lexenv (>= insert-step-conditions 2))
93 (let ((op (car form)))
94 (or (and (consp op) (eq 'lambda (car op)))
96 (not (special-operator-p op))
97 (member (lexenv-find op funs) '(nil functional global-var))
98 (not (eq :macro (info :function :kind op)))
99 (step-symbol-p op)))))
101 (and *step-arguments-p*
102 (policy lexenv (= insert-step-conditions 3))
103 (not (consp (lexenv-find form vars)))
104 (not (constantp form))
105 (step-symbol-p form))))))))