From: Nikodemus Siivola Date: Sun, 23 Oct 2011 09:37:42 +0000 (+0300) Subject: tweak tail merging logic X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=f7a78dd3554bd977b006e5da349a11d4e8463bb5;p=sbcl.git tweak tail merging logic TAIL-ANNOTATE used MERGE-TAIL-CALLS policy (which is an integer) as a boolean, instead of comparing it to zero. Oops. This means that we always did TCO when possible. Since adding a debug-catch-tag effectively prevents TCO, and the policy controlling that looks just like what we would like to have in MERGE-TAIL-CALLS if TAIL-ANNOTATE were to use it correctly... just deprecate MERGE-TAIL-CALLS instead. --- diff --git a/NEWS b/NEWS index b69cc16..8d62097 100644 --- a/NEWS +++ b/NEWS @@ -47,6 +47,9 @@ changes relative to sbcl-1.0.53: systems with getaddrinfo(). ** GET-HOST-BY-NAME and GET-HOST-BY-ADDRESS weren't thread or interrupt safe outside systems with getaddrinfo(). + * enhancement: special-case TCO prevention for functions which never return + extended to untrusted type, keeping one more frame's worth of debug + information around in many cases. * enhancement: debug-names of anonymous and local function are more descriptive. Affects backtraces and SB-SPROF results. (lp#805100) * enhancement: on CHENEYGC targets, SB-KERNEL:MAKE-LISP-OBJ now does diff --git a/contrib/sb-sprof/sb-sprof.lisp b/contrib/sb-sprof/sb-sprof.lisp index ab1edf2..dd1760c 100644 --- a/contrib/sb-sprof/sb-sprof.lisp +++ b/contrib/sb-sprof/sb-sprof.lisp @@ -514,7 +514,7 @@ profiling") ;;; This in turn will distribute the notice to those threads we are ;;; interested using SIGPROF. (defun thread-distribution-handler () - (declare (optimize sb-c::merge-tail-calls)) + (declare (optimize speed (space 0))) (when *sampling* #+sb-thread (let ((lock *distribution-lock*)) diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index e3ef6cf..4f433b1 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -149,6 +149,16 @@ (t (eq (block-start (first (block-succ (node-block node)))) (node-prev dest)))))) +;;; Returns the defined (usually untrusted) type of the combination, +;;; or NIL if we couldn't figure it out. +(defun combination-defined-type (combination) + (let ((use (principal-lvar-use (basic-combination-fun combination)))) + (or (when (ref-p use) + (let ((type (leaf-defined-type (ref-leaf use)))) + (when (fun-type-p type) + (fun-type-returns type)))) + *wild-type*))) + ;;; Return true if LVAR destination is executed after node with only ;;; uninteresting nodes intervening. ;;; diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index 9e605c1..4e18af7 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -163,9 +163,7 @@ ,(if (policy *lexenv* (zerop verify-arg-count)) `(declare (ignore ,n-supplied)) `(%verify-arg-count ,n-supplied ,nargs)) - (locally - (declare (optimize (merge-tail-calls 3))) - (%funcall ,fun ,@temps))))) + (%funcall ,fun ,@temps)))) (optional-dispatch (let* ((min (optional-dispatch-min-args fun)) (max (optional-dispatch-max-args fun)) @@ -190,9 +188,7 @@ ,(with-unique-names (n-context n-count) `(multiple-value-bind (,n-context ,n-count) (%more-arg-context ,n-supplied ,max) - (locally - (declare (optimize (merge-tail-calls 3))) - (%funcall ,more ,@temps ,n-context ,n-count))))))) + (%funcall ,more ,@temps ,n-context ,n-count)))))) (t (%arg-count-error ,n-supplied))))))))) diff --git a/src/compiler/physenvanal.lisp b/src/compiler/physenvanal.lisp index a2adbcc..615239a 100644 --- a/src/compiler/physenvanal.lisp +++ b/src/compiler/physenvanal.lisp @@ -496,26 +496,24 @@ (declare (type component component)) (dolist (fun (component-lambdas component)) (let ((ret (lambda-return fun))) - ;; Nodes whose type is NIL (i.e. don't return) such as calls to - ;; ERROR are never annotated as TAIL-P, in order to preserve - ;; debugging information. - ;; - ;; FIXME: It might be better to add another DEFKNOWN property - ;; (e.g. NO-TAIL-RECURSION) and use it for error-handling - ;; functions like ERROR, instead of spreading this special case - ;; net so widely. --WHN? - ;; - ;; Why is that bad? Because this non-elimination of - ;; non-returning tail calls causes the XEP for FOO appear in - ;; backtrace for (defun foo (x) (error "foo ~S" x)) wich seems - ;; less then optimal. --NS 2005-02-28 (when ret (let ((result (return-result ret))) (do-uses (use result) - (when (and (policy use merge-tail-calls) - (basic-combination-p use) + (when (and (basic-combination-p use) (immediately-used-p result use) - (or (not (eq (node-derived-type use) *empty-type*)) - (eq (basic-combination-kind use) :local))) + (or (eq (basic-combination-kind use) :local) + ;; Nodes whose type is NIL (i.e. don't return) such + ;; as calls to ERROR are never annotated as TAIL-P, + ;; in order to preserve debugging information, so that + ;; + ;; We spread this net wide enough to catch + ;; untrusted NIL return types as well, so that + ;; frames calling functions such as FOO-ERROR are + ;; kept in backtraces: + ;; + ;; (defun foo-error (x) (error "oops: ~S" x)) + ;; + (not (or (eq *empty-type* (node-derived-type use)) + (eq *empty-type* (combination-defined-type use)))))) (setf (node-tail-p use) t))))))) (values)) diff --git a/src/compiler/policies.lisp b/src/compiler/policies.lisp index 18437bb..53b21e4 100644 --- a/src/compiler/policies.lisp +++ b/src/compiler/policies.lisp @@ -62,27 +62,18 @@ more reliable bactracing across foreign calls.") ("no" "maybe" "yes" "yes")) (define-optimization-quality merge-tail-calls - (if (or (> space debug) - (> speed debug)) - 3 - 0) - ("no" "maybe" "yes" "yes") - "Control whether tail-calls should reuse caller stack frame. -Enabling this option make functions use less stack space, and make -tail-recursive functions execute in constant stack, but debugging -become harder, because backtraces show only part of function call -sequence. - -This options has no effect when INSERT-DEBUG-CATCH is set.") + 3 + "Deprecated: has no effect on compiled code. (Never really did.)") (define-optimization-quality insert-debug-catch (if (> debug (max speed space)) 3 0) ("no" "maybe" "yes" "yes") - "Enable possibility of returning from stack frames with the debugger. - -Enabling this option effectively disables MERGE-TAIL-CALLS.") + "Enables possibility of returning from stack frames with the debugger. +Enabling this option causes apparent tail calls to no longer be in a tail +position -- effectively disabling tail-merging, hence causing apparently tail +recursive functions to no longer execute in constant stack space") (define-optimization-quality recognize-self-calls (if (> (max speed space) debug)