From 40b06a4157c22c2bab0b13ba051fde2489864076 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sat, 12 Aug 2006 09:55:13 +0000 Subject: [PATCH] 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. --- NEWS | 3 ++ src/compiler/ir1opt.lisp | 17 +++++---- src/compiler/ir1tran-lambda.lisp | 71 +++++++++++++++++--------------------- tests/compiler.pure.lisp | 9 +++++ version.lisp-expr | 2 +- 5 files changed, 56 insertions(+), 46 deletions(-) diff --git a/NEWS b/NEWS index 2eeaff2..136bb2d 100644 --- 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 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4