From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 1 Jun 1987 16:04:25 +0000 (+0000)
Subject: Change interpreter-call:cache-assignment/reference/unassigned? to
X-Git-Tag: 20090517-FFI~13444
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e9528637dd81b04fb1784cb9c69ce1df1428bc80;p=mit-scheme.git

Change interpreter-call:cache-assignment/reference/unassigned? to
CSE their "name" argument.
---

diff --git a/v7/src/compiler/rtlopt/rcse1.scm b/v7/src/compiler/rtlopt/rcse1.scm
index c6cd3dffb..d09dd6385 100644
--- a/v7/src/compiler/rtlopt/rcse1.scm
+++ b/v7/src/compiler/rtlopt/rcse1.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcse1.scm,v 1.106 1987/05/31 22:56:55 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcse1.scm,v 1.107 1987/06/01 16:04:25 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -180,11 +180,8 @@ MIT in each case. |#
 (define-cse-method 'CONTINUATION-HEAP-CHECK method/noop)
 (define-cse-method 'INVOCATION:APPLY method/noop)
 (define-cse-method 'INVOCATION:JUMP method/noop)
-(define-cse-method 'INVOCATION:CACHE-REFERENCE method/noop)
 (define-cse-method 'INVOCATION:LEXPR method/noop)
 (define-cse-method 'INVOCATION:PRIMITIVE method/noop)
-(define-cse-method 'INTERPRETER-CALL:CACHE-REFERENCE method/noop)
-(define-cse-method 'INTERPRETER-CALL:CACHE-UNASSIGNED? method/noop)
 
 (define (method/invalidate-stack statement)
   (stack-pointer-invalidate!))
@@ -200,22 +197,19 @@ MIT in each case. |#
     (stack-pointer-invalidate!)
     (expression-invalidate! (interpreter-register:enclose))))
 
-(define-cse-method 'INVOCATION:LOOKUP
+(define-cse-method 'INVOCATION:CACHE-REFERENCE
   (lambda (statement)
-    (expression-replace! rtl:invocation:lookup-environment
-			 rtl:set-invocation:lookup-environment!
+    (expression-replace! rtl:invocation:cache-reference-name
+			 rtl:set-invocation:cache-reference-name!
 			 statement
 			 trivial-action)))
 
-(define-cse-method 'INTERPRETER-CALL:CACHE-ASSIGNMENT
+(define-cse-method 'INVOCATION:LOOKUP
   (lambda (statement)
-    (expression-replace! rtl:interpreter-call:cache-assignment-value
-			 rtl:set-interpreter-call:cache-assignment-value!
+    (expression-replace! rtl:invocation:lookup-environment
+			 rtl:set-invocation:lookup-environment!
 			 statement
-      (lambda (volatile? insert-source!)
-	(hash-table-delete-class! element-address-varies?)
-	(non-object-invalidate!)
-	(if (not volatile?) (insert-source!))))))
+			 trivial-action)))
 
 (define (define-lookup-method type get-environment set-environment! register)
   (define-cse-method type
@@ -231,6 +225,16 @@ MIT in each case. |#
   rtl:set-interpreter-call:access-environment!
   interpreter-register:access)
 
+(define-lookup-method 'INTERPRETER-CALL:CACHE-REFERENCE
+  rtl:interpreter-call:cache-reference-name
+  rtl:set-interpreter-call:cache-reference-name!
+  interpreter-register:cache-reference)
+
+(define-lookup-method 'INTERPRETER-CALL:CACHE-UNASSIGNED?
+  rtl:interpreter-call:cache-unassigned?-name
+  rtl:set-interpreter-call:cache-unassigned?-name!
+  interpreter-register:cache-unassigned?)
+
 (define-lookup-method 'INTERPRETER-CALL:LOOKUP
   rtl:interpreter-call:lookup-environment
   rtl:set-interpreter-call:lookup-environment!
@@ -245,7 +249,7 @@ MIT in each case. |#
   rtl:interpreter-call:unbound?-environment
   rtl:set-interpreter-call:unbound?-environment!
   interpreter-register:unbound?)
-
+
 (define (define-assignment-method type
 	  get-environment set-environment!
 	  get-value set-value!)
@@ -258,6 +262,12 @@ MIT in each case. |#
 	  (non-object-invalidate!)
 	  (if (not volatile?) (insert-source!)))))))
 
+(define-assignment-method 'INTERPRETER-CALL:CACHE-ASSIGNMENT
+  rtl:interpreter-call:cache-assignment-name
+  rtl:set-interpreter-call:cache-assignment-name!
+  rtl:interpreter-call:cache-assignment-value
+  rtl:set-interpreter-call:cache-assignment-value!)
+
 (define-assignment-method 'INTERPRETER-CALL:DEFINE
   rtl:interpreter-call:define-environment
   rtl:set-interpreter-call:define-environment!