Add special lookup for compiler to do side-effect for value.

diff --git a/v7/src/compiler/rtlbase/rtlcon.scm b/v7/src/compiler/rtlbase/rtlcon.scm
index 39fc64e2bb19db6397b1ae4d839741b60006cd3a..7b19aa71f9124dc774d4b048a808a358083e0904 100644 (file)
--- a/v7/src/compiler/rtlbase/rtlcon.scm
+++ b/v7/src/compiler/rtlbase/rtlcon.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlcon.scm,v 1.4 1987/05/16 18:24:34 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlcon.scm,v 1.5 1987/05/22 00:10:58 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -109,8 +109,10 @@ MIT in each case. |#
 (define rtl:make-interpreter-call:define
   (interpreter-assignment-maker %make-interpreter-call:define))
 
-(define rtl:make-interpreter-call:lookup
-  (interpreter-lookup-maker %make-interpreter-call:lookup))
+(define (rtl:make-interpreter-call:lookup environment name safe?)
+  (expression-simplify-for-statement environment
+    (lambda (environment)
+      (%make-interpreter-call:lookup environment name safe?))))
 
 (define rtl:make-interpreter-call:set!
   (interpreter-assignment-maker %make-interpreter-call:set!))

diff --git a/v7/src/compiler/rtlbase/rtlty1.scm b/v7/src/compiler/rtlbase/rtlty1.scm
index ac5af8f675180864bab72dff0a36aaea30c0311d..45643bc345ff7f20b398354b856a9e0e707a4490 100644 (file)
--- a/v7/src/compiler/rtlbase/rtlty1.scm
+++ b/v7/src/compiler/rtlbase/rtlty1.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlty1.scm,v 1.4 1987/05/15 19:50:24 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlty1.scm,v 1.5 1987/05/22 00:11:14 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -65,7 +65,7 @@ MIT in each case. |#
 (define-rtl-statement interpreter-call:access % environment name)
 (define-rtl-statement interpreter-call:define % environment name value)
 (define-rtl-statement interpreter-call:enclose rtl: size)
-(define-rtl-statement interpreter-call:lookup % environment name)
+(define-rtl-statement interpreter-call:lookup % environment name safe?)
 (define-rtl-statement interpreter-call:set! % environment name value)
 (define-rtl-statement interpreter-call:unassigned? % environment name)
 (define-rtl-statement interpreter-call:unbound? % environment name)

diff --git a/v7/src/compiler/rtlgen/rgrval.scm b/v7/src/compiler/rtlgen/rgrval.scm
index 57ae81273e7bae5a70af230b1d666a326e093591..0edd3f3bf17e8a1f9a544aeeece9a1d029b2f438 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.4 1987/05/21 14:59:26 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgrval.scm,v 1.5 1987/05/22 00:10:40 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.4 1987/05/21 14:59:26 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgrval.scm,v 1.5 1987/05/22 00:10:40 cph Exp $
 
 Copyright (c) 1988, 1990 Massachusetts Institute of Technology
 
@@ -62,21 +62,19 @@ promotional, or sales literature without prior written consent from
 
 (define-rvalue-generator reference-tag
   (lambda (reference)
-    (generate/variable (reference-block reference)
-                      (reference-variable reference))))
-
-(define (generate/variable block variable)
-  (if (vnode-known-constant? variable)
-      (generate/constant (vnode-known-value variable))
-      (find-variable block variable
-       (lambda (locative)
-         (expression-value/simple (rtl:make-fetch locative)))
-       (lambda (environment name)
-         (return-2
-          (rtl:make-interpreter-call:lookup environment
-                                            (intern-scode-variable! block
-                                                                    name))
-          (rtl:interpreter-call-result:lookup))))))
+    (if (vnode-known-constant? (reference-variable reference))
+       (generate/constant (vnode-known-value (reference-variable reference)))
+       (find-variable (reference-block reference)
+                      (reference-variable reference)
+         (lambda (locative)
+           (expression-value/simple (rtl:make-fetch locative)))
+         (lambda (environment name)
+           (return-2
+            (rtl:make-interpreter-call:lookup
+             environment
+             (intern-scode-variable! (reference-block reference) name)
+             (reference-safe? reference))
+            (rtl:interpreter-call-result:lookup)))))))
 
 (define-rvalue-generator temporary-tag
   (lambda (temporary)