From: William H. N. <wn...@us...> - 2002-07-23 23:52:19
|
Update of /cvsroot/sbcl/sbcl/src/compiler In directory usw-pr-cvs1:/tmp/cvs-serv17979/src/compiler Modified Files: info-functions.lisp ir1opt.lisp ir1tran.lisp locall.lisp Log Message: 0.7.6.3: tweaked bsd-os.h to make the new sigaltstack(2) stuff build on OpenBSD/x86 fixed bug 189: Now FLET and LABELS inlining respects NOTINLINE declarations as required by ANSI. While I'm at it, suppress FLET/LABELS inlining when (> DEBUG SPEED) too. Index: info-functions.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/info-functions.lisp,v retrieving revision 1.15 retrieving revision 1.16 diff -u -d -r1.15 -r1.16 --- info-functions.lisp 15 Jan 2002 01:06:09 -0000 1.15 +++ info-functions.lisp 23 Jul 2002 23:52:16 -0000 1.16 @@ -189,10 +189,9 @@ (defun sb!xc:compiler-macro-function (name &optional env) #!+sb-doc - "If NAME names a compiler-macro, returns the expansion function, - else returns NIL. Note: if the name is shadowed in ENV by a local - definition, or declared NOTINLINE, NIL is returned. Can be - set with SETF." + "If NAME names a compiler-macro, return the expansion function, else + return NIL. Note: if the name is shadowed in ENV by a local definition, + or declared NOTINLINE, NIL is returned. Can be set with SETF." (let ((found (and env (cdr (assoc name (sb!c::lexenv-funs env) :test #'equal))))) Index: ir1opt.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1opt.lisp,v retrieving revision 1.38 retrieving revision 1.39 diff -u -d -r1.38 -r1.39 --- ir1opt.lisp 1 Jun 2002 02:34:52 -0000 1.38 +++ ir1opt.lisp 23 Jul 2002 23:52:16 -0000 1.39 @@ -1228,7 +1228,7 @@ (derive-node-type node (continuation-type (set-value node))) (values)) -;;; Return true if the value of Ref will always be the same (and is +;;; Return true if the value of REF will always be the same (and is ;;; thus legal to substitute.) (defun constant-reference-p (ref) (declare (type ref ref)) Index: ir1tran.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1tran.lisp,v retrieving revision 1.82 retrieving revision 1.83 diff -u -d -r1.82 -r1.83 --- ir1tran.lisp 23 Jul 2002 17:22:36 -0000 1.82 +++ ir1tran.lisp 23 Jul 2002 23:52:16 -0000 1.83 @@ -2065,8 +2065,8 @@ (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. + ;; 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 Index: locall.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/locall.lisp,v retrieving revision 1.33 retrieving revision 1.34 diff -u -d -r1.33 -r1.34 --- locall.lisp 11 Jul 2002 00:59:30 -0000 1.33 +++ locall.lisp 23 Jul 2002 23:52:16 -0000 1.34 @@ -970,58 +970,79 @@ (reoptimize-continuation (node-cont call)) (values)) +;;; Are there any declarations in force to say CLAMBDA shouldn't be +;;; LET converted? +(defun declarations-suppress-let-conversion-p (clambda) + ;; From the user's point of view, LET-converting something that + ;; has a name is inlining it. (The user can't see what we're doing + ;; with anonymous things, and suppressing inlining + ;; for such things can easily give Python acute indigestion, so + ;; we don't.) + (when (leaf-has-source-name-p clambda) + ;; ANSI requires that explicit NOTINLINE be respected. + (or (eq (lambda-inlinep clambda) :notinline) + ;; If (> DEBUG SPEED) we can guess that inlining generally + ;; won't be appreciated, but if the user specifically requests + ;; inlining, that takes precedence over our general guess. + (and (policy clambda (> debug speed)) + (not (eq (lambda-inlinep clambda) :inline)))))) + ;;; We also don't convert calls to named functions which appear in the ;;; initial component, delaying this until optimization. This ;;; minimizes the likelihood that we will LET-convert a function which ;;; may have references added due to later local inline expansion. (defun ok-initial-convert-p (fun) (not (and (leaf-has-source-name-p fun) - (eq (component-kind (lambda-component fun)) - :initial)))) + (or (declarations-suppress-let-conversion-p fun) + (eq (component-kind (lambda-component fun)) + :initial))))) ;;; This function is called when there is some reason to believe that ;;; CLAMBDA might be converted into a LET. This is done after local -;;; call analysis, and also when a reference is deleted. We only -;;; convert to a let when the function is a normal local function, has -;;; no XEP, and is referenced in exactly one local call. Conversion is -;;; also inhibited if the only reference is in a block about to be -;;; deleted. We return true if we converted. -;;; -;;; These rules may seem unnecessarily restrictive, since there are -;;; some cases where we could do the return with a jump that don't -;;; satisfy these requirements. The reason for doing things this way -;;; is that it makes the concept of a LET much more useful at the -;;; level of IR1 semantics. The :ASSIGNMENT function kind provides -;;; another way to optimize calls to single-return/multiple call -;;; functions. -;;; -;;; We don't attempt to convert calls to functions that have an XEP, -;;; since we might be embarrassed later when we want to convert a -;;; newly discovered local call. Also, see OK-INITIAL-CONVERT-P. +;;; call analysis, and also when a reference is deleted. We return +;;; true if we converted. (defun maybe-let-convert (clambda) (declare (type clambda clambda)) - (let ((refs (leaf-refs clambda))) - (when (and refs - (null (rest refs)) - (member (functional-kind clambda) '(nil :assignment)) - (not (functional-entry-fun clambda))) - (let* ((ref-cont (node-cont (first refs))) - (dest (continuation-dest ref-cont))) - (when (and dest - (basic-combination-p dest) - (eq (basic-combination-fun dest) ref-cont) - (eq (basic-combination-kind dest) :local) - (not (block-delete-p (node-block dest))) - (cond ((ok-initial-convert-p clambda) t) - (t - (reoptimize-continuation ref-cont) - nil))) - (unless (eq (functional-kind clambda) :assignment) - (let-convert clambda dest)) - (reoptimize-call dest) - (setf (functional-kind clambda) - (if (mv-combination-p dest) :mv-let :let)))) - t))) + (unless (declarations-suppress-let-conversion-p clambda) + ;; We only convert to a LET when the function is a normal local + ;; function, has no XEP, and is referenced in exactly one local + ;; call. Conversion is also inhibited if the only reference is in + ;; a block about to be deleted. + ;; + ;; These rules limiting LET conversion may seem unnecessarily + ;; restrictive, since there are some cases where we could do the + ;; return with a jump that don't satisfy these requirements. The + ;; reason for doing things this way is that it makes the concept + ;; of a LET much more useful at the level of IR1 semantics. The + ;; :ASSIGNMENT function kind provides another way to optimize + ;; calls to single-return/multiple call functions. + ;; + ;; We don't attempt to convert calls to functions that have an + ;; XEP, since we might be embarrassed later when we want to + ;; convert a newly discovered local call. Also, see + ;; OK-INITIAL-CONVERT-P. + (let ((refs (leaf-refs clambda))) + (when (and refs + (null (rest refs)) + (member (functional-kind clambda) '(nil :assignment)) + (not (functional-entry-fun clambda))) + (let* ((ref-cont (node-cont (first refs))) + (dest (continuation-dest ref-cont))) + (when (and dest + (basic-combination-p dest) + (eq (basic-combination-fun dest) ref-cont) + (eq (basic-combination-kind dest) :local) + (not (block-delete-p (node-block dest))) + (cond ((ok-initial-convert-p clambda) t) + (t + (reoptimize-continuation ref-cont) + nil))) + (unless (eq (functional-kind clambda) :assignment) + (let-convert clambda dest)) + (reoptimize-call dest) + (setf (functional-kind clambda) + (if (mv-combination-p dest) :mv-let :let)))) + t)))) ;;;; tail local calls and assignments |