0.9.6.36:

[sbcl.git] / src / compiler / ir1-step.lisp

diff --git a/src/compiler/ir1-step.lisp b/src/compiler/ir1-step.lisp
index 2ca4af6..3d3bf41 100644 (file)
--- a/src/compiler/ir1-step.lisp
+++ b/src/compiler/ir1-step.lisp
@@ -32,7 +32,7 @@
         (setf *stepping* nil))
       (step-next ()
         nil)
         (setf *stepping* nil))
       (step-next ()
         nil)

-      (step-into () 
+      (step-into ()

         t))))
 
 (defun step-variable (symbol value)
         t))))
 
 (defun step-variable (symbol value)

@@ -47,8 +47,8 @@
 
 (defun insert-step-conditions (form)
   `(locally (declare
 
 (defun insert-step-conditions (form)
   `(locally (declare

-            (optimize (insert-step-conditions
-                       ,(policy *lexenv* insert-step-conditions))))
+             (optimize (insert-step-conditions
+                        ,(policy *lexenv* insert-step-conditions))))

     ,form))
 
 ;;; Flag to control instrumentation function call arguments.
     ,form))
 
 ;;; Flag to control instrumentation function call arguments.

@@ -64,7 +64,8 @@
                     `(locally (declare (optimize (insert-step-conditions 0)))
                       (step-variable ,form-string ,form))))
       (list
                     `(locally (declare (optimize (insert-step-conditions 0)))
                       (step-variable ,form-string ,form))))
       (list

-       (let* ((*step-arguments-p* (policy *lexenv* (= insert-step-conditions 3)))
+       (let* ((*step-arguments-p* (and *allow-instrumenting*
+                                       (policy *lexenv* (= insert-step-conditions 3))))

               (step-form `(step-form ,form-string
                                      ',(source-path-original-source *current-path*)
                                      *compile-file-pathname*))
               (step-form `(step-form ,form-string
                                      ',(source-path-original-source *current-path*)
                                      *compile-file-pathname*))

@@ -83,12 +84,13 @@
   #+sb-xc-host (declare (ignore form))
   #-sb-xc-host
   (flet ((step-symbol-p (symbol)
   #+sb-xc-host (declare (ignore form))
   #-sb-xc-host
   (flet ((step-symbol-p (symbol)

-           (not (member (symbol-package symbol) 
-                        (load-time-value 
+           (not (member (symbol-package symbol)
+                        (load-time-value

                          ;; KLUDGE: packages we're not interested in stepping.
                          (mapcar #'find-package '(sb!c sb!int sb!impl sb!kernel sb!pcl)))))))
     (let ((lexenv *lexenv*))
                          ;; KLUDGE: packages we're not interested in stepping.
                          (mapcar #'find-package '(sb!c sb!int sb!impl sb!kernel sb!pcl)))))))
     (let ((lexenv *lexenv*))

-      (and (policy lexenv (>= insert-step-conditions 2))
+      (and *allow-instrumenting*
+           (policy lexenv (>= insert-step-conditions 2))

            (cond ((consp form)
                   (let ((op (car form)))
                     (or (and (consp op) (eq 'lambda (car op)))
            (cond ((consp form)
                   (let ((op (car form)))
                     (or (and (consp op) (eq 'lambda (car op)))

@@ -99,6 +101,7 @@
                              (step-symbol-p op)))))
                  ((symbolp form)
                   (and *step-arguments-p*
                              (step-symbol-p op)))))
                  ((symbolp form)
                   (and *step-arguments-p*

+                       *allow-instrumenting*

                        (policy lexenv (= insert-step-conditions 3))
                        (not (consp (lexenv-find form vars)))
                        (not (constantp form))
                        (policy lexenv (= insert-step-conditions 3))
                        (not (consp (lexenv-find form vars)))
                        (not (constantp form))