0.9.15.28: less instrumentation

 * Don't instrument inline-expansions of known functions. Fixes at
   least some of the "step-instrumentation confusing the compiler"
   problems.

 * Rename IR1-CONVERT-LAMBDA-FOR-DEFUN to
   IR1-CONVERT-INLINE-EXPANSION, since that is the only way it is
   currently used. Refactor slightly for simplicity, given the way it
   is actually used.

 * Test-case.

diff --git a/NEWS b/NEWS
index 2eeaff2..136bb2d 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -37,6 +37,9 @@ changes in sbcl-0.9.16 relative to sbcl-0.9.15:
     argument for shadowing by local functions.
   * bug fix: compiler-macros expansion was inhibited by local INLINE 
     declarations.
+  * bug fix: inline expansions of known functions were subject to
+    step-instrumentation in high debug policies, leading to problems
+    with type-inference.
 
 changes in sbcl-0.9.15 relative to sbcl-0.9.14:
   * added support for the ucs-2 external format.  (contributed by Ivan

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index b1c09f5..1fd55cd 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -850,11 +850,15 @@
              ;; called semi-inlining? A more descriptive name would
              ;; be nice. -- WHN 2002-01-07
              (frob ()
-               (let ((res (let ((*allow-instrumenting* t))
-                            (ir1-convert-lambda-for-defun
-                             (defined-fun-inline-expansion leaf)
-                             leaf t
-                             #'ir1-convert-inline-lambda))))
+               (let* ((name (leaf-source-name leaf))
+                      (res (ir1-convert-inline-expansion
+                            name
+                            (defined-fun-inline-expansion leaf)
+                            leaf
+                            inlinep
+                            (info :function :info name))))
+                 ;; allow backward references to this function from
+                 ;; following top level forms
                  (setf (defined-fun-functional leaf) res)
                  (change-ref-leaf ref res))))
         (if ir1-converting-not-optimizing-p
@@ -1117,7 +1121,8 @@
                                 (block-next (node-block call)))
       (let ((new-fun (ir1-convert-inline-lambda
                       res
-                      :debug-name (debug-name 'lambda-inlined source-name)))
+                      :debug-name (debug-name 'lambda-inlined source-name)
+                      :system-lambda t))
             (ref (lvar-use (combination-fun call))))
         (change-ref-leaf ref new-fun)
         (setf (combination-kind call) :full)

diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp
index 88f6aba..9841e8e 100644 (file)
--- a/src/compiler/ir1tran-lambda.lisp
+++ b/src/compiler/ir1tran-lambda.lisp
@@ -955,9 +955,11 @@
 ;;; current compilation policy. Note that FUN may be a
 ;;; LAMBDA-WITH-LEXENV, so we may have to augment the environment to
 ;;; reflect the state at the definition site.
-(defun ir1-convert-inline-lambda (fun &key
-                                      (source-name '.anonymous.)
-                                      debug-name)
+(defun ir1-convert-inline-lambda (fun 
+                                  &key
+                                  (source-name '.anonymous.)
+                                  debug-name
+                                  system-lambda)
   (destructuring-bind (decls macros symbol-macros &rest body)
                       (if (eq (car fun) 'lambda-with-lexenv)
                           (cdr fun)
@@ -970,7 +972,8 @@
                                      `(,(car x) .
                                        (macro . ,(coerce (cdr x) 'function))))
                                    macros)
-                     :policy (lexenv-policy *lexenv*))))
+                     :policy (lexenv-policy *lexenv*)))
+          (*allow-instrumenting* (and (not system-lambda) *allow-instrumenting*)))
       (ir1-convert-lambda `(lambda ,@body)
                           :source-name source-name
                           :debug-name debug-name))))
@@ -1031,41 +1034,31 @@
                 "previous declaration"
                 "previous definition"))))
 
-;;; Convert a lambda doing all the basic stuff we would do if we were
-;;; converting a DEFUN. In the old CMU CL system, this was used both
-;;; by the %DEFUN translator and for global inline expansion, but
-;;; since sbcl-0.pre7.something %DEFUN does things differently.
-;;; FIXME: And now it's probably worth rethinking whether this
-;;; function is a good idea.
-;;;
-;;; Unless a :INLINE function, we temporarily clobber the inline
-;;; expansion. This prevents recursive inline expansion of
-;;; opportunistic pseudo-inlines.
-(defun ir1-convert-lambda-for-defun (lambda var expansion converter)
-  (declare (cons lambda) (function converter) (type defined-fun var))
-  (let ((var-expansion (defined-fun-inline-expansion var)))
-    (unless (eq (defined-fun-inlinep var) :inline)
-      (setf (defined-fun-inline-expansion var) nil))
-    (let* ((name (leaf-source-name var))
-           (fun (funcall converter lambda
-                         :source-name name))
-           (fun-info (info :function :info name)))
-      (setf (functional-inlinep fun) (defined-fun-inlinep var))
-      (assert-new-definition var fun)
-      (setf (defined-fun-inline-expansion var) var-expansion)
-      ;; If definitely not an interpreter stub, then substitute for
-      ;; any old references.
-      (unless (or (eq (defined-fun-inlinep var) :notinline)
-                  (not *block-compile*)
-                  (and fun-info
-                       (or (fun-info-transforms fun-info)
-                           (fun-info-templates fun-info)
-                           (fun-info-ir2-convert fun-info))))
-        (substitute-leaf fun var)
-        ;; If in a simple environment, then we can allow backward
-        ;; references to this function from following top level forms.
-        (when expansion (setf (defined-fun-functional var) fun)))
-      fun)))
+;;; Used for global inline expansion. Earlier something like this was
+;;; used by %DEFUN too. FIXME: And now it's probably worth rethinking
+;;; whether this function is a good idea at all.
+(defun ir1-convert-inline-expansion (name expansion var inlinep info)
+  ;; Unless a :INLINE function, we temporarily clobber the inline
+  ;; expansion. This prevents recursive inline expansion of
+  ;; opportunistic pseudo-inlines.
+  (unless (eq inlinep :inline)
+    (setf (defined-fun-inline-expansion var) nil))
+  (let ((fun (ir1-convert-inline-lambda expansion
+                                        :source-name name 
+                                        ;; prevent instrumentation of
+                                        ;; known function expansions
+                                        :system-lambda (and info t))))
+    (setf (functional-inlinep fun) inlinep)
+    (assert-new-definition var fun)
+    (setf (defined-fun-inline-expansion var) expansion)
+    ;; substitute for any old references
+    (unless (or (not *block-compile*)
+                (and info
+                     (or (fun-info-transforms info)
+                         (fun-info-templates info)
+                         (fun-info-ir2-convert info))))
+      (substitute-leaf fun var))
+    fun))
 
 ;;; the even-at-compile-time part of DEFUN
 ;;;

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index a528b67..60b91b8 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -2113,3 +2113,12 @@
 (compile nil '(lambda ()
                (let ((x (make-array '(1) :element-type '(signed-byte 32))))
                  (setf (aref x 0) 1))))
+
+;;; step instrumentation confusing the compiler, reported by Faré
+(handler-bind ((warning #'error))
+  (compile nil '(lambda () 
+                 (declare (optimize (debug 2))) ; not debug 3!
+                 (let ((val "foobar"))
+                   (map-into (make-array (list (length val)) 
+                                         :element-type '(unsigned-byte 8))
+                             #'char-code val)))))

diff --git a/version.lisp-expr b/version.lisp-expr
index b0b10d9..ef75296 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.15.27"
+"0.9.15.28"