From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 30 Sep 1992 21:02:39 +0000 (+0000)
Subject: Tweak definition of RTL-PROCEDURE/STACK-LEAF? to be true only when the
X-Git-Tag: 20090517-FFI~8870
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3f5b474d1f1114d0bcc53273c6bc7b69f0e76ab2;p=mit-scheme.git

Tweak definition of RTL-PROCEDURE/STACK-LEAF? to be true only when the
procedure pushes a continuation, and to consider inline-coded descendant
procedures as part of the ancestor.
---

diff --git a/v7/src/compiler/base/make.scm b/v7/src/compiler/base/make.scm
index 1becebd77..3c67ba610 100644
--- a/v7/src/compiler/base/make.scm
+++ b/v7/src/compiler/base/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/make.scm,v 4.92 1992/07/29 19:56:21 cph Exp $
+$Id: make.scm,v 4.93 1992/09/30 21:02:39 cph Exp $
 
 Copyright (c) 1988-92 Massachusetts Institute of Technology
 
@@ -46,5 +46,5 @@ MIT in each case. |#
     (initialize-package! '(COMPILER DECLARATIONS)))
   (add-system!
    (make-system (string-append "Liar (" architecture-name ")")
-		4 92
+		4 93
 		'())))
\ No newline at end of file
diff --git a/v7/src/compiler/rtlgen/rtlgen.scm b/v7/src/compiler/rtlgen/rtlgen.scm
index 15e9dfc32..793b394d8 100644
--- a/v7/src/compiler/rtlgen/rtlgen.scm
+++ b/v7/src/compiler/rtlgen/rtlgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rtlgen.scm,v 4.27 1992/09/30 19:23:21 cph Exp $
+$Id: rtlgen.scm,v 4.28 1992/09/30 21:02:16 cph Exp $
 
 Copyright (c) 1988-92 Massachusetts Institute of Technology
 
@@ -126,13 +126,25 @@ MIT in each case. |#
        (procedure/type procedure)
        (procedure-debugging-info procedure)
        (block/next-continuation-offset (procedure-block procedure) 0)
-       (let ((block (procedure-block procedure)))
-	 (and (stack-block? block)
-	      (for-all? (block-children block)
-		(lambda (block)
-		  (and (continuation-block? block)
-		       (continuation/always-known-operator?
-			(block-procedure block)))))))))))
+       ;; This expression computes the value of STACK-LEAF? for
+       ;; PROCEDURE.  This is defined to mean that the procedure
+       ;; doesn't push anything, but it's not what this expression
+       ;; computes.  Instead, it is true if the procedure doesn't push
+       ;; any continuations on the stack.  Thus it is true of
+       ;; procedures that push environment bindings on the stack,
+       ;; provided that all of the procedure calls made by them are
+       ;; reductions.
+       (let loop ((block (procedure-block procedure)))
+	 (for-all? (block-children block)
+	   (lambda (block)
+	     (let ((procedure (block-procedure block)))
+	       (and (procedure? procedure)
+		    (if (procedure-continuation? procedure)
+			(continuation/always-known-operator? procedure)
+			;; Inline-coded child procedures are treated
+			;; as an extension of this procedure.
+			(or (not (procedure-inline-code? procedure))
+			    (loop block))))))))))))
 
 (define (generate/procedure-entry/inline procedure)
   (generate/procedure-header procedure