X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flocall.lisp;h=aa84315a06280270f1c50bd64944f42e0ca50b84;hb=95591ed483dbb8c0846c129953acac1554f28809;hp=1c6db26ec5390103b5c7821db9902f8dbb5d16ab;hpb=757091b10a73a7f6e2bd673bcf990ac93f23f77c;p=sbcl.git diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index 1c6db26..aa84315 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -43,36 +43,6 @@ (setf (car args) nil))) (values)) -(defun handle-nested-dynamic-extent-lvars (dx lvar) - (let ((uses (lvar-uses lvar))) - ;; DX value generators must end their blocks: see UPDATE-UVL-LIVE-SETS. - ;; Uses of mupltiple-use LVARs already end their blocks, so we just need - ;; to process uses of single-use LVARs. - (when (node-p uses) - (node-ends-block uses)) - ;; If this LVAR's USE is good for DX, it is either a CAST, or it - ;; must be a regular combination whose arguments are potentially DX as well. - (flet ((recurse (use) - (etypecase use - (cast - (handle-nested-dynamic-extent-lvars dx (cast-value use))) - (combination - (loop for arg in (combination-args use) - ;; deleted args show up as NIL here - when (and arg (lvar-good-for-dx-p arg dx)) - append (handle-nested-dynamic-extent-lvars dx arg))) - (ref - (let* ((other (trivial-lambda-var-ref-lvar use))) - (unless (eq other lvar) - (handle-nested-dynamic-extent-lvars dx other))))))) - (cons (cons dx lvar) - (if (listp uses) - (loop for use in uses - when (use-good-for-dx-p use dx) - nconc (recurse use)) - (when (use-good-for-dx-p uses dx) - (recurse uses))))))) - (defun recognize-dynamic-extent-lvars (call fun) (declare (type combination call) (type clambda fun)) (loop for arg in (basic-combination-args call) @@ -502,13 +472,13 @@ (declare (type ref ref) (type mv-combination call) (type functional fun)) (when (and (looks-like-an-mv-bind fun) (singleton-p (leaf-refs fun)) - (singleton-p (basic-combination-args call))) + (singleton-p (basic-combination-args call)) + (not (functional-entry-fun fun))) (let* ((*current-component* (node-component ref)) (ep (optional-dispatch-entry-point-fun fun (optional-dispatch-max-args fun)))) (when (null (leaf-refs ep)) (aver (= (optional-dispatch-min-args fun) 0)) - (aver (not (functional-entry-fun fun))) (setf (basic-combination-kind call) :local) (sset-adjoin ep (lambda-calls-or-closes (node-home-lambda call))) (merge-tail-sets call ep)