X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1tran.lisp;h=23c69960d2c242c7816c9d4bad76d9129ecf0cf6;hb=7e24349c17298e2959e853ea411b5f65d9f7f332;hp=783ba7be00e339e16579d800b0fc053b738133cc;hpb=de1859fb0815446420c6e0d58adb266012134acc;p=sbcl.git

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 783ba7b..23c6996 100644
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -487,9 +487,7 @@
     (ir1-error-bailout (start next result form)
       (let ((*current-path* (or (gethash form *source-paths*)
                                 (cons form *current-path*))))
-        (cond ((step-form-p form)
-               (ir1-convert-step start next result form))
-              ((atom form)
+        (cond ((atom form)
                (cond ((and (symbolp form) (not (keywordp form)))
                       (ir1-convert-var start next result form))
                      ((leaf-p form)
@@ -591,28 +589,33 @@
 (defun ir1-convert-var (start next result name)
   (declare (type ctran start next) (type (or lvar null) result) (symbol name))
   (let ((var (or (lexenv-find name vars) (find-free-var name))))
-    (etypecase var
-      (leaf
-       (when (lambda-var-p var)
-         (let ((home (ctran-home-lambda-or-null start)))
-           (when home
-             (pushnew var (lambda-calls-or-closes home))))
-         (when (lambda-var-ignorep var)
-           ;; (ANSI's specification for the IGNORE declaration requires
-           ;; that this be a STYLE-WARNING, not a full WARNING.)
-           #-sb-xc-host
-           (compiler-style-warn "reading an ignored variable: ~S" name)
-           ;; there's no need for us to accept ANSI's lameness when
-           ;; processing our own code, though.
-           #+sb-xc-host
-           (warn "reading an ignored variable: ~S" name)))
-       (reference-leaf start next result var))
-      (cons
-       (aver (eq (car var) 'macro))
-       ;; FIXME: [Free] type declarations. -- APD, 2002-01-26
-       (ir1-convert start next result (cdr var)))
-      (heap-alien-info
-       (ir1-convert start next result `(%heap-alien ',var)))))
+    (if (and (global-var-p var) (not result))
+        ;; KLUDGE: If the reference is dead, convert using SYMBOL-VALUE
+        ;; which is not flushable, so that unbound dead variables signal
+        ;; an error (bug 412).
+        (ir1-convert start next result `(symbol-value ',name))
+        (etypecase var
+          (leaf
+           (when (lambda-var-p var)
+             (let ((home (ctran-home-lambda-or-null start)))
+               (when home
+                 (sset-adjoin var (lambda-calls-or-closes home))))
+             (when (lambda-var-ignorep var)
+               ;; (ANSI's specification for the IGNORE declaration requires
+               ;; that this be a STYLE-WARNING, not a full WARNING.)
+               #-sb-xc-host
+               (compiler-style-warn "reading an ignored variable: ~S" name)
+               ;; there's no need for us to accept ANSI's lameness when
+               ;; processing our own code, though.
+               #+sb-xc-host
+               (warn "reading an ignored variable: ~S" name)))
+           (reference-leaf start next result var))
+          (cons
+           (aver (eq (car var) 'macro))
+           ;; FIXME: [Free] type declarations. -- APD, 2002-01-26
+           (ir1-convert start next result (cdr var)))
+          (heap-alien-info
+           (ir1-convert start next result `(%heap-alien ',var))))))
   (values))
 
 ;;; Find a compiler-macro for a form, taking FUNCALL into account.
@@ -701,7 +704,9 @@
     (:macro
      (ir1-convert start next result
                   (careful-expand-macro (info :function :macro-function fun)
-                                        form)))
+                                        form))
+     (unless (policy *lexenv* (zerop store-xref-data))
+       (record-macroexpansion fun (ctran-block start) *current-path*)))
     ((nil :function)
      (ir1-convert-srctran start next result
                           (find-free-fun fun "shouldn't happen! (no-cmacro)")
@@ -801,6 +806,22 @@
 
 ;;;; converting combinations
 
+;;; Does this form look like something that we should add single-stepping
+;;; instrumentation for?
+(defun step-form-p (form)
+  (flet ((step-symbol-p (symbol)
+           (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)))))))
+    (and *allow-instrumenting*
+         (policy *lexenv* (= insert-step-conditions 3))
+         (listp form)
+         (symbolp (car form))
+         (step-symbol-p (car form)))))
+
 ;;; Convert a function call where the function FUN is a LEAF. FORM is
 ;;; the source for the call. We return the COMBINATION node so that
 ;;; the caller can poke at it if it wants to.
@@ -810,7 +831,20 @@
   (let ((ctran (make-ctran))
         (fun-lvar (make-lvar)))
     (ir1-convert start ctran fun-lvar `(the (or function symbol) ,fun))
-    (ir1-convert-combination-args fun-lvar ctran next result (cdr form))))
+    (let ((combination
+           (ir1-convert-combination-args fun-lvar ctran next result
+                                         (cdr form))))
+      (when (step-form-p form)
+        ;; Store a string representation of the form in the
+        ;; combination node. This will let the IR2 translator know
+        ;; that we want stepper instrumentation for this node. The
+        ;; string will be stored in the debug-info by DUMP-1-LOCATION.
+        (setf (combination-step-info combination)
+              (let ((*print-pretty* t)
+                    (*print-circle* t)
+                    (*print-readably* nil))
+                (prin1-to-string form))))
+      combination)))
 
 ;;; Convert the arguments to a call and make the COMBINATION
 ;;; node. FUN-LVAR yields the function to call. ARGS is the list of