X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flocall.lisp;h=c423a66dd61093e80ecacbc6113a9afa6a6ac458;hb=dfa55a883f94470267b626dae77ce7e7dfac3df6;hp=dadfbddecc76cff68fee46b165577efde919ae5e;hpb=d147d512602d761a2dcdfded506dd1a8f9a140dc;p=sbcl.git diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index dadfbdd..c423a66 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -130,7 +130,7 @@ (temps (make-gensym-list (length (lambda-vars fun))))) `(lambda (,n-supplied ,@temps) (declare (type index ,n-supplied)) - ,(if (policy nil (zerop safety)) + ,(if (policy *lexenv* (zerop safety)) `(declare (ignore ,n-supplied)) `(%verify-argument-count ,n-supplied ,nargs)) (%funcall ,fun ,@temps)))) @@ -154,7 +154,7 @@ (cond ,@(if more (butlast (entries)) (entries)) ,@(when more - `((,(if (zerop min) 't `(>= ,n-supplied ,max)) + `((,(if (zerop min) t `(>= ,n-supplied ,max)) ,(let ((n-context (gensym)) (n-count (gensym))) `(multiple-value-bind (,n-context ,n-count) @@ -168,8 +168,7 @@ ;;; then associate this lambda with FUN as its XEP. After the ;;; conversion, we iterate over the function's associated lambdas, ;;; redoing local call analysis so that the XEP calls will get -;;; converted. We also bind *LEXENV* to change the compilation policy -;;; over to the interface policy. +;;; converted. ;;; ;;; We set REANALYZE and REOPTIMIZE in the component, just in case we ;;; discover an XEP after the initial local call analyze pass. @@ -177,14 +176,13 @@ (declare (type functional fun)) (aver (not (functional-entry-function fun))) (with-ir1-environment (lambda-bind (main-entry fun)) - (let* ((*lexenv* (make-lexenv :policy (make-interface-policy *lexenv*))) - (res (ir1-convert-lambda (make-xep-lambda fun)))) - (setf (functional-kind res) :external) - (setf (leaf-ever-used res) t) - (setf (functional-entry-function res) fun) - (setf (functional-entry-function fun) res) - (setf (component-reanalyze *current-component*) t) - (setf (component-reoptimize *current-component*) t) + (let ((res (ir1-convert-lambda (make-xep-lambda fun)))) + (setf (functional-kind res) :external + (leaf-ever-used res) t + (functional-entry-function res) fun + (functional-entry-function fun) res + (component-reanalyze *current-component*) t + (component-reoptimize *current-component*) t) (etypecase fun (clambda (local-call-analyze-1 fun)) (optional-dispatch @@ -295,7 +293,8 @@ (won nil) (res (catch 'local-call-lossage (prog1 - (ir1-convert-lambda (functional-inline-expansion fun)) + (ir1-convert-lambda (functional-inline-expansion + fun)) (setq won t))))) (cond (won (change-ref-leaf ref res) @@ -602,33 +601,33 @@ ;;;; LET conversion ;;;; -;;;; Converting to a LET has differing significance to various parts of the -;;;; compiler: -;;;; -- The body of a LET is spliced in immediately after the corresponding -;;;; combination node, making the control transfer explicit and allowing -;;;; LETs to be mashed together into a single block. The value of the LET is -;;;; delivered directly to the original continuation for the call, -;;;; eliminating the need to propagate information from the dummy result -;;;; continuation. -;;;; -- As far as IR1 optimization is concerned, it is interesting in that -;;;; there is only one expression that the variable can be bound to, and -;;;; this is easily substitited for. -;;;; -- LETs are interesting to environment analysis and to the back end -;;;; because in most ways a LET can be considered to be "the same function" -;;;; as its home function. -;;;; -- LET conversion has dynamic scope implications, since control transfers -;;;; within the same environment are local. In a local control transfer, -;;;; cleanup code must be emitted to remove dynamic bindings that are no -;;;; longer in effect. - -;;; Set up the control transfer to the called lambda. We split the call -;;; block immediately after the call, and link the head of FUN to the call -;;; block. The successor block after splitting (where we return to) is -;;; returned. -;;; -;;; If the lambda is is a different component than the call, then we call -;;; JOIN-COMPONENTS. This only happens in block compilation before -;;; FIND-INITIAL-DFO. +;;;; Converting to a LET has differing significance to various parts +;;;; of the compiler: +;;;; -- The body of a LET is spliced in immediately after the +;;;; corresponding combination node, making the control transfer +;;;; explicit and allowing LETs to be mashed together into a single +;;;; block. The value of the LET is delivered directly to the +;;;; original continuation for the call,eliminating the need to +;;;; propagate information from the dummy result continuation. +;;;; -- As far as IR1 optimization is concerned, it is interesting in +;;;; that there is only one expression that the variable can be bound +;;;; to, and this is easily substitited for. +;;;; -- LETs are interesting to environment analysis and to the back +;;;; end because in most ways a LET can be considered to be "the +;;;; same function" as its home function. +;;;; -- LET conversion has dynamic scope implications, since control +;;;; transfers within the same environment are local. In a local +;;;; control transfer, cleanup code must be emitted to remove +;;;; dynamic bindings that are no longer in effect. + +;;; Set up the control transfer to the called lambda. We split the +;;; call block immediately after the call, and link the head of FUN to +;;; the call block. The successor block after splitting (where we +;;; return to) is returned. +;;; +;;; If the lambda is is a different component than the call, then we +;;; call JOIN-COMPONENTS. This only happens in block compilation +;;; before FIND-INITIAL-DFO. (defun insert-let-body (fun call) (declare (type clambda fun) (type basic-combination call)) (let* ((call-block (node-block call)) @@ -874,7 +873,8 @@ (not (functional-entry-function fun))) (let* ((ref-cont (node-cont (first refs))) (dest (continuation-dest ref-cont))) - (when (and (basic-combination-p dest) + (when (and dest + (basic-combination-p dest) (eq (basic-combination-fun dest) ref-cont) (eq (basic-combination-kind dest) :local) (not (block-delete-p (node-block dest))) @@ -965,7 +965,9 @@ (call-fun nil)) (when (and (dolist (ref (leaf-refs fun) t) (let ((dest (continuation-dest (node-cont ref)))) - (when (block-delete-p (node-block dest)) (return nil)) + (when (or (not dest) + (block-delete-p (node-block dest))) + (return nil)) (let ((home (node-home-lambda ref))) (unless (eq home fun) (when call-fun (return nil))