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 1becebd77c1f9fbef06d0eb1f15e411ffacd57ed..3c67ba6103bb560b42212c0b3970b15a991c57c4 100644 (file)
--- 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 15e9dfc32188bcce392aaac7333937973f0c8c19..793b394d8458a1c49ef997c5d9afda2881cb2e54 100644 (file)
--- 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