From 83bac5e0188c97dc76548eb700fc97a83ebaa064 Mon Sep 17 00:00:00 2001
From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Fri, 25 Nov 1994 16:29:40 +0000
Subject: [PATCH] Added code to include the parameters of `fat' procedures
 (thos ethat have some stack arguments) in the stack optimization.

---
 v8/src/compiler/midend/stackopt.scm | 32 +++++++++++++++++++++++++----
 1 file changed, 28 insertions(+), 4 deletions(-)

diff --git a/v8/src/compiler/midend/stackopt.scm b/v8/src/compiler/midend/stackopt.scm
index 05423f799..d1c8899fa 100644
--- a/v8/src/compiler/midend/stackopt.scm
+++ b/v8/src/compiler/midend/stackopt.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: stackopt.scm,v 1.1 1994/11/19 02:04:29 adams Exp $
+$Id: stackopt.scm,v 1.2 1994/11/25 16:29:40 adams Exp $
 
 Copyright (c) 1994 Massachusetts Institute of Technology
 
@@ -135,9 +135,14 @@ End of Big Note A |#
   `(LOOKUP ,name))
 
 (define-stack-optimizer LAMBDA (state lambda-list body)
-  state					; ignored
-  `(LAMBDA ,lambda-list
-     ,(stackopt/expr false body)))
+  (define (wrap body)
+    `(LAMBDA ,lambda-list ,body))
+  (cond ((form/match stackopt/fat-procedure-body-pattern body)
+	 => (lambda (result)
+	      (wrap (stackopt/fat-procedure state body result))))
+	(else
+	 (wrap (stackopt/expr false body)))))
+
 
 (define-stack-optimizer LET (state bindings body)
   `(LET ,(lmap (lambda (binding)
@@ -295,6 +300,25 @@ End of Big Note A |#
 	 ,@stackopt/?closure-elts))
 
 
+(define stackopt/fat-procedure-body-pattern
+  `(LET ((,stackopt/?frame-name
+	  (CALL (QUOTE ,%fetch-stack-closure)
+		(QUOTE #F)
+		(QUOTE ,stackopt/?frame-vector))))
+     ,stackopt/?body))
+
+
+(define (stackopt/fat-procedure state lambda-body match-result)
+  (if state
+      (internal-error "Model exists at non-continuation lambda!" state))
+  (let* ((frame  (cadr (assq stackopt/?frame-vector match-result)))
+	 (model  (stackopt/model/make #F frame #T))
+	 (form*  (stackopt/expr model lambda-body)))
+    (set-stackopt/model/form! model #F)
+    (stackopt/reorder! model)
+    form*))
+
+
 (define (stackopt/call/can-see-both-frames state handler match-result)
 
   (define (first-mismatch v1 v2)
-- 
2.25.1