Decisions to use variable cache mechanism are raised to a higher level

to allow special handling of IC procedure references.

diff --git a/v7/src/compiler/rtlgen/rgcomb.scm b/v7/src/compiler/rtlgen/rgcomb.scm
index 770e1d7fcc4f914ac6e6e2c5ae5097758acc75b6..26095a2b8105bab01293906b711aedaa861f53f6 100644 (file)
--- 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.25 1987/06/13 00:14:10 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgcomb.scm,v 1.26 1987/06/13 03:00:39 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -287,7 +287,9 @@ MIT in each case. |#
       (let ((operator (subproblem-value (combination-operator combination)))
            (frame-size* (1+ frame-size)))
        (let ((name (variable-name (reference-variable operator))))
-         (if compiler:cache-free-variables?
+         ;; This predicate assumes that (reference-block operator)
+         ;; returns an IC block.
+         (if (ic-block/use-lookup? (reference-block operator))
              (let* ((temp (make-temporary))
                     (cell (rtl:make-fetch temp))
                     (contents (rtl:make-fetch cell)))

diff --git a/v7/src/compiler/rtlgen/rgproc.scm b/v7/src/compiler/rtlgen/rgproc.scm
index 72cb46e7028f539c3814a15b85caa26ab9de68e0..ea2c76b6f44d7961f3b3885d449642e1b35d9419 100644 (file)
--- a/v7/src/compiler/rtlgen/rgproc.scm
+++ b/v7/src/compiler/rtlgen/rgproc.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgproc.scm,v 1.1 1987/05/07 00:22:51 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgproc.scm,v 1.2 1987/06/13 03:01:28 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -40,7 +40,9 @@ MIT in each case. |#
 
 (define-export (generate/procedure-header procedure body)
   (if (procedure/ic? procedure)
-      body
+      (scfg*scfg->scfg!
+       (rtl:make-procedure-heap-check procedure)
+       body)
       (scfg-append!
        ((if (or (procedure-rest procedure)
                (and (procedure/closure? procedure)
@@ -121,6 +123,8 @@ MIT in each case. |#
                          (find-variable block variable
                            (lambda (locative) locative)
                            (lambda (nearest-ic-locative name)
+                             (error "Missing closure variable" variable))
+                           (lambda (name)
                              (error "Missing closure variable" variable))))
                         environment)))))
 

diff --git a/v7/src/compiler/rtlgen/rgrval.scm b/v7/src/compiler/rtlgen/rgrval.scm
index 3ee64dc6dd094aa105583f8dfc2d78a78aaed669..2273d60f8412735e238f436fe26aad55cfc0d6e2 100644 (file)
--- a/v7/src/compiler/rtlgen/rgrval.scm
+++ b/v7/src/compiler/rtlgen/rgrval.scm
@@ -1,9 +1,9 @@
 d3 1
 a4 1
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgrval.scm,v 1.9 1987/06/01 20:29:50 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgrval.scm,v 1.10 1987/06/13 02:55:54 cph Exp $
 #| -*-Scheme-*-
 Copyright (c) 1987 Massachusetts Institute of Technology
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgrval.scm,v 1.9 1987/06/01 20:29:50 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgrval.scm,v 1.10 1987/06/13 02:55:54 cph Exp $
 
 Copyright (c) 1988, 1990 Massachusetts Institute of Technology
 
@@ -74,14 +74,14 @@ promotional, or sales literature without prior written consent from
          (lambda (locative)
            (expression-value/simple (rtl:make-fetch locative)))
          (lambda (environment name)
-           (if compiler:cache-free-variables?
-               (generate/cached-reference name (reference-safe? reference))
-               (expression-value/temporary
-                (rtl:make-interpreter-call:lookup
-                 environment
-                 (intern-scode-variable! (reference-block reference) name)
-                 (reference-safe? reference))
-                (rtl:interpreter-call-result:lookup))))))))
+           (expression-value/temporary
+            (rtl:make-interpreter-call:lookup
+             environment
+             (intern-scode-variable! (reference-block reference) name)
+             (reference-safe? reference))
+            (rtl:interpreter-call-result:lookup)))
+         (lambda (name)
+           (generate/cached-reference name (reference-safe? reference)))))))
 
 (define (generate/cached-reference name safe?)
   (let ((temp (make-temporary))
@@ -180,12 +180,12 @@ promotional, or sales literature without prior written consent from
           (expression-value/simple (rtl:make-constant false)))
          ((ic-block? block)
           (expression-value/simple
-           (if compiler:cache-free-variables?
-               (rtl:make-constant false)
+           (if (ic-block/use-lookup? block)
                (let ((closure-block (procedure-closure-block procedure)))
                  (if (ic-block? closure-block)
                      (rtl:make-fetch register:environment)
-                     (closure-ic-locative closure-block block))))))
+                     (closure-ic-locative closure-block block)))
+               (rtl:make-constant false))))
          ((closure-block? block)
           (let ((closure-block (procedure-closure-block procedure)))
             (define (loop variables)
@@ -202,7 +202,7 @@ promotional, or sales literature without prior written consent from
             (let ((pushes
                    (let ((parent (block-parent block))
                          (pushes (loop (block-bound-variables block))))
-                     (if (and parent (not compiler:cache-free-variables?))
+                     (if (and parent (ic-block/use-lookup? parent))
                          (cons (rtl:make-push
                                 (closure-ic-locative closure-block
                                                      parent))

diff --git a/v7/src/compiler/rtlgen/rgstmt.scm b/v7/src/compiler/rtlgen/rgstmt.scm
index 9d66295c87c16a3c7232bc374916643b61035a5f..7622982ca09d226498246372e807fb7f12da59ed 100644 (file)
--- a/v7/src/compiler/rtlgen/rgstmt.scm
+++ b/v7/src/compiler/rtlgen/rgstmt.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgstmt.scm,v 1.6 1987/06/01 20:30:23 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgstmt.scm,v 1.7 1987/06/13 02:57:08 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -44,9 +44,7 @@ MIT in each case. |#
       (lambda (prefix expression)
        (scfg*scfg->scfg!
         prefix
-        (find-variable (definition-block node) (definition-lvalue node)
-          (lambda (locative)
-            (error "Definition of compiled variable"))
+        (transmit-values (find-definition-variable node)
           (lambda (environment name)
             (rtl:make-interpreter-call:define environment name
                                               expression))))))))
@@ -101,11 +99,11 @@ MIT in each case. |#
       (lambda (locative)
        (rtl:make-assignment locative expression))
       (lambda (environment name)
-       (if compiler:cache-free-variables?
-           (generate/cached-assignment name expression)
-           (rtl:make-interpreter-call:set! environment
-                                           (intern-scode-variable! block name)
-                                           expression))))))
+       (rtl:make-interpreter-call:set! environment
+                                       (intern-scode-variable! block name)
+                                       expression))
+      (lambda (name)
+       (generate/cached-assignment name expression)))))
 
 (define (generate/cached-assignment name value)
   (let ((temp (make-temporary)))