X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flocall.lisp;h=360c241d5071d763d5d27acc47adfc5f26dc155d;hb=403bacffd903f8c5787a182f4133cffc69b55dc0;hp=bf6c409fb1d257dbc8fab41f7befd27d03cf8b90;hpb=efb7317381c54e1a28f6c1c179a4fb8d58fdc7eb;p=sbcl.git diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index bf6c409..360c241 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -144,11 +144,12 @@ (n-supplied (gensym)) (temps (make-gensym-list max))) (collect ((entries)) - (do ((eps (optional-dispatch-entry-points fun) (rest eps)) - (n min (1+ n))) - ((null eps)) - (entries `((= ,n-supplied ,n) - (%funcall ,(first eps) ,@(subseq temps 0 n))))) + ;; Force convertion of all entries + (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) + (%funcall ,(force ep) ,@(subseq temps 0 n))))) `(lambda (,n-supplied ,@temps) ;; FIXME: Make sure that INDEX type distinguishes between ;; target and host. (Probably just make the SB!XC:DEFTYPE @@ -173,7 +174,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. +;;; converted. ;;; ;;; We set REANALYZE and REOPTIMIZE in the component, just in case we ;;; discover an XEP after the initial local call analyze pass. @@ -196,7 +197,7 @@ (locall-analyze-fun-1 fun)) (optional-dispatch (dolist (ep (optional-dispatch-entry-points fun)) - (locall-analyze-fun-1 ep)) + (locall-analyze-fun-1 (force ep))) (when (optional-dispatch-more-entry fun) (locall-analyze-fun-1 (optional-dispatch-more-entry fun))))) res))) @@ -315,7 +316,8 @@ ;; COMPONENT is the only one here. Let's make that explicit. (aver (= 1 (length (functional-components clambda)))) (aver (eql component (first (functional-components clambda)))) - (when (component-new-functionals component) + (when (or (component-new-functionals component) + (component-reanalyze-functionals component)) (setf did-something t) (locall-analyze-component component)))) (unless did-something @@ -332,27 +334,35 @@ (>= speed compilation-speed))) (not (eq (functional-kind (node-home-lambda call)) :external)) (inline-expansion-ok call)) - (multiple-value-bind (losing-local-functional converted-lambda) - (catch 'locall-already-let-converted - (with-ir1-environment-from-node call - (let ((*lexenv* (functional-lexenv original-functional))) - (values nil - (ir1-convert-lambda - (functional-inline-expansion original-functional) - :debug-name (debug-namify - "local inline ~A" - (leaf-debug-name - original-functional))))))) - (cond (losing-local-functional - (let ((*compiler-error-context* call)) - (compiler-note "couldn't inline expand because expansion ~ - calls this LET-converted local function:~ - ~% ~S" - (leaf-debug-name losing-local-functional))) - original-functional) - (t - (change-ref-leaf ref converted-lambda) - converted-lambda))) + (let* ((end (component-last-block (node-component call))) + (pred (block-prev end))) + (multiple-value-bind (losing-local-functional converted-lambda) + (catch 'locall-already-let-converted + (with-ir1-environment-from-node call + (let ((*lexenv* (functional-lexenv original-functional))) + (values nil + (ir1-convert-lambda + (functional-inline-expansion original-functional) + :debug-name (debug-namify + "local inline ~A" + (leaf-debug-name + original-functional))))))) + (cond (losing-local-functional + (let ((*compiler-error-context* call)) + (compiler-notify "couldn't inline expand because expansion ~ + calls this LET-converted local function:~ + ~% ~S" + (leaf-debug-name losing-local-functional))) + (loop for block = (block-next pred) then (block-next block) + until (eq block end) + do (setf (block-delete-p block) t)) + (loop for block = (block-next pred) then (block-next block) + until (eq block end) + do (delete-block block t)) + original-functional) + (t + (change-ref-leaf ref converted-lambda) + converted-lambda)))) original-functional)) ;;; Dispatch to the appropriate function to attempt to convert a call. @@ -431,7 +441,10 @@ (not (functional-entry-fun fun)) (= (length (leaf-refs fun)) 1) (= (length (basic-combination-args call)) 1)) - (let ((ep (car (last (optional-dispatch-entry-points fun))))) + (let* ((*current-component* (node-component ref)) + (ep (optional-dispatch-entry-point-fun + fun (optional-dispatch-max-args fun)))) + (aver (= (optional-dispatch-min-args fun) 0)) (setf (basic-combination-kind call) :local) (pushnew ep (lambda-calls-or-closes (node-home-lambda call))) (merge-tail-sets call ep) @@ -498,8 +511,9 @@ (setf (basic-combination-kind call) :error)) ((<= call-args max-args) (convert-call ref call - (elt (optional-dispatch-entry-points fun) - (- call-args min-args)))) + (let ((*current-component* (node-component ref))) + (optional-dispatch-entry-point-fun + fun (- call-args min-args))))) ((optional-dispatch-more-entry fun) (convert-more-call ref call fun)) (t @@ -596,7 +610,7 @@ (let ((cont (first key))) (unless (constant-continuation-p cont) (when flame - (compiler-note "non-constant keyword in keyword call")) + (compiler-notify "non-constant keyword in keyword call")) (setf (basic-combination-kind call) :error) (return-from convert-more-call)) @@ -610,7 +624,7 @@ (setq allow-found t allowp (continuation-value val))) (t (when flame - (compiler-note "non-constant :ALLOW-OTHER-KEYS value")) + (compiler-notify "non-constant :ALLOW-OTHER-KEYS value")) (setf (basic-combination-kind call) :error) (return-from convert-more-call))))) (dolist (var (key-vars)