From 7931ba802412deaa862f85351621eaf19bb900a8 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Thu, 14 Feb 1991 20:44:33 +0000 Subject: [PATCH] Fixed IR1-OPTIMIZE-MV-CALL not to convert calls with more than one arg, and to convert the call immediately and check if it wins. --- compiler/ir1opt.lisp | 90 ++++++++++++++++++++++---------------------- 1 file changed, 45 insertions(+), 45 deletions(-) diff --git a/compiler/ir1opt.lisp b/compiler/ir1opt.lisp index 68c3cd103..7a6ea10b9 100644 --- a/compiler/ir1opt.lisp +++ b/compiler/ir1opt.lisp @@ -1215,7 +1215,6 @@ (when (and (ref-p use) (functional-p (ref-leaf use)) (not (eq (ref-inlinep use) :notinline))) (convert-call-if-possible use node) - (when (eq (basic-combination-kind node) :local)) (maybe-let-convert (ref-leaf use))))) (when (and (not (eq (basic-combination-kind node) :local)) (or fun-changed (find-if #'continuation-reoptimize args)) @@ -1254,8 +1253,9 @@ ;;; ;;; If possible, convert a general MV call to an MV-BIND. We can do this ;;; if: +;;; -- The call has only one argument, and ;;; -- The function has a known fixed number of arguments, or -;;; -- All the arguments yield a known fixed number of values. +;;; -- The argument yields a known fixed number of values. ;;; ;;; What we do is change the function in the MV-CALL to be a lambda that "looks ;;; like an MV bind", which allows IR1-OPTIMIZE-MV-COMBINATION to notice that @@ -1277,55 +1277,55 @@ ;;; (defun ir1-optimize-mv-call (node) (let ((fun (basic-combination-fun node)) - (total-nvals 0) (*compiler-error-context* node) - (ref (continuation-use (basic-combination-fun node)))) + (ref (continuation-use (basic-combination-fun node))) + (args (basic-combination-args node))) - (unless (and (ref-p ref) (constant-reference-p ref)) + (unless (and (ref-p ref) (constant-reference-p ref) + args (null (rest args))) (return-from ir1-optimize-mv-call)) (multiple-value-bind (min max) (function-type-nargs (continuation-type fun)) - (dolist (arg (basic-combination-args node)) - (multiple-value-bind (types nvals) - (values-types (continuation-derived-type arg)) - (declare (ignore types)) - (when (eq nvals :unknown) - (setq total-nvals nil) - (return)) - (incf total-nvals nvals))) - - (when total-nvals - (when (and min (< total-nvals min)) - (compiler-warning - "MULTIPLE-VALUE-CALL with ~R values when the function expects ~ - at least ~R." - total-nvals min) - (setf (ref-inlinep ref) :notinline) - (return-from ir1-optimize-mv-call)) - (when (and max (> total-nvals max)) - (compiler-warning - "MULTIPLE-VALUE-CALL with ~R values when the function expects ~ - at most ~R." - total-nvals max) - (setf (ref-inlinep ref) :notinline) - (return-from ir1-optimize-mv-call))) - - (let ((count (cond (total-nvals) - ((and (policy node (zerop safety)) (eql min max)) - min) - (t nil)))) - (when count - (with-ir1-environment node - (let* ((dums (loop repeat count collect (gensym))) - (ignore (gensym)) - (fun (ir1-convert-lambda - `(lambda (&optional ,@dums &rest ,ignore) - (declare (ignore ,ignore)) - (funcall ,(ref-leaf ref) ,@dums))))) - (change-ref-leaf ref fun) - (setf (basic-combination-kind node) :full) - (local-call-analyze *current-component*))))))) + (let ((total-nvals + (multiple-value-bind + (types nvals) + (values-types (continuation-derived-type (first args))) + (declare (ignore types)) + (if (eq nvals :unknown) nil nvals)))) + + (when total-nvals + (when (and min (< total-nvals min)) + (compiler-warning + "MULTIPLE-VALUE-CALL with ~R values when the function expects ~ + at least ~R." + total-nvals min) + (setf (ref-inlinep ref) :notinline) + (return-from ir1-optimize-mv-call)) + (when (and max (> total-nvals max)) + (compiler-warning + "MULTIPLE-VALUE-CALL with ~R values when the function expects ~ + at most ~R." + total-nvals max) + (setf (ref-inlinep ref) :notinline) + (return-from ir1-optimize-mv-call))) + + (let ((count (cond (total-nvals) + ((and (policy node (zerop safety)) (eql min max)) + min) + (t nil)))) + (when count + (with-ir1-environment node + (let* ((dums (loop repeat count collect (gensym))) + (ignore (gensym)) + (fun (ir1-convert-lambda + `(lambda (&optional ,@dums &rest ,ignore) + (declare (ignore ,ignore)) + (funcall ,(ref-leaf ref) ,@dums))))) + (change-ref-leaf ref fun) + (assert (eq (basic-combination-kind node) :full)) + (local-call-analyze *current-component*) + (assert (eq (functional-kind (ref-leaf ref)) :mv-let))))))))) (undefined-value)) -- GitLab