X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1opt.lisp;h=2a7f9a1005d176342889c0c8b1109bd2a926a3a0;hb=a74b0bdb483504f6faddf8089f848f61ed94b92a;hp=e2abea6f7ac320583d23429d4fc4440bd63cd711;hpb=2bdf5a3484eda55b0d4b9313aa6b3505b6d7cbd8;p=sbcl.git diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index e2abea6..2a7f9a1 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -580,7 +580,7 @@ ;;; all functions in the tail set to be equivalent, this amounts to ;;; bringing the entire tail set up to date. We iterate over the ;;; returns for all the functions in the tail set, reanalyzing them -;;; all (not treating Node specially.) +;;; all (not treating NODE specially.) ;;; ;;; When we are done, we check whether the new type is different from ;;; the old TAIL-SET-TYPE. If so, we set the type and also reoptimize @@ -1322,12 +1322,14 @@ (null (lambda-var-sets leaf))) (defined-fun (not (eq (defined-fun-inlinep leaf) :notinline))) - #!+(and (not sb-fluid) (not sb-xc-host)) (global-var (case (global-var-kind leaf) - (:global-function (let ((name (leaf-source-name leaf))) - (eq (symbol-package (fun-name-block-name name)) - *cl-package*)))))))) + (:global-function + (let ((name (leaf-source-name leaf))) + (or #-sb-xc-host + (eq (symbol-package (fun-name-block-name name)) + *cl-package*) + (info :function :info name))))))))) ;;; If we have a non-set LET var with a single use, then (if possible) ;;; replace the variable reference's CONT with the arg continuation. @@ -1338,7 +1340,7 @@ ;;; -- either continuation has a funky TYPE-CHECK annotation. ;;; -- the continuations have incompatible assertions, so the new asserted type ;;; would be NIL. -;;; -- the var's DEST has a different policy than the ARG's (think safety). +;;; -- the VAR's DEST has a different policy than the ARG's (think safety). ;;; ;;; We change the REF to be a reference to NIL with unused value, and ;;; let it be flushed as dead code. A side effect of this substitution @@ -1352,7 +1354,7 @@ (dest (continuation-dest cont))) (when (and (eq (continuation-use cont) ref) dest - (not (typep dest '(or creturn exit mv-combination))) + (continuation-single-value-p cont) (eq (node-home-lambda ref) (lambda-home (lambda-var-home var))) (member (continuation-type-check arg) '(t nil)) @@ -1453,9 +1455,9 @@ ;;; If the function has an XEP, then we don't do anything, since we ;;; won't discover anything. ;;; -;;; We can clear the Continuation-Reoptimize flags for arguments in -;;; all calls corresponding to changed arguments in Call, since the -;;; only use in IR1 optimization of the Reoptimize flag for local call +;;; We can clear the CONTINUATION-REOPTIMIZE flags for arguments in +;;; all calls corresponding to changed arguments in CALL, since the +;;; only use in IR1 optimization of the REOPTIMIZE flag for local call ;;; args is right here. (defun propagate-local-call-args (call fun) (declare (type combination call) (type clambda fun)) @@ -1678,7 +1680,7 @@ (setf (node-prev use) nil) (setf (continuation-next node-prev) nil) (collect ((res vals)) - (loop as cont = (make-continuation use) + (loop for cont = (make-continuation use) and prev = node-prev then cont repeat (- nvars nvals) do (reference-constant prev cont nil) @@ -1711,6 +1713,8 @@ ;;; CONVERT-MV-BIND-TO-LET. We grab the args of LIST and make them ;;; args of the VALUES-LIST call, flushing the old argument ;;; continuation (allowing the LIST to be flushed.) +;;; +;;; FIXME: Thus we lose possible type assertions on (LIST ...). (defoptimizer (values-list optimizer) ((list) node) (let ((use (continuation-use list))) (when (and (combination-p use) @@ -1732,8 +1736,7 @@ ;;; to a PROG1. This allows the computation of the additional values ;;; to become dead code. (deftransform values ((&rest vals) * * :node node) - (when (typep (continuation-dest (node-cont node)) - '(or creturn exit mv-combination)) + (unless (continuation-single-value-p (node-cont node)) (give-up-ir1-transform)) (setf (node-derived-type node) *wild-type*) (if vals