From 7fae2af55971ce853d6b47a60dccdbad501e96b1 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 16 May 1987 19:48:05 +0000
Subject: [PATCH] For known calls to procedures that are not externally
 visible, do not pass arguments that correspond to parameters that are
 integrated in the body of the procedure.

---
 v7/src/compiler/rtlgen/rgcomb.scm | 84 ++++++++++++++++++++++---------
 1 file changed, 61 insertions(+), 23 deletions(-)

diff --git a/v7/src/compiler/rtlgen/rgcomb.scm b/v7/src/compiler/rtlgen/rgcomb.scm
index 15bbf0253..934ad2e77 100644
--- a/v7/src/compiler/rtlgen/rgcomb.scm
+++ b/v7/src/compiler/rtlgen/rgcomb.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgcomb.scm,v 1.17 1987/05/09 06:24:34 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgcomb.scm,v 1.18 1987/05/16 19:48:05 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -40,25 +40,32 @@ MIT in each case. |#
   (lambda (combination subproblem?)
     (if (combination-constant? combination)
 	(combination/constant combination subproblem?)
-	(let ((callee (combination-known-operator combination))
-	      (operator
-	       (generate/subproblem-cfg (combination-operator combination)))
-	      (operands
-	       (map generate/operand (combination-operands combination))))
-	  (or (and callee
-		   (normal-primitive-constant? callee)
-		   (let ((open-coder
-			  (assq (constant-value callee)
-				primitive-open-coders)))
-		     (and open-coder
-			  ((cdr open-coder) combination
-					    subproblem?
-					    operator
-					    operands))))
-	      (combination/normal combination
-				  subproblem?
-				  operator
-				  operands))))))
+	(let ((callee (combination-known-operator combination)))
+	  (let ((operator
+		 (generate/subproblem-cfg (combination-operator combination)))
+		(operands
+		 (if (and callee
+			  (procedure? callee)
+			  (not (procedure-externally-visible? callee)))
+		     (generate-operands (procedure-required callee)
+					(procedure-optional callee)
+					(procedure-rest callee)
+					(combination-operands combination))
+		     (map generate/operand (combination-operands combination)))))
+	    (or (and callee
+		     (normal-primitive-constant? callee)
+		     (let ((open-coder
+			    (assq (constant-value callee)
+				  primitive-open-coders)))
+		       (and open-coder
+			    ((cdr open-coder) combination
+					      subproblem?
+					      operator
+					      operands))))
+		(combination/normal combination
+				    subproblem?
+				    operator
+				    operands)))))))
 
 (define (combination/constant combination subproblem?)
   (generate/normal-statement combination subproblem?
@@ -78,6 +85,35 @@ MIT in each case. |#
 	      (else
 	       (error "Unknown combination value" value)))))))
 
+(define (generate-operands required optional rest operands)
+  (define (required-loop required operands)
+    (if (null? required)
+	(optional-loop optional operands)
+	(cons ((if (integrated-vnode? (car required))
+		   generate/operand-no-value
+		   generate/operand)
+	       (car operands))
+	      (required-loop (cdr required) (cdr operands)))))
+
+  (define (optional-loop optional operands)
+    (if (null? optional)
+	(if (not rest)
+	    '()
+	    (map (if (integrated-vnode? rest)
+		     generate/operand-no-value
+		     generate/operand)
+		 operands))
+	(cons ((if (integrated-vnode? (car optional))
+		   generate/operand-no-value
+		   generate/operand)
+	       (car operands))
+	      (optional-loop (cdr optional) (cdr operands)))))
+
+  (required-loop required operands))
+
+(define (generate/operand-no-value operand)
+  (return-3 (generate/subproblem-cfg operand) (make-null-cfg) false))
+
 (define (combination/normal combination subproblem? operator operands)
   ;; For the time being, all close-coded combinations will return
   ;; their values in the value register.
@@ -313,9 +349,11 @@ MIT in each case. |#
 	     (map (lambda (operand)
 		    (transmit-values operand
 		      (lambda (cfg prefix expression)
-			(scfg-append! cfg
-				      prefix
-				      (rtl:make-push expression)))))
+			(if expression
+			    (scfg-append! cfg
+					  prefix
+					  (rtl:make-push expression))
+			    cfg))))
 		  (reverse operands)))
 	    operator
 	    (if push-operator?
-- 
2.25.1