mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
Make stack allocating anonymous closures work.
* Introduce a DX-INFO structure to do the bookkeeping better. This way we don't need to do list hackery anymore during optimization, and we don't need to carry the DX kind on the cleanup. * Let-bound anonymous closures get marked as being dynamic extent when the LET variable gets substituted away with propagate-ref-dx. * Simplify RECOGNIZE-POTENTIALLY-DYNAMIC-EXTENT-LVARS a bit so we don't need to iterate over the DX lvars twice. * Simplify comments in DETERMINE-LAMBDA-VAR-AND-NLX-EXTENT: It tried to predict how this change would be implemented, but we just mark the extent of the main entry rather than the XEP when propagating DX, so the cases become uniform and we can simplify the logic and not rely on clever punning.
This commit is contained in:
Charles Zhang
parent
35c86a9d7e
commit
3252878f0d
4
NEWS
4
NEWS
|
|
@ -1,5 +1,9 @@
|
|||
;;;; -*- coding: utf-8; fill-column: 78 -*-
|
||||
|
||||
changes relative to sbcl-2.3.2:
|
||||
* enhancement: LET-bound anonymous closures declared dynamic extent can be
|
||||
stack allocated, just like closures bound with FLET or LABELS.
|
||||
|
||||
changes in sbcl-2.3.2 relative to sbcl-2.3.1:
|
||||
* incompatible change: the :ORDER long-form-option in
|
||||
DEFINE-METHOD-COMBINATION accepts NIL as well as :MOST-SPECIFIC-FIRST and
|
||||
|
|
|
|||
|
|
@ -184,41 +184,22 @@
|
|||
;;; CLAMBDAs that need checking.
|
||||
(defun determine-lambda-var-and-nlx-extent (component)
|
||||
(dolist (fun (component-lambdas component))
|
||||
(let ((entry-fun (functional-entry-fun fun)))
|
||||
;; We treat DYNAMIC-EXTENT declarations on functions as trusted
|
||||
;; assertions that none of the values closed over survive the
|
||||
;; extent of the function. We must 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)
|
||||
;; Functions without XEPs can be treated as if they
|
||||
;; are DYNAMIC-EXTENT, even without being so
|
||||
;; declared, as any escaping closure which /isn't/
|
||||
;; DYNAMIC-EXTENT but calls one of these functions
|
||||
;; will also close over the required variables or
|
||||
;; exits, thus forcing the allocation of value
|
||||
;; cells. Since the XEP is stored in the ENTRY-FUN
|
||||
;; slot, we can pick off the non-XEP case here.
|
||||
(not entry-fun)
|
||||
(leaf-dynamic-extent entry-fun))
|
||||
(let ((closure (environment-closure (lambda-environment fun))))
|
||||
(dolist (thing closure)
|
||||
(typecase thing
|
||||
(lambda-var
|
||||
(when (lambda-var-indirect thing)
|
||||
(setf (lambda-var-explicit-value-cell thing) t)))
|
||||
(nlx-info
|
||||
(let ((exit (nlx-info-exit thing)))
|
||||
(unless (policy exit (zerop safety))
|
||||
(setf (nlx-info-safe-p thing) t)
|
||||
(note-exit-check-elision-failure exit)))))))))))
|
||||
(when (and (eq (functional-kind fun) :external)
|
||||
;; We treat DYNAMIC-EXTENT declarations on functions as
|
||||
;; trusted assertions that none of the values closed
|
||||
;; over survive the extent of the function.
|
||||
(not (leaf-dynamic-extent (functional-entry-fun fun))))
|
||||
(let ((closure (environment-closure (lambda-environment fun))))
|
||||
(dolist (thing closure)
|
||||
(typecase thing
|
||||
(lambda-var
|
||||
(when (lambda-var-indirect thing)
|
||||
(setf (lambda-var-explicit-value-cell thing) t)))
|
||||
(nlx-info
|
||||
(let ((exit (nlx-info-exit thing)))
|
||||
(unless (policy exit (zerop safety))
|
||||
(setf (nlx-info-safe-p thing) t)
|
||||
(note-exit-check-elision-failure exit))))))))))
|
||||
|
||||
(defun note-exit-check-elision-failure (exit)
|
||||
(when (policy exit (> speed safety))
|
||||
|
|
@ -355,11 +336,13 @@
|
|||
(when (and enclose (not (node-lvar enclose)))
|
||||
(let ((lvar (make-lvar)))
|
||||
(use-lvar enclose lvar)
|
||||
(let ((cleanup (node-enclosing-cleanup (ctran-next (node-next enclose)))))
|
||||
(aver (eq (cleanup-mess-up cleanup) enclose))
|
||||
(setf (lvar-dynamic-extent lvar) cleanup)
|
||||
(setf (cleanup-nlx-info cleanup) (list lvar)))
|
||||
;; THe node component of ENCLOSE may be a different
|
||||
(let* ((cleanup (enclose-cleanup enclose))
|
||||
(dx-info (make-dx-info :kind 'enclose :value lvar
|
||||
:subparts (list lvar)
|
||||
:cleanup cleanup)))
|
||||
(setf (lvar-dynamic-extent lvar) dx-info)
|
||||
(setf (cleanup-nlx-info cleanup) (list dx-info)))
|
||||
;; The node component of ENCLOSE may be a different
|
||||
;; component for top level closure references. We
|
||||
;; always compile non-top-level components before
|
||||
;; top-level components, so this takes effect at the
|
||||
|
|
@ -367,16 +350,14 @@
|
|||
(push lvar (component-dx-lvars (node-component enclose))))))))))
|
||||
(dolist (entry (lambda-entries lambda))
|
||||
(let* ((cleanup (entry-cleanup entry))
|
||||
(lvar+extents (cleanup-nlx-info cleanup)))
|
||||
(dx-infos (cleanup-nlx-info cleanup)))
|
||||
(when (eq (cleanup-kind cleanup) :dynamic-extent)
|
||||
(setf (cleanup-nlx-info cleanup) nil)
|
||||
(dolist (lvar+extent lvar+extents)
|
||||
(declare (type cons lvar+extent))
|
||||
(let ((dx (car lvar+extent))
|
||||
(lvar (cdr lvar+extent)))
|
||||
(dolist (dx-info dx-infos)
|
||||
(let ((dx (dx-info-kind dx-info)))
|
||||
(aver (eq cleanup (dx-info-cleanup dx-info)))
|
||||
(labels ((mark-dx (lvar)
|
||||
(setf (lvar-dynamic-extent lvar) cleanup)
|
||||
(push lvar (cleanup-nlx-info cleanup))
|
||||
(setf (lvar-dynamic-extent lvar) dx-info)
|
||||
(push lvar (dx-info-subparts dx-info))
|
||||
(push lvar (component-dx-lvars component))
|
||||
;; Now look to see if there are otherwise
|
||||
;; inaccessible parts of the value in LVAR.
|
||||
|
|
@ -390,13 +371,14 @@
|
|||
(mark-dx arg))))
|
||||
(ref
|
||||
(mark-dx (let-var-initial-value (ref-leaf use))))))))
|
||||
;; Check that the LVAR hasn't been flushed somehow.
|
||||
(when (lvar-uses lvar)
|
||||
(cond ((lvar-good-for-dx-p lvar cleanup dx)
|
||||
(mark-dx lvar))
|
||||
(t
|
||||
(note-no-stack-allocation lvar)
|
||||
(setf (lvar-dynamic-extent lvar) nil)))))))))))
|
||||
(let ((lvar (dx-info-value dx-info)))
|
||||
;; Check that the value hasn't been flushed somehow.
|
||||
(when (lvar-uses lvar)
|
||||
(cond ((lvar-good-for-dx-p lvar cleanup dx)
|
||||
(mark-dx lvar))
|
||||
(t
|
||||
(note-no-stack-allocation lvar)
|
||||
(setf (lvar-dynamic-extent lvar) nil))))))))))))
|
||||
(values))
|
||||
|
||||
;;;; cleanup emission
|
||||
|
|
@ -442,8 +424,10 @@
|
|||
(dolist (nlx (cleanup-nlx-info cleanup))
|
||||
(code `(%lexical-exit-breakup ',nlx))))
|
||||
(:dynamic-extent
|
||||
(when (cleanup-nlx-info cleanup)
|
||||
(code `(%cleanup-point))))
|
||||
(dolist (dx-info (cleanup-nlx-info cleanup))
|
||||
(when (dx-info-subparts dx-info)
|
||||
(code `(%cleanup-point))
|
||||
(return))))
|
||||
(:restore-nsp
|
||||
(code `(%primitive set-nsp ,(ref-leaf node))))))))
|
||||
(flet ((coalesce-unbinds (code)
|
||||
|
|
|
|||
|
|
@ -930,9 +930,11 @@ also processed as top level forms."
|
|||
(enclose start enclose-ctran funs)
|
||||
(cond ((some #'leaf-dynamic-extent funs)
|
||||
(ctran-starts-block next)
|
||||
(let ((cleanup (make-cleanup :kind :dynamic-extent
|
||||
:mess-up (ctran-use enclose-ctran)))
|
||||
(cleanup-ctran (make-ctran)))
|
||||
(let* ((enclose (ctran-use enclose-ctran))
|
||||
(cleanup (make-cleanup :kind :dynamic-extent
|
||||
:mess-up enclose))
|
||||
(cleanup-ctran (make-ctran)))
|
||||
(setf (enclose-cleanup enclose) cleanup)
|
||||
(let ((*lexenv* (make-lexenv :cleanup cleanup)))
|
||||
(ir1-convert enclose-ctran cleanup-ctran nil '(%cleanup-point))
|
||||
(ir1-convert-progn-body cleanup-ctran next result body))))
|
||||
|
|
|
|||
|
|
@ -357,12 +357,12 @@
|
|||
(values))
|
||||
|
||||
(defun propagate-lvar-dx (new old)
|
||||
(let ((cleanup (lvar-dynamic-extent old)))
|
||||
(when cleanup
|
||||
(let ((dx-info (lvar-dynamic-extent old)))
|
||||
(when dx-info
|
||||
(setf (lvar-dynamic-extent old) nil)
|
||||
(unless (lvar-dynamic-extent new)
|
||||
(setf (lvar-dynamic-extent new) cleanup)
|
||||
(setf (cleanup-nlx-info cleanup) (subst new old (cleanup-nlx-info cleanup)))))))
|
||||
(setf (lvar-dynamic-extent new) dx-info)
|
||||
(setf (dx-info-value dx-info) new)))))
|
||||
|
||||
(defun lexenv-contains-lambda (lambda parent-lexenv)
|
||||
(loop for lexenv = (lambda-lexenv lambda)
|
||||
|
|
@ -380,15 +380,21 @@
|
|||
;;; (fill m)
|
||||
;;; m))))
|
||||
(defun propagate-ref-dx (new-ref old-lvar)
|
||||
(let ((dx (lvar-dynamic-extent old-lvar))
|
||||
(new-lambda-var (ref-leaf new-ref)))
|
||||
(when (and dx
|
||||
(lambda-var-p new-lambda-var)
|
||||
(eq (functional-kind (lambda-var-home new-lambda-var)) :let)
|
||||
;; Make sure the let is inside the dx let
|
||||
(lexenv-contains-lambda (lambda-var-home new-lambda-var)
|
||||
(node-lexenv (cleanup-mess-up dx))))
|
||||
(propagate-lvar-dx (let-var-initial-value new-lambda-var) old-lvar)
|
||||
(let ((dx-info (lvar-dynamic-extent old-lvar))
|
||||
(leaf (ref-leaf new-ref)))
|
||||
(when dx-info
|
||||
(let ((cleanup (dx-info-cleanup dx-info)))
|
||||
(typecase leaf
|
||||
(lambda-var
|
||||
(when (and (eq (functional-kind (lambda-var-home leaf)) :let)
|
||||
;; Make sure the let is inside the dx let
|
||||
(lexenv-contains-lambda (lambda-var-home leaf)
|
||||
(node-lexenv (cleanup-mess-up cleanup))))
|
||||
(propagate-lvar-dx (let-var-initial-value leaf) old-lvar)))
|
||||
(clambda
|
||||
(let ((fun (functional-entry-fun leaf)))
|
||||
(setf (enclose-cleanup (functional-enclose fun)) cleanup)
|
||||
(setf (leaf-extent fun) (dx-info-kind dx-info))))))
|
||||
t)))
|
||||
|
||||
(defun node-dominates-p (node1 node2)
|
||||
|
|
@ -758,7 +764,7 @@
|
|||
(principal-lvar-use (cast-value use))
|
||||
use)))
|
||||
(unless (or
|
||||
(eq (cleanup-dx-kind (lvar-dynamic-extent lvar))
|
||||
(eq (dx-info-kind (lvar-dynamic-extent lvar))
|
||||
'dynamic-extent-no-note)
|
||||
;; If we're flushing, don't complain if we can flush the combination.
|
||||
(and flush
|
||||
|
|
|
|||
|
|
@ -71,39 +71,34 @@
|
|||
;;; dynamic-extent allocate.
|
||||
(defun recognize-potentially-dynamic-extent-lvars (call fun)
|
||||
(declare (type combination call) (type clambda fun))
|
||||
(let* (no-notes
|
||||
(dx-lvars
|
||||
(loop for arg in (basic-combination-args call)
|
||||
for var in (lambda-vars fun)
|
||||
for dx = (leaf-dynamic-extent var)
|
||||
when (and dx arg (not (lvar-dynamic-extent arg)))
|
||||
collect (cons dx arg)
|
||||
do
|
||||
(when (eq dx 'dynamic-extent-no-note)
|
||||
(setf no-notes dx)))))
|
||||
(when dx-lvars
|
||||
(let* ((entry (with-ir1-environment-from-node call
|
||||
(make-entry)))
|
||||
(cleanup (make-cleanup :kind :dynamic-extent
|
||||
:mess-up entry
|
||||
:nlx-info dx-lvars
|
||||
:dx-kind no-notes)))
|
||||
(setf (entry-cleanup entry) cleanup)
|
||||
(insert-node-before call entry)
|
||||
(setf (node-lexenv call)
|
||||
(make-lexenv :default (node-lexenv call)
|
||||
:cleanup cleanup))
|
||||
(setf (ctran-next (node-prev call)) nil)
|
||||
(let ((ctran (make-ctran)))
|
||||
(with-ir1-environment-from-node call
|
||||
(ir1-convert (node-prev call) ctran nil '(%cleanup-point))
|
||||
(link-node-to-previous-ctran call ctran)))
|
||||
;; Make CALL end its block, so that we have a place to
|
||||
;; insert cleanup code.
|
||||
(node-ends-block call)
|
||||
(push entry (lambda-entries (node-home-lambda entry)))
|
||||
(dolist (cell dx-lvars)
|
||||
(setf (lvar-dynamic-extent (cdr cell)) cleanup)))))
|
||||
(let (entry cleanup)
|
||||
(loop for arg in (basic-combination-args call)
|
||||
for var in (lambda-vars fun)
|
||||
do (let ((dx-kind (leaf-dynamic-extent var)))
|
||||
(when (and arg dx-kind (not (lvar-dynamic-extent arg)))
|
||||
(unless entry
|
||||
(setq entry (with-ir1-environment-from-node call
|
||||
(make-entry)))
|
||||
(setq cleanup (make-cleanup :kind :dynamic-extent
|
||||
:mess-up entry))
|
||||
(setf (entry-cleanup entry) cleanup)
|
||||
(insert-node-before call entry)
|
||||
(setf (node-lexenv call)
|
||||
(make-lexenv :default (node-lexenv call)
|
||||
:cleanup cleanup))
|
||||
(setf (ctran-next (node-prev call)) nil)
|
||||
(let ((ctran (make-ctran)))
|
||||
(with-ir1-environment-from-node call
|
||||
(ir1-convert (node-prev call) ctran nil '(%cleanup-point))
|
||||
(link-node-to-previous-ctran call ctran)))
|
||||
;; Make CALL end its block, so that we have a place to
|
||||
;; insert cleanup code.
|
||||
(node-ends-block call)
|
||||
(push entry (lambda-entries (node-home-lambda entry))))
|
||||
(let ((dx-info (make-dx-info :kind dx-kind :value arg
|
||||
:cleanup cleanup)))
|
||||
(setf (lvar-dynamic-extent arg) dx-info)
|
||||
(push dx-info (cleanup-nlx-info cleanup)))))))
|
||||
(values))
|
||||
|
||||
;;; This function handles merging the tail sets if CALL is potentially
|
||||
|
|
@ -1270,6 +1265,7 @@
|
|||
(leaf-type var))
|
||||
(let ((use-component (node-component use)))
|
||||
(propagate-lvar-annotations-to-refs arg var)
|
||||
(propagate-ref-dx use arg)
|
||||
(update-lvar-dependencies leaf arg)
|
||||
(substitute-leaf-if
|
||||
(lambda (ref)
|
||||
|
|
|
|||
|
|
@ -194,8 +194,8 @@
|
|||
;; the optimizer for this node type doesn't care, it can elect not
|
||||
;; to clear this flag.
|
||||
(reoptimize t :type boolean)
|
||||
;; if the LVAR value is DYNAMIC-EXTENT, CLEANUP protecting it.
|
||||
(dynamic-extent nil :type (or null cleanup))
|
||||
;; if the LVAR value is DYNAMIC-EXTENT, some information.
|
||||
(dynamic-extent nil :type (or null dx-info))
|
||||
;; something or other that the back end annotates this lvar with
|
||||
(info nil)
|
||||
;; Nodes to reoptimize together with the lvar
|
||||
|
|
@ -204,6 +204,21 @@
|
|||
(dependent-annotations nil))
|
||||
(!set-load-form-method lvar (:xc :target) :ignore-it)
|
||||
|
||||
;;; A DX-INFO structure is used to accumulate information about a
|
||||
;;; dynamic extent declaration.
|
||||
(defstruct (dx-info (:copier nil))
|
||||
;; The kind of dynamic extent this is.
|
||||
(kind (missing-arg) :type (member enclose dynamic-extent truly-dynamic-extent
|
||||
dynamic-extent-no-note))
|
||||
;; The value recognized to be declared dynamic extent.
|
||||
(value (missing-arg) :type lvar)
|
||||
;; The stack-allocatable values in the transitive closure of the
|
||||
;; relation determined by the "otherwise inaccessible part"
|
||||
;; criterion. This is filled in by environment analysis.
|
||||
(subparts nil :type list)
|
||||
;; The CLEANUP associated with this dynamic extent.
|
||||
(cleanup (missing-arg) :type cleanup))
|
||||
|
||||
;;; These are used for annotating a LVAR with information that can't
|
||||
;;; be expressed using types or if the CAST semantics are undesirable
|
||||
;;; (type derivation, runtime errors).
|
||||
|
|
@ -695,13 +710,9 @@
|
|||
;; structures whose NLX-INFO-CLEANUP is this cleanup. This is filled
|
||||
;; in by environment analysis.
|
||||
;;
|
||||
;; For :DYNAMIC-EXTENT: a list of all DX LVARs, preserved by this
|
||||
;; cleanup. This is filled when the cleanup is created (now by
|
||||
;; locall call analysis) and is rechecked by environment
|
||||
;; analysis. (For closures this is a list of the LVAR of the enclose
|
||||
;; after environment analysis.)
|
||||
(nlx-info nil :type list)
|
||||
(dx-kind nil))
|
||||
;; For :DYNAMIC-EXTENT: a list of all DX-INFOs, preserved by this
|
||||
;; cleanup.
|
||||
(nlx-info nil :type list))
|
||||
(defprinter (cleanup :identity t)
|
||||
kind
|
||||
mess-up
|
||||
|
|
@ -1720,8 +1731,11 @@
|
|||
;;; would be emitted, if necessary.
|
||||
(defstruct (enclose (:include valued-node) ; this node uses a dummy lvar for dx analysis
|
||||
(:copier nil))
|
||||
;; the list of functionals that this ENCLOSE node allocates.
|
||||
(funs nil :type list))
|
||||
;; The list of functionals that this ENCLOSE node allocates.
|
||||
(funs nil :type list)
|
||||
;; The cleanup for this enclose if any of its functionals are
|
||||
;; declared dynamic extent.
|
||||
(cleanup nil :type (or null cleanup)))
|
||||
(defprinter (enclose :identity t)
|
||||
funs)
|
||||
|
||||
|
|
|
|||
|
|
@ -181,17 +181,17 @@
|
|||
marked)))))
|
||||
(back-propagate-pathwise block))))
|
||||
|
||||
(defun back-propagate-dx-lvars (block dx-lvars)
|
||||
(declare (type cblock block)
|
||||
(type list dx-lvars))
|
||||
(dolist (dx-lvar dx-lvars)
|
||||
(back-propagate-one-dx-lvar block dx-lvar)))
|
||||
(defun back-propagate-dx-lvars (block dx-infos)
|
||||
(declare (type cblock block))
|
||||
(dolist (dx-info dx-infos)
|
||||
(dolist (dx-lvar (dx-info-subparts dx-info))
|
||||
(back-propagate-one-dx-lvar block dx-lvar))))
|
||||
|
||||
;;; Update information on stacks of unknown-values LVARs on the
|
||||
;;; boundaries of BLOCK. Return true if the start stack has been
|
||||
;;; changed.
|
||||
;;;
|
||||
;;; An LVAR is live at the end iff it is live at some of blocks, which
|
||||
;;; An LVAR is live at the end iff it is live at any of blocks which
|
||||
;;; BLOCK can transfer control to. There are two kind of control
|
||||
;;; transfers: normal, expressed with BLOCK-SUCC, and NLX.
|
||||
(defun update-uvl-live-sets (block)
|
||||
|
|
@ -221,26 +221,27 @@
|
|||
(setq new-end (merge-uvl-live-sets
|
||||
new-end next-stack)))))
|
||||
(:dynamic-extent
|
||||
(dolist (lvar (cleanup-nlx-info cleanup))
|
||||
(do-uses (generator lvar)
|
||||
(let* ((block (node-block generator))
|
||||
(2block (block-info block)))
|
||||
;; DX objects, living in the LVAR, are alive in
|
||||
;; the environment, protected by the CLEANUP. We
|
||||
;; also cannot move them (because, in general, we
|
||||
;; cannot track all references to them).
|
||||
;; Therefore, everything, allocated deeper than a
|
||||
;; DX object -- that is, before the DX object --
|
||||
;; should be kept alive until the object is
|
||||
;; deallocated.
|
||||
(setq new-end (merge-uvl-live-sets
|
||||
new-end
|
||||
(set-difference
|
||||
(ir2-block-start-stack 2block)
|
||||
(ir2-block-popped 2block))))
|
||||
(setq new-end (merge-uvl-live-sets
|
||||
new-end
|
||||
(ir2-block-pushed-before lvar 2block))))))
|
||||
(dolist (dx-info (cleanup-nlx-info cleanup))
|
||||
(dolist (lvar (dx-info-subparts dx-info))
|
||||
(do-uses (generator lvar)
|
||||
(let* ((block (node-block generator))
|
||||
(2block (block-info block)))
|
||||
;; DX objects, living in the LVAR, are alive in
|
||||
;; the environment, protected by the CLEANUP. We
|
||||
;; also cannot move them (because, in general, we
|
||||
;; cannot track all references to them).
|
||||
;; Therefore, everything, allocated deeper than a
|
||||
;; DX object -- that is, before the DX object --
|
||||
;; should be kept alive until the object is
|
||||
;; deallocated.
|
||||
(setq new-end (merge-uvl-live-sets
|
||||
new-end
|
||||
(set-difference
|
||||
(ir2-block-start-stack 2block)
|
||||
(ir2-block-popped 2block))))
|
||||
(setq new-end (merge-uvl-live-sets
|
||||
new-end
|
||||
(ir2-block-pushed-before lvar 2block)))))))
|
||||
;; We need to back-propagate the DX LVARs from the start of
|
||||
;; their environments to their allocation sites. The
|
||||
;; %CLEANUP-POINT funny function combination ensures the
|
||||
|
|
|
|||
|
|
@ -1768,3 +1768,15 @@
|
|||
(assert (sb-ext:stack-allocated-p (cdr x))))
|
||||
nil)
|
||||
((3) NIL)))
|
||||
|
||||
(with-test (:name :dx-anonymous-closure)
|
||||
(checked-compile-and-assert
|
||||
()
|
||||
'(lambda (z)
|
||||
(let ((x (lambda () (print z))))
|
||||
(declare (dynamic-extent x))
|
||||
(funcall x)
|
||||
(funcall x)
|
||||
(assert (sb-ext:stack-allocated-p x))
|
||||
(funcall x)))
|
||||
((3) 3)))
|
||||
|
|
|
|||
Loading…
Reference in a new issue