From 50d252cde635ebb36aad114d22aa3283771381df Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Mon, 7 Sep 1992 16:01:25 +0000
Subject: [PATCH] Now local-call conversion is responsible for copying lambdas
 for copy-per-call inlining. Tweaked top-level code separation stuff to
 interface with dfo properly. Don't set LEAF-INLINEP anymore (use
 COMBINATION-KIND :ERROR).

---
 compiler/locall.lisp | 153 +++++++++++++++++++++++++------------------
 1 file changed, 91 insertions(+), 62 deletions(-)

diff --git a/compiler/locall.lisp b/compiler/locall.lisp
index 374a217ca..fbefc43f1 100644
--- a/compiler/locall.lisp
+++ b/compiler/locall.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/locall.lisp,v 1.34 1992/07/21 18:45:34 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/locall.lisp,v 1.35 1992/09/07 16:01:25 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -19,8 +19,8 @@
 ;;; places the body of the function inline.
 ;;;
 ;;;    We cannot always do a local call even when we do have the function being
-;;; called.  Local call can be explicitly disabled by a NOTINLINE declaration.
-;;; Calls that cannot be shown to have legal arg counts are also not converted.
+;;; called.  Calls that cannot be shown to have legal arg counts are not
+;;; converted.
 ;;;
 ;;; Written by Rob MacLachlan
 ;;;
@@ -151,7 +151,7 @@
 	   (temps (gensym)))
 	 `(lambda (,n-supplied ,@(temps))
 	    (declare (fixnum ,n-supplied))
-	    ,(if (policy (lambda-bind fun) (zerop safety))
+	    ,(if (policy nil (zerop safety))
 		 `(declare (ignore ,n-supplied))
 		 `(%verify-argument-count ,n-supplied ,nargs))
 	    (%funcall ,fun ,@(temps))))))
@@ -240,23 +240,19 @@
       (change-ref-leaf ref (or (functional-entry-function fun)
 			       (make-external-entry-point fun))))))
 
+
 
 ;;; Local-Call-Analyze-1  --  Interface
 ;;;
 ;;;    Attempt to convert all references to Fun to local calls.  The reference
-;;; cannot be :Notinline, and must be the function for a call.  The function
-;;; continuation must be used only once, since otherwise we cannot be sure what
-;;; function is to be called.  The call continuation would be multiply used if
-;;; there is hairy stuff such as conditionals in the expression that computes
-;;; the function.
-;;;
-;;;    Except in the interpreter, we don't attempt to convert calls that appear
-;;; in a top-level lambda unless there is only one reference or the function is
-;;; a unwind-protect cleanup.  This allows top-level components to contain only
-;;; load-time code: any references to run-time functions will be as closures.
+;;; must be the function for a call, and the function continuation must be used
+;;; only once, since otherwise we cannot be sure what function is to be called.
+;;; The call continuation would be multiply used if there is hairy stuff such
+;;; as conditionals in the expression that computes the function.
 ;;;
 ;;;    If we cannot convert a reference, then we mark the referenced function
-;;; as an entry-point, creating a new XEP if necessary.
+;;; as an entry-point, creating a new XEP if necessary.  We don't try to
+;;; convert calls that are in error (:ERROR kind.)
 ;;;
 ;;;    This is broken off from Local-Call-Analyze so that people can force
 ;;; analysis of newly introduced calls.  Note that we don't do let conversion
@@ -264,27 +260,22 @@
 ;;;
 (defun local-call-analyze-1 (fun)
   (declare (type functional fun))
-  (let ((refs (leaf-refs fun)))
+  (let ((refs (leaf-refs fun))
+	(first-time t))
     (dolist (ref refs)
       (let* ((cont (node-cont ref))
 	     (dest (continuation-dest cont)))
 	(cond ((and (basic-combination-p dest)
 		    (eq (basic-combination-fun dest) cont)
-		    (eq (continuation-use cont) ref)
-		    (or (null (rest refs))
-			*converting-for-interpreter*
-			(eq (functional-kind fun) :cleanup)
-			(not (eq (functional-kind (node-home-lambda ref))
-				 :top-level))))
-	       (ecase (ref-inlinep ref)
-		 ((nil :inline :maybe-inline)
-		  (convert-call-if-possible ref dest))
-		 ((:notinline)))
+		    (eq (continuation-use cont) ref))
+
+	       (convert-call-if-possible ref dest)
 	       
 	       (unless (eq (basic-combination-kind dest) :local)
 		 (reference-entry-point ref)))
 	      (t
-	       (reference-entry-point ref))))))
+	       (reference-entry-point ref))))
+      (setq first-time nil)))
 
   (undefined-value))
 
@@ -301,6 +292,9 @@
 ;;; triggered by reference deletion.  In particular, the Component-Lambdas are
 ;;; being hacked to remove newly deleted and let converted lambdas, so it is
 ;;; important that the lambda is added to the Component-Lambdas when it is.
+;;; Also, the COMPOENT-NEW-FUNCTIONS may contain all sorts of drivel, since it
+;;; is not updated when we delete functions, etc.  Only COMPONENT-LAMBDAS is
+;;; updated.
 ;;;
 (defun local-call-analyze (component)
   (declare (type component component))
@@ -308,7 +302,7 @@
     (unless (component-new-functions component) (return))
     (let* ((fun (pop (component-new-functions component)))
 	   (kind (functional-kind fun)))
-      (cond ((eq kind :deleted))
+      (cond ((member kind '(:deleted :let :mv-let :assignment)))
 	    ((and (null (leaf-refs fun)) (eq kind nil)
 		  (not (functional-entry-function fun)))
 	     (delete-functional fun))
@@ -322,41 +316,77 @@
   (undefined-value))
 
 
+;;; MAYBE-EXPAND-LOCAL-INLINE  --  Internal
+;;;
+;;;    If policy is auspicious, Call is not in an XEP, and we don't seem to be
+;;; in an infinite recursive loop, then change the reference to reference a
+;;; fresh copy.  We return whichever function we decide to reference.
+;;;
+(defun maybe-expand-local-inline (fun ref call)
+  (if (and (policy call (>= speed space) (>= speed cspeed))
+	   (not (eq (functional-kind (node-home-lambda call)) :external))
+	   (inline-expansion-ok call))
+      (with-ir1-environment call
+	(let* ((*lexical-environment* (functional-lexenv fun))
+	       (res (ir1-convert-lambda (functional-inline-expansion fun))))
+	  (change-ref-leaf ref res)
+	  res))
+      fun))
+
+
 ;;; Convert-Call-If-Possible  --  Interface
 ;;;
 ;;;    Dispatch to the appropriate function to attempt to convert a call.  This
 ;;; is called in IR1 optimize as well as in local call analysis.  If the call
-;;; is already :Local, we do nothing.  If the call is in the top-level
-;;; component, also do nothing, since we don't want to join top-level code into
-;;; normal components.
+;;; is is already :Local, we do nothing.  If the call is already scheduled for
+;;; deletion, also do nothing (in addition to saving time, this also avoids
+;;; some problems with optimizing collections of functions that are partially
+;;; deleted.)
+;;;
+;;;    This is called both before and after FIND-INITIAL-DFO runs.  When called
+;;; on a :INITIAL component, we don't care whether the caller and callee are in
+;;; the same component.  Afterward, we must stick with whatever component
+;;; division we have chosen.
+;;;
+;;;    Before attempting to convert a call, we see if the function is supposed
+;;; to be inline expanded.  Call conversion proceeds as before after any
+;;; expansion.
 ;;;
 ;;;    We bind *Compiler-Error-Context* to the node for the call so that
 ;;; warnings will get the right context.
 ;;;
+;;;
 (defun convert-call-if-possible (ref call)
   (declare (type ref ref) (type basic-combination call))
-  (unless (or (eq (basic-combination-kind call) :local)
-	      (let ((block (node-block call)))
-		(or (block-delete-p block)
-		    (eq (functional-kind (block-home-lambda block))
-			:deleted))))
-    (let ((fun (let ((fun (ref-leaf ref)))
-		 (if (external-entry-point-p fun)
-		     (functional-entry-function fun)
-		     fun)))
-	  (*compiler-error-context* call))
-      (let ((c1 (block-component (node-block call)))
-	    (c2 (block-component (node-block (lambda-bind (main-entry fun))))))
-	(assert (or (eq c1 c2)
-		    (and (eq (component-kind c1) :initial)
-			 (eq (component-kind c2) :initial)))))
-      (assert (member (functional-kind fun) '(nil :escape :cleanup :optional)))
-      (cond ((mv-combination-p call)
-	     (convert-mv-call ref call fun))
-	    ((lambda-p fun)
-	     (convert-lambda-call ref call fun))
-	    (t
-	     (convert-hairy-call ref call fun)))))
+  (let* ((block (node-block call))
+	 (component (block-component block))
+	 (original-fun (ref-leaf ref)))
+    (unless (or (member (basic-combination-kind call) '(:local :error))
+		(block-delete-p block)
+		(eq (functional-kind (block-home-lambda block)) :deleted)
+		(not (or (eq (component-kind component) :initial)
+			 (eq (block-component
+			      (node-block
+			       (lambda-bind (main-entry original-fun))))
+			     component))))
+      (let ((fun (if (external-entry-point-p original-fun)
+		     (functional-entry-function original-fun)
+		     original-fun))
+	    (*compiler-error-context* call))
+	
+	(when (and (eq (functional-inlinep fun) :inline)
+		   (rest (leaf-refs original-fun)))
+	  (setq fun (maybe-expand-local-inline fun ref call)))
+	
+	(assert (member (functional-kind fun)
+			'(nil :escape :cleanup :optional)))
+	(cond ((mv-combination-p call)
+	       (convert-mv-call ref call fun))
+	      ((lambda-p fun)
+	       (convert-lambda-call ref call fun))
+	      (t
+	       (convert-hairy-call ref call fun))))))
+
   (undefined-value))
 
 
@@ -398,7 +428,7 @@
 ;;; Convert-Lambda-Call  --  Internal
 ;;;
 ;;;    Attempt to convert a call to a lambda.  If the number of args is wrong,
-;;; we give a warning and mark the Ref as :Notinline to remove it from future
+;;; we give a warning and mark the call as :ERROR to remove it from future
 ;;; consideration.  If the argcount is O.K. then we just convert it.
 ;;;
 (defun convert-lambda-call (ref call fun)
@@ -411,7 +441,7 @@
 	   (compiler-warning
 	    "Function called with ~R argument~:P, but wants exactly ~R."
 	    call-args nargs)
-	   (setf (ref-inlinep ref) :notinline)))))
+	   (setf (basic-combination-kind call) :error)))))
 
 
 
@@ -433,7 +463,7 @@
     (cond ((< call-args min-args)
 	   (compiler-warning "Function called with ~R argument~:P, but wants at least ~R."
 			     call-args min-args)
-	   (setf (ref-inlinep ref) :notinline))
+	   (setf (basic-combination-kind call) :error))
 	  ((<= call-args max-args)
 	   (convert-call ref call
 			 (elt (optional-dispatch-entry-points fun)
@@ -443,8 +473,7 @@
 	  (t
 	   (compiler-warning "Function called with ~R argument~:P, but wants at most ~R."
 			     call-args max-args)
-	   (setf (ref-inlinep ref) :notinline))))
-
+	   (setf (basic-combination-kind call) :error))))
   (undefined-value))
 
 
@@ -526,7 +555,8 @@
 	(when (oddp (length more))
 	  (compiler-warning "Function called with odd number of ~
 	  		     arguments in keyword portion.")
-	  (setf (ref-inlinep ref) :notinline)
+
+	  (setf (basic-combination-kind call) :error)
 	  (return-from convert-more-call))
 
 	(do ((key more (cddr key))
@@ -536,7 +566,7 @@
 	    (unless (constant-continuation-p cont)
 	      (when flame
 		(compiler-note "Non-constant keyword in keyword call."))
-	      (setf (ref-inlinep ref) :notinline)
+	      (setf (basic-combination-kind call) :error)
 	      (return-from convert-more-call))
 	    
 	    (let ((name (continuation-value cont))
@@ -555,7 +585,7 @@
 	(when (and loser (not (optional-dispatch-allowp fun)))
 	  (compiler-warning "Function called with unknown argument keyword ~S."
 			    loser)
-	  (setf (ref-inlinep ref) :notinline)
+	  (setf (basic-combination-kind call) :error)
 	  (return-from convert-more-call)))
 
       (collect ((call-args))
@@ -837,7 +867,6 @@
     (move-return-stuff fun call next-block)
     (merge-lets fun call))
 
-  (maybe-remove-free-function fun)
   (dolist (arg (basic-combination-args call))
     (when arg
       (reoptimize-continuation arg)))
-- 
GitLab