From 1b80001626f929d44050b576ae0b96986489bad5 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Sat, 19 Mar 1994 22:38:45 +0000
Subject: [PATCH] Don't call valid-function-use on mv-combinations.  Don't
 annotate mv-calls to inline functions or slot accessors as though they were
 non-mv calls.

---
 compiler/byte-comp.lisp | 80 ++++++++++++++++++++++-------------------
 1 file changed, 43 insertions(+), 37 deletions(-)

diff --git a/compiler/byte-comp.lisp b/compiler/byte-comp.lisp
index 2c3839ee8..bcba96178 100644
--- a/compiler/byte-comp.lisp
+++ b/compiler/byte-comp.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/byte-comp.lisp,v 1.23 1994/03/07 11:35:30 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/byte-comp.lisp,v 1.24 1994/03/19 22:38:45 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -508,44 +508,50 @@
 	 (args (basic-combination-args call))
 	 (name (continuation-function-name fun))
 	 (info (gethash name *inline-function-table*)))
-    (cond ((and info
-		(valid-function-use call (inline-function-info-type info)))
-	   (annotate-basic-combination-args call)
-	   (setf (node-tail-p call) nil)
-	   (setf (basic-combination-info call) info)
-	   (annotate-continuation fun 0)
-	   (when (inline-function-info-safe info)
+    (flet ((annotate-args ()
+	     (annotate-basic-combination-args call)
 	     (dolist (arg args)
 	       (when (continuation-type-check arg)
-		 (setf (continuation-%type-check arg) :deleted)))))
-	  ((and (mv-combination-p call) (eq name '%throw))
-	   (assert (= (length args) 2))
-	   (annotate-continuation (first args) 1)
-	   (annotate-continuation (second args) :unknown)
-	   (setf (node-tail-p call) nil)
-	   (annotate-continuation fun 0))
-	  ((and name 
-		(let ((leaf (ref-leaf (continuation-use fun))))
-		  (and (slot-accessor-p leaf)
-		       (or (policy call (zerop safety))
-			   (not (find 't args :key #'continuation-type-check)))
-		       (if (consp name)
-			   (not (continuation-dest (node-cont call)))
-			   t))))
-	   (setf (basic-combination-info call)
-		 (gethash (if (consp name) '%setf-instance-ref '%instance-ref)
-			  *inline-function-table*))
-	   (setf (node-tail-p call) nil)
-	   (annotate-continuation fun 0)
-	   (annotate-basic-combination-args call))
-	  (t
-	   (annotate-basic-combination-args call)
-	   (dolist (arg args)
-	     (when (continuation-type-check arg)
-	       (setf (continuation-%type-check arg) :deleted)))
-	   (annotate-continuation
-	    fun
-	    (if (continuation-function-name fun) :fdefinition 1)))))
+		 (setf (continuation-%type-check arg) :deleted)))
+	     (annotate-continuation
+	      fun
+	      (if (continuation-function-name fun) :fdefinition 1))))
+      (cond ((mv-combination-p call)
+	     (cond ((eq name '%throw)
+		    (assert (= (length args) 2))
+		    (annotate-continuation (first args) 1)
+		    (annotate-continuation (second args) :unknown)
+		    (setf (node-tail-p call) nil)
+		    (annotate-continuation fun 0))
+		   (t
+		    (annotate-args))))
+	    ((and info
+		  (valid-function-use call (inline-function-info-type info)))
+	     (annotate-basic-combination-args call)
+	     (setf (node-tail-p call) nil)
+	     (setf (basic-combination-info call) info)
+	     (annotate-continuation fun 0)
+	     (when (inline-function-info-safe info)
+	       (dolist (arg args)
+		 (when (continuation-type-check arg)
+		   (setf (continuation-%type-check arg) :deleted)))))
+	    ((and name 
+		  (let ((leaf (ref-leaf (continuation-use fun))))
+		    (and (slot-accessor-p leaf)
+			 (or (policy call (zerop safety))
+			     (not (find 't args
+					:key #'continuation-type-check)))
+			 (if (consp name)
+			     (not (continuation-dest (node-cont call)))
+			     t))))
+	     (setf (basic-combination-info call)
+		   (gethash (if (consp name) '%setf-instance-ref '%instance-ref)
+			    *inline-function-table*))
+	     (setf (node-tail-p call) nil)
+	     (annotate-continuation fun 0)
+	     (annotate-basic-combination-args call))
+	    (t
+	     (annotate-args)))))
 
   ;; If this is (still) a tail-call, then blow away the return.
   (when (node-tail-p call)
-- 
GitLab