From 2d996b6c1f64a2a8f7515629bba134da0d0f0d32 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Sat, 15 Jan 2005 09:19:43 +0000 Subject: [PATCH] 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). --- NEWS | 5 +++++ doc/manual/compiler.texinfo | 1 + doc/manual/efficiency.texinfo | 4 +++- src/compiler/gtn.lisp | 4 +++- src/compiler/ir1tran-lambda.lisp | 3 ++- src/compiler/ir2tran.lisp | 24 +++++++++++++-------- src/compiler/node.lisp | 3 +++ src/compiler/physenvanal.lisp | 46 +++++++++------------------------------- src/compiler/policies.lisp | 5 +++++ tests/compiler.pure.lisp | 8 +++++++ version.lisp-expr | 2 +- 11 files changed, 56 insertions(+), 49 deletions(-) diff --git a/NEWS b/NEWS index addba38b9..ac0ca2e82 100644 --- a/NEWS +++ b/NEWS @@ -22,10 +22,15 @@ changes in sbcl-0.8.19 relative to sbcl-0.8.18: directories works correctly. (thanks to Artem V. Andreev) * fixed bug 125: compiler preserves identity of closures. (reported by Gabe Garza) + * bug fixed: functions with &REST arguments sometimes failed with + "Undefined function" when compiled with (DEBUG 3). (reported by + Robert J. Macomber) * build fix: fixed the dependence on *LOAD-PATHNAME* and *COMPILE-FILE-PATHNAME* being absolute pathnames. * on x86 compiler partially supports stack allocation of dynamic-extent closures. + * GO and RETURN-FROM do not check the extent of their exit points + when compiled with SAFETY 0. * fixed some bugs related to Unicode integration: ** encoding and decoding errors are now much more robustly handled; it should now be possible to recover even from invalid diff --git a/doc/manual/compiler.texinfo b/doc/manual/compiler.texinfo index f5924151c..546f817dd 100644 --- a/doc/manual/compiler.texinfo +++ b/doc/manual/compiler.texinfo @@ -858,6 +858,7 @@ is to slow the program by causing cache misses or even swapping. @c _ In addition to suppressing type checks, \code{0} also suppresses @c _ argument count checking, unbound-symbol checking and array bounds @c _ checks. +@c _ ... and checking of tag existence in RETURN-FROM and GO. @c _ @c _\item[\code{extensions:inhibit-warnings}] \cindex{inhibit-warnings @c _ optimization quality}This is a CMU extension that determines how diff --git a/doc/manual/efficiency.texinfo b/doc/manual/efficiency.texinfo index f857d6060..fb20ff1a7 100644 --- a/doc/manual/efficiency.texinfo +++ b/doc/manual/efficiency.texinfo @@ -196,7 +196,9 @@ or Stack allocation of closures, defined with @code{flet} or @code{labels} with a bound declaration @code{dynamic-extent}. Closed-over variables, which are assigned (either inside or outside -the closure), tags and blocks are still allocated on the heap. +the closure) are still allocated on the heap. Blocks and tags are also +allocated on the heap, unless all non-local control transfers to them +are compiled with zero @code{safety}. @end itemize diff --git a/src/compiler/gtn.lisp b/src/compiler/gtn.lisp index a6d56ea6e..c1fb1c72e 100644 --- a/src/compiler/gtn.lisp +++ b/src/compiler/gtn.lisp @@ -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)) diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp index 409443115..75c81eab4 100644 --- a/src/compiler/ir1tran-lambda.lisp +++ b/src/compiler/ir1tran-lambda.lisp @@ -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 diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp index 8157cd815..bf1796af8 100644 --- a/src/compiler/ir2tran.lisp +++ b/src/compiler/ir2tran.lisp @@ -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))) diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index 535af80c9..14c344491 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -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) diff --git a/src/compiler/physenvanal.lisp b/src/compiler/physenvanal.lisp index ff248e9f2..3cdb53b8c 100644 --- a/src/compiler/physenvanal.lisp +++ b/src/compiler/physenvanal.lisp @@ -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)) diff --git a/src/compiler/policies.lisp b/src/compiler/policies.lisp index 4680f71da..3295a6cce 100644 --- a/src/compiler/policies.lisp +++ b/src/compiler/policies.lisp @@ -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")) diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index ba1eeed36..6dd5498a2 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -1667,3 +1667,11 @@ (type (simple-array (unsigned-byte 32) (*)) v)) (setf (aref v 0) (* (* x #.(floor (ash 1 32) (* 11 80))) y)) nil))) + +;;; Bug reported by Robert J. Macomber: instrumenting of more-entry +;;; prevented open coding of %LISTIFY-REST-ARGS. +(let ((f (compile nil '(lambda () + (declare (optimize (debug 3))) + (with-simple-restart (blah "blah") (error "blah")))))) + (handler-bind ((error (lambda (c) (invoke-restart 'blah)))) + (assert (equal (multiple-value-list (funcall f)) '(nil t))))) diff --git a/version.lisp-expr b/version.lisp-expr index 4f91139e8..40f29adc3 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.8.18.32" +"0.8.18.33" -- 2.11.4.GIT