From 024389e7e3db268f535e36d883b4efc9d7ea0f65 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Wed, 17 Jun 2009 20:03:35 +0000 Subject: [PATCH] 1.0.29.13: relax CAST-EXTERNALLY-CHECKABLE-P a bit * Allows (lambda (x y) (string= x y)) to be compiled without inserting type-checks that will be done by STRING=* into the lambda. --- NEWS | 2 ++ src/compiler/checkgen.lisp | 42 +++++++++++++++++++++++++----------------- src/compiler/ir1util.lisp | 44 +++++++++++++++++++++++++++++++++++++++++--- src/pcl/sequence.lisp | 7 ++++++- version.lisp-expr | 2 +- 5 files changed, 75 insertions(+), 22 deletions(-) diff --git a/NEWS b/NEWS index 3fa4968..3c85592 100644 --- a/NEWS +++ b/NEWS @@ -4,6 +4,8 @@ * improvement: failure to provide requested stack allocation compiler notes provided in all cases (requested stack allocation not happening without a note being issued is now considered a bug.) + * optimization: compiler is smarter about delegating argument type checks to + callees. * bug fix: on 64 bit platforms FILL worked incorrectly on arrays with upgraded element type (COMPLEX SINGLE-FLOAT), regression from 1.0.28.55. (thanks to Paul Khuong) diff --git a/src/compiler/checkgen.lisp b/src/compiler/checkgen.lisp index addf025..46b32e1 100644 --- a/src/compiler/checkgen.lisp +++ b/src/compiler/checkgen.lisp @@ -315,28 +315,36 @@ (t (values :too-hairy nil))))) -;;; Do we want to do a type check? +;;; Return T is the cast appears to be from the declaration of the callee, +;;; and should be checked externally -- that is, by the callee and not the caller. (defun cast-externally-checkable-p (cast) (declare (type cast cast)) (let* ((lvar (node-lvar cast)) (dest (and lvar (lvar-dest lvar)))) (and (combination-p dest) - ;; The theory is that the type assertion is from a - ;; declaration in (or on) the callee, so the callee should be - ;; able to do the check. We want to let the callee do the - ;; check, because it is possible that by the time of call - ;; that declaration will be changed and we do not want to - ;; make people recompile all calls to a function when they - ;; were originally compiled with a bad declaration. (See also - ;; bug 35.) - (or (immediately-used-p lvar cast) - (binding* ((ctran (node-next cast) :exit-if-null) - (next (ctran-next ctran))) - (and (cast-p next) - (eq (node-dest next) dest) - (eq (cast-type-check next) :external)))) - (values-subtypep (lvar-externally-checkable-type lvar) - (cast-type-to-check cast))))) + ;; The theory is that the type assertion is from a declaration on the + ;; callee, so the callee should be able to do the check. We want to + ;; let the callee do the check, because it is possible that by the + ;; time of call that declaration will be changed and we do not want + ;; to make people recompile all calls to a function when they were + ;; originally compiled with a bad declaration. + ;; + ;; ALMOST-IMMEDIATELY-USED-P ensures that we don't delegate casts + ;; that occur before nodes that can cause observable side effects -- + ;; most commonly other non-external casts: so the order in which + ;; possible type errors are signalled matches with the evaluation + ;; order. + ;; + ;; FIXME: We should let more cases be handled by the callee then we + ;; currently do, see: https://bugs.launchpad.net/sbcl/+bug/309104 + ;; This is not fixable quite here, though, because flow-analysis has + ;; deleted the LVAR of the cast by the time we get here, so there is + ;; no destination. Perhaps we should mark cases inserted by + ;; ASSERT-CALL-TYPE explicitly, and delete those whose destination is + ;; deemed unreachable? + (almost-immediately-used-p lvar cast) + (values (values-subtypep (lvar-externally-checkable-type lvar) + (cast-type-to-check cast)))))) ;;; Return true if CAST's value is an lvar whose type the back end is ;;; likely to be able to check (see GENERATE-TYPE-CHECKS). Since we diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index 19e0adb..046c7bf 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -148,6 +148,43 @@ (eq (ctran-next it) dest)) (t (eq (block-start (first (block-succ (node-block node)))) (node-prev dest)))))) + +;;; Return true if LVAR destination is executed after node with only +;;; uninteresting nodes intervening. +;;; +;;; Uninteresting nodes are nodes in the same block which are either +;;; REFs, external CASTs to the same destination, or known combinations +;;; that never unwind. +(defun almost-immediately-used-p (lvar node) + (declare (type lvar lvar) + (type node node)) + (aver (eq (node-lvar node) lvar)) + (let ((dest (lvar-dest lvar))) + (tagbody + :next + (let ((ctran (node-next node))) + (cond (ctran + (setf node (ctran-next ctran)) + (if (eq node dest) + (return-from almost-immediately-used-p t) + (typecase node + (ref + (go :next)) + (cast + (when (and (eq :external (cast-type-check node)) + (eq dest (node-dest node))) + (go :next))) + (combination + ;; KLUDGE: Unfortunately we don't have an attribute for + ;; "never unwinds", so we just special case + ;; %ALLOCATE-CLOSURES: it is easy to run into with eg. + ;; FORMAT and a non-constant first argument. + (when (eq '%allocate-closures (combination-fun-source-name node nil)) + (go :next)))))) + (t + (when (eq (block-start (first (block-succ (node-block node)))) + (node-prev dest)) + (return-from almost-immediately-used-p t)))))))) ;;;; lvar substitution @@ -1884,9 +1921,10 @@ is :ANY, the function name is not checked." ;;; Return the source name of a combination. (This is an idiom ;;; which was used in CMU CL. I gather it always works. -- WHN) -(defun combination-fun-source-name (combination) - (let ((ref (lvar-uses (combination-fun combination)))) - (leaf-source-name (ref-leaf ref)))) +(defun combination-fun-source-name (combination &optional (errorp t)) + (let ((leaf (ref-leaf (lvar-uses (combination-fun combination))))) + (when (or errorp (leaf-has-source-name-p leaf)) + (leaf-source-name leaf)))) ;;; Return the COMBINATION node that is the call to the LET FUN. (defun let-combination (fun) diff --git a/src/pcl/sequence.lisp b/src/pcl/sequence.lisp index 46f3f85..295cc71 100644 --- a/src/pcl/sequence.lisp +++ b/src/pcl/sequence.lisp @@ -104,7 +104,12 @@ (values iterator limit from-end #'sequence:iterator-step #'sequence:iterator-endp #'sequence:iterator-element #'(setf sequence:iterator-element) - #'sequence:iterator-index #'sequence:iterator-copy)))) + #'sequence:iterator-index #'sequence:iterator-copy))) + (:method ((s t) &key from-end start end) + (declare (ignore from-end start end)) + (error 'type-error + :datum s + :expected-type 'sequence))) ;;; the simple protocol: the simple iterator returns three values, ;;; STATE, LIMIT and FROM-END. diff --git a/version.lisp-expr b/version.lisp-expr index b61c1d3..cc8762f 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".) -"1.0.29.12" +"1.0.29.13" -- 1.7.10.4