From 6e1eec3ed564da272ebf0caad99384670ad4a643 Mon Sep 17 00:00:00 2001 From: Alastair Bridgewater Date: Tue, 9 Nov 2010 19:46:33 +0000 Subject: [PATCH] 1.0.44.18: physenvanal: When checking closure-DXness, handle XEPs reasonably. * In ANALYZE-INDIRECT-LAMBDA-VARS, treat functionals as being DX if either they are marked as being DX or they have a FUNCTIONAL-ENTRY-FUN that is marked as being DX. * This extends the existing logic to allow functions with XEPs (those functions callable via the full-call convention) to use the ANCESTOR-FRAME optimizations. --- src/compiler/physenvanal.lisp | 24 ++++++++++++++++++------ version.lisp-expr | 2 +- 2 files changed, 19 insertions(+), 7 deletions(-) diff --git a/src/compiler/physenvanal.lisp b/src/compiler/physenvanal.lisp index fe6769c..d067c27 100644 --- a/src/compiler/physenvanal.lisp +++ b/src/compiler/physenvanal.lisp @@ -219,12 +219,24 @@ ;;; that need checking. (defun analyze-indirect-lambda-vars (component) (dolist (fun (component-lambdas component)) - (unless (leaf-dynamic-extent fun) - (let ((closure (physenv-closure (lambda-physenv fun)))) - (dolist (var closure) - (when (and (lambda-var-p var) - (lambda-var-indirect var)) - (setf (lambda-var-explicit-value-cell var) t))))))) + (let ((entry-fun (functional-entry-fun fun))) + ;; We also check the ENTRY-FUN, as XEPs for LABELS or FLET + ;; functions aren't set to be DX even if their underlying + ;; CLAMBDAs are, and if we ever get LET-bound anonymous function + ;; DX working, it would mark the XEP as being DX but not the + ;; "real" CLAMBDA. This works because a FUNCTIONAL-ENTRY-FUN is + ;; either NULL, a self-pointer (for :TOPLEVEL functions), a + ;; pointer from an XEP to its underlying function (for :EXTERNAL + ;; functions), or a pointer from an underlying function to its + ;; XEP (for non-:TOPLEVEL functions with XEPs). + (unless (or (leaf-dynamic-extent fun) + (and entry-fun + (leaf-dynamic-extent entry-fun))) + (let ((closure (physenv-closure (lambda-physenv fun)))) + (dolist (var closure) + (when (and (lambda-var-p var) + (lambda-var-indirect var)) + (setf (lambda-var-explicit-value-cell var) t)))))))) ;;;; non-local exit diff --git a/version.lisp-expr b/version.lisp-expr index 20784af..2e4c425 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".) -"1.0.44.17" +"1.0.44.18" -- 1.7.10.4