X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flocall.lisp;h=2c413654ba3949ad8f52b3320adc34b2df3b25fb;hb=0e7a9105ae992fc4befa37846c42f298e12918c0;hp=ceff522a650a7a6593471dfd33b1f009f142c6e7;hpb=6d0c182ac7069b549c80feaa024caed176c4b35f;p=sbcl.git diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index ceff522..2c41365 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -131,7 +131,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 +191,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 +201,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 +276,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 +289,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 +357,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 +497,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 +833,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 +843,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 +860,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 +912,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 +1050,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 +1167,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)