X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flocall.lisp;h=4fe1a0e3c9508d631ee70dda9bb3f7bc17221baa;hb=6d69dfcc438b3530fa922e518919158ccf1af497;hp=ceff522a650a7a6593471dfd33b1f009f142c6e7;hpb=6d0c182ac7069b549c80feaa024caed176c4b35f;p=sbcl.git diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index ceff522..4fe1a0e 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -43,21 +43,30 @@ (setf (car args) nil))) (values)) + +(defun handle-nested-dynamic-extent-lvars (arg) + (let ((use (lvar-uses arg))) + ;; Stack analysis wants DX value generators to end their + ;; blocks. Uses of mupltiple used LVARs already end their blocks, + ;; so we just need to process used-once LVARs. + (when (node-p use) + (node-ends-block use)) + ;; If the function result is DX, so are its arguments... This + ;; assumes that all our DX functions do not store their arguments + ;; anywhere -- just use, and maybe return. + (if (basic-combination-p use) + (cons arg (funcall (lambda (lists) + (reduce #'append lists)) + (mapcar #'handle-nested-dynamic-extent-lvars (basic-combination-args use)))) + (list arg)))) + (defun recognize-dynamic-extent-lvars (call fun) (declare (type combination call) (type clambda fun)) (loop for arg in (basic-combination-args call) and var in (lambda-vars fun) - when (and arg - (lambda-var-dynamic-extent var) + when (and arg (lambda-var-dynamic-extent var) (not (lvar-dynamic-extent arg))) - collect arg into dx-lvars - and do (let ((use (lvar-uses arg))) - ;; Stack analysis wants DX value generators to end - ;; their blocks. Uses of mupltiple used LVARs already - ;; end their blocks, so we just need to process - ;; used-once LVARs. - (when (node-p use) - (node-ends-block use))) + append (handle-nested-dynamic-extent-lvars arg) into dx-lvars finally (when dx-lvars (binding* ((before-ctran (node-prev call)) (nil (ensure-block-start before-ctran)) @@ -131,7 +140,7 @@ (dolist (arg (basic-combination-args call)) (when arg (flush-lvar-externally-checkable-type arg)))) - (pushnew fun (lambda-calls-or-closes (node-home-lambda call))) + (sset-adjoin fun (lambda-calls-or-closes (node-home-lambda call))) (recognize-dynamic-extent-lvars call fun) (merge-tail-sets call fun) (change-ref-leaf ref fun) @@ -191,7 +200,7 @@ (optional-dispatch-entry-point-fun fun 0) (loop for ep in (optional-dispatch-entry-points fun) and n from min - do (entries `((= ,n-supplied ,n) + do (entries `((eql ,n-supplied ,n) (%funcall ,(force ep) ,@(subseq temps 0 n))))) `(lambda (,n-supplied ,@temps) ;; FIXME: Make sure that INDEX type distinguishes between @@ -201,7 +210,9 @@ (cond ,@(if more (butlast (entries)) (entries)) ,@(when more - `((,(if (zerop min) t `(>= ,n-supplied ,max)) + ;; KLUDGE: (NOT (< ...)) instead of >= avoids one round of + ;; deftransforms and lambda-conversion. + `((,(if (zerop min) t `(not (< ,n-supplied ,max))) ,(let ((n-context (gensym)) (n-count (gensym))) `(multiple-value-bind (,n-context ,n-count) @@ -274,7 +285,8 @@ ;;; do LET conversion here. (defun locall-analyze-fun-1 (fun) (declare (type functional fun)) - (let ((refs (leaf-refs fun))) + (let ((refs (leaf-refs fun)) + (local-p t)) (dolist (ref refs) (let* ((lvar (node-lvar ref)) (dest (when lvar (lvar-dest lvar)))) @@ -286,9 +298,12 @@ (convert-call-if-possible ref dest) (unless (eq (basic-combination-kind dest) :local) - (reference-entry-point ref))) + (reference-entry-point ref) + (setq local-p nil))) (t - (reference-entry-point ref))))))) + (reference-entry-point ref) + (setq local-p nil)))))) + (when local-p (note-local-functional fun))) (values)) @@ -351,8 +366,7 @@ (loop (let ((did-something nil)) (dolist (clambda clambdas) - (let* ((component (lambda-component clambda)) - (*all-components* (list component))) + (let ((component (lambda-component clambda))) ;; The original CMU CL code seemed to implicitly assume that ;; COMPONENT is the only one here. Let's make that explicit. (aver (= 1 (length (functional-components clambda)))) @@ -492,7 +506,7 @@ (aver (= (optional-dispatch-min-args fun) 0)) (aver (not (functional-entry-fun fun))) (setf (basic-combination-kind call) :local) - (pushnew ep (lambda-calls-or-closes (node-home-lambda call))) + (sset-adjoin ep (lambda-calls-or-closes (node-home-lambda call))) (merge-tail-sets call ep) (change-ref-leaf ref ep) @@ -828,7 +842,8 @@ (depart-from-tail-set clambda) (let* ((home (node-home-lambda call)) - (home-physenv (lambda-physenv home))) + (home-physenv (lambda-physenv home)) + (physenv (lambda-physenv clambda))) (aver (not (eq home clambda))) @@ -837,6 +852,11 @@ (setf (lambda-home clambda) home) (setf (lambda-physenv clambda) home-physenv) + (when physenv + (setf (physenv-nlx-info home-physenv) + (nconc (physenv-nlx-info physenv) + (physenv-nlx-info home-physenv)))) + ;; All of CLAMBDA's LETs belong to HOME now. (let ((lets (lambda-lets clambda))) (dolist (let lets) @@ -849,10 +869,9 @@ ;; HOME no longer calls CLAMBDA, and owns all of CLAMBDA's old ;; DFO dependencies. - (setf (lambda-calls-or-closes home) - (delete clambda - (nunion (lambda-calls-or-closes clambda) - (lambda-calls-or-closes home)))) + (sset-union (lambda-calls-or-closes home) + (lambda-calls-or-closes clambda)) + (sset-delete clambda (lambda-calls-or-closes home)) ;; CLAMBDA no longer has an independent existence as an entity ;; which calls things or has DFO dependencies. (setf (lambda-calls-or-closes clambda) nil) @@ -902,7 +921,7 @@ ;;; the RETURN-RESULT, because the return might have been deleted (if ;;; all calls were TR.) (defun unconvert-tail-calls (fun call next-block) - (dolist (called (lambda-calls-or-closes fun)) + (do-sset-elements (called (lambda-calls-or-closes fun)) (when (lambda-p called) (dolist (ref (leaf-refs called)) (let ((this-call (node-dest ref))) @@ -1040,7 +1059,8 @@ ;;; true if we converted. (defun maybe-let-convert (clambda) (declare (type clambda clambda)) - (unless (declarations-suppress-let-conversion-p clambda) + (unless (or (declarations-suppress-let-conversion-p clambda) + (functional-has-external-references-p clambda)) ;; We only convert to a LET when the function is a normal local ;; function, has no XEP, and is referenced in exactly one local ;; call. Conversion is also inhibited if the only reference is in @@ -1156,7 +1176,8 @@ (defun maybe-convert-to-assignment (clambda) (declare (type clambda clambda)) (when (and (not (functional-kind clambda)) - (not (functional-entry-fun clambda))) + (not (functional-entry-fun clambda)) + (not (functional-has-external-references-p clambda))) (let ((outside-non-tail-call nil) (outside-call nil)) (when (and (dolist (ref (leaf-refs clambda) t)