From: Alexey D. <ade...@us...> - 2005-01-15 09:19:57
|
Update of /cvsroot/sbcl/sbcl/src/compiler In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8533/src/compiler Modified Files: gtn.lisp ir1tran-lambda.lisp ir2tran.lisp node.lisp physenvanal.lisp policies.lisp Log Message: 0.8.18.33: * When non-local lexical exits are compiled with (SAFETY 0), pass the unwind block without packing it into a VALUE-CELL. This disables checking of tag extent, but also eliminates one source of heap allocation in dynamic-extent closures. * Disable intrumenting of more-entries (bug reported by Robert J. Macomber). Index: gtn.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/gtn.lisp,v retrieving revision 1.15 retrieving revision 1.16 diff -u -d -r1.15 -r1.16 --- gtn.lisp 8 Jan 2005 09:41:48 -0000 1.15 +++ gtn.lisp 15 Jan 2005 09:19:45 -0000 1.16 @@ -210,6 +210,8 @@ (make-ir2-nlx-info :home (when (member (cleanup-kind (nlx-info-cleanup nlx)) '(:block :tagbody)) - (make-normal-tn *backend-t-primitive-type*)) + (if (nlx-info-safe-p nlx) + (make-normal-tn *backend-t-primitive-type*) + (make-stack-pointer-tn))) :save-sp (make-nlx-sp-tn physenv))))) (values)) Index: ir1tran-lambda.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1tran-lambda.lisp,v retrieving revision 1.22 retrieving revision 1.23 diff -u -d -r1.22 -r1.23 --- ir1tran-lambda.lisp 2 Oct 2004 07:48:33 -0000 1.22 +++ ir1tran-lambda.lisp 15 Jan 2005 09:19:45 -0000 1.23 @@ -505,7 +505,8 @@ :type (leaf-type var) :where-from (leaf-where-from var)))) - (let* ((n-context (gensym "N-CONTEXT-")) + (let* ((*allow-instrumenting* nil) + (n-context (gensym "N-CONTEXT-")) (context-temp (make-lambda-var :%source-name n-context)) (n-count (gensym "N-COUNT-")) (count-temp (make-lambda-var :%source-name n-count Index: ir2tran.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir2tran.lisp,v retrieving revision 1.58 retrieving revision 1.59 diff -u -d -r1.58 -r1.59 --- ir2tran.lisp 12 Jan 2005 17:57:15 -0000 1.58 +++ ir2tran.lisp 15 Jan 2005 09:19:45 -0000 1.59 @@ -1489,11 +1489,13 @@ ;;; IR2 converted. (defun ir2-convert-exit (node block) (declare (type exit node) (type ir2-block block)) - (let ((loc (find-in-physenv (exit-nlx-info node) - (node-physenv node))) - (temp (make-stack-pointer-tn)) - (value (exit-value node))) - (vop value-cell-ref node block loc temp) + (let* ((nlx (exit-nlx-info node)) + (loc (find-in-physenv nlx (node-physenv node))) + (temp (make-stack-pointer-tn)) + (value (exit-value node))) + (if (nlx-info-safe-p nlx) + (vop value-cell-ref node block loc temp) + (emit-move node block loc temp)) (if value (let ((locs (ir2-lvar-locs (lvar-info value)))) (vop unwind node block temp (first locs) (second locs))) @@ -1510,9 +1512,11 @@ ;;; dynamic extent. This is done by storing 0 into the indirect value ;;; cell that holds the closed unwind block. (defoptimizer (%lexical-exit-breakup ir2-convert) ((info) node block) - (vop value-cell-set node block - (find-in-physenv (lvar-value info) (node-physenv node)) - (emit-constant 0))) + (let ((nlx (lvar-value info))) + (when (nlx-info-safe-p nlx) + (vop value-cell-set node block + (find-in-physenv nlx (node-physenv node)) + (emit-constant 0))))) ;;; We have to do a spurious move of no values to the result lvar so ;;; that lifetime analysis won't get confused. @@ -1560,7 +1564,9 @@ (ecase kind ((:block :tagbody) - (do-make-value-cell node block res (ir2-nlx-info-home 2info))) + (if (nlx-info-safe-p info) + (do-make-value-cell node block res (ir2-nlx-info-home 2info)) + (emit-move node block res (ir2-nlx-info-home 2info)))) (:unwind-protect (vop set-unwind-protect node block block-tn)) (:catch))) Index: node.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/node.lisp,v retrieving revision 1.60 retrieving revision 1.61 diff -u -d -r1.60 -r1.61 --- node.lisp 12 Jan 2005 17:57:15 -0000 1.60 +++ node.lisp 15 Jan 2005 09:19:46 -0000 1.61 @@ -569,6 +569,9 @@ ;; has the original exit destination as its successor. Null only ;; temporarily. (target nil :type (or cblock null)) + ;; for a lexical exit it determines whether tag existence check is + ;; needed + (safe-p nil :type boolean) ;; some kind of info used by the back end info) (defprinter (nlx-info :identity t) Index: physenvanal.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/physenvanal.lisp,v retrieving revision 1.17 retrieving revision 1.18 diff -u -d -r1.17 -r1.18 --- physenvanal.lisp 12 Jan 2005 17:57:15 -0000 1.17 +++ physenvanal.lisp 15 Jan 2005 09:19:46 -0000 1.18 @@ -69,41 +69,6 @@ (setq found-it t))) found-it)) -;;; This is like old CMU CL PRE-ENVIRONMENT-ANALYZE-TOPLEVEL, except -;;; (1) It's been brought into the post-0.7.0 world where the property -;;; HAS-EXTERNAL-REFERENCES-P is orthogonal to the property of -;;; being specialized/optimized for locall at top level. -;;; (2) There's no return value, since we don't care whether we -;;; find any possible closure variables. -;;; -;;; I wish I could find an explanation of why -;;; PRE-ENVIRONMENT-ANALYZE-TOPLEVEL is important. The old CMU CL -;;; comments said -;;; Called on component with top level lambdas before the -;;; compilation of the associated non-top-level code to detect -;;; closed over top level variables. We just do COMPUTE-CLOSURE on -;;; all the lambdas. This will pre-allocate environments for all -;;; the functions with closed-over top level variables. The -;;; post-pass will use the existing structure, rather than -;;; allocating a new one. We return true if we discover any -;;; possible closure vars. -;;; But that doesn't seem to explain either why it's important to do -;;; this for top level lambdas, or why it's important to do it only -;;; for top level lambdas instead of just doing it indiscriminately -;;; for all lambdas. I do observe that when it's not done, compiler -;;; assertions occasionally fail. My tentative hypothesis for why it's -;;; important to do it is that other environment analysis expects to -;;; bottom out on the outermost enclosing thing, and (insert -;;; mysterious reason here) it's important to set up bottomed-out-here -;;; environments before anything else. I haven't been able to guess -;;; why it's important to do it selectively instead of -;;; indiscriminately. -- WHN 2001-11-10 -(defun preallocate-physenvs-for-toplevelish-lambdas (component) - (dolist (clambda (component-lambdas component)) - (when (lambda-toplevelish-p clambda) - (add-lambda-vars-and-let-vars-to-closures clambda))) - (values)) - ;;; If CLAMBDA has a PHYSENV, return it, otherwise assign an empty one ;;; and return that. (defun get-lambda-physenv (clambda) @@ -250,6 +215,11 @@ ;;;; non-local exit +#!-sb-fluid (declaim (inline should-exit-check-tag-p)) +(defun exit-should-check-tag-p (exit) + (declare (type exit exit)) + (not (zerop (policy exit check-tag-existence)))) + ;;; Insert the entry stub before the original exit target, and add a ;;; new entry to the PHYSENV-NLX-INFO. The %NLX-ENTRY call in the ;;; stub is passed the NLX-INFO as an argument so that the back end @@ -284,6 +254,7 @@ (setf (exit-nlx-info exit) info) (setf (nlx-info-target info) new-block) + (setf (nlx-info-safe-p info) (exit-should-check-tag-p exit)) (push info (physenv-nlx-info env)) (push info (cleanup-nlx-info cleanup)) (when (member (cleanup-kind cleanup) '(:catch :unwind-protect)) @@ -319,7 +290,10 @@ (aver (= (length (block-succ block)) 1)) (unlink-blocks block (first (block-succ block))) (link-blocks block (component-tail (block-component block))) - (setf (exit-nlx-info exit) info))) + (setf (exit-nlx-info exit) info) + (unless (nlx-info-safe-p info) + (setf (nlx-info-safe-p info) + (exit-should-check-tag-p exit))))) (t (insert-nlx-entry-stub exit env) (setq info (exit-nlx-info exit)) Index: policies.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/policies.lisp,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- policies.lisp 13 Sep 2004 07:14:41 -0000 1.6 +++ policies.lisp 15 Jan 2005 09:19:46 -0000 1.7 @@ -23,6 +23,11 @@ (t 2)) ("no" "maybe" "fast" "full")) +(define-optimization-quality check-tag-existence + (cond ((= safety 0) 0) + (t 3)) + ("no" "maybe" "yes" "yes")) + (define-optimization-quality let-convertion (if (<= debug speed) 3 0) ("off" "maybe" "on" "on")) |