From: Alastair Bridgewater Date: Wed, 19 Jan 2011 21:59:23 +0000 (+0000) Subject: 1.0.45.5: life: Propagate implicit value cells through tail-calls. X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=3afdf2de234586523ed94941def9f25a8f7f4906;p=sbcl.git 1.0.45.5: life: Propagate implicit value cells through tail-calls. * When setting up "environment tn conflicts", recurse through callee environments when processing a block that ends in a tail local combination and a TN that represents an "implicit" value cell. * This closes the hole where a tail-local-call would replace the stack frame which allocated a closed-over lambda-var, but the inbound stack frame didn't know about the storage for the variable, leading to badness. Hopefully the last bug with the dynamic-extent closure representation changes. * This patch fixes what 1.0.44.34 was supposed to KLUDGE around, and finishes fixing lp#681092 (the first half of the fix being 1.0.44.33). --- diff --git a/NEWS b/NEWS index 76c54b1..fd5dbc1 100644 --- a/NEWS +++ b/NEWS @@ -1,4 +1,8 @@ ;;;; -*- coding: utf-8; fill-column: 78 -*- +changes relative to sbcl-1.0.45: + * bug fix: local tail calls to DYNAMIC-EXTENT functions can no longer cause + lifetime analysis to overwrite closed-over variables (lp#681092). + changes in sbcl-1.0.45 relative to sbcl-1.0.44: * enhancement: ~/ and ~user/ are treated specially in pathnames. Refer to documentation for details. diff --git a/src/compiler/life.lisp b/src/compiler/life.lisp index 6a89ee3..16449af 100644 --- a/src/compiler/life.lisp +++ b/src/compiler/life.lisp @@ -418,11 +418,31 @@ (return)))) (values)) +;;; Return true if TN represents a closed-over variable with an +;;; "implicit" value-cell. +(defun implicit-value-cell-tn-p (tn) + (let ((leaf (tn-leaf tn))) + (and (lambda-var-p leaf) + (lambda-var-indirect leaf) + (not (lambda-var-explicit-value-cell leaf))))) + +;;; If BLOCK ends with a TAIL LOCAL COMBINATION, the function called. +;;; Otherwise, NIL. +(defun block-tail-local-call-fun (block) + (let ((node (block-last block))) + (when (and (combination-p node) + (eq :local (combination-kind node)) + (combination-tail-p node)) + (ref-leaf (lvar-uses (combination-fun node)))))) + ;;; Iterate over all the blocks in ENV, setting up :LIVE conflicts for ;;; TN. We make the TN global if it isn't already. The TN must have at ;;; least one reference. -(defun setup-environment-tn-conflicts (component tn env debug-p) - (declare (type component component) (type tn tn) (type physenv env)) +(defun setup-environment-tn-conflicts (component tn env debug-p &optional parent-envs) + (declare (type component component) (type tn tn) (type physenv env) (type list parent-envs)) + (when (member env parent-envs) + ;; Prevent infinite recursion due to recursive tail calls. + (return-from setup-environment-tn-conflicts (values))) (when (and debug-p (not (tn-global-conflicts tn)) (tn-local tn)) @@ -437,7 +457,15 @@ prev)))) (do ((b last (ir2-block-prev b))) ((not (eq (ir2-block-block b) block))) - (setup-environment-tn-conflict tn b debug-p))))) + (setup-environment-tn-conflict tn b debug-p))) + ;; If BLOCK ends with a TAIL LOCAL COMBINATION and TN is an + ;; "implicit value cell" then setup conflicts for the callee + ;; function as well. + (let ((fun (and (implicit-value-cell-tn-p tn) + (block-tail-local-call-fun block)))) + (when fun + (setup-environment-tn-conflicts component tn (lambda-physenv fun) debug-p + (list* env parent-envs)))))) (values)) ;;; Iterate over all the environment TNs, adding always-live conflicts diff --git a/version.lisp-expr b/version.lisp-expr index eae7941..49f58c1 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -20,4 +20,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.45.4" +"1.0.45.5"