From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 31 Dec 1987 07:01:21 +0000 (+0000)
Subject: Change treatment of interpreter memory registers so that they do not
X-Git-Tag: 20090517-FFI~12963
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=22dec91f017445db9503b1940b9448fe5d604731;p=mit-scheme.git

Change treatment of interpreter memory registers so that they do not
cause invalidation of random memory addresses.  No other pointers will
ever point into that address block.
---

diff --git a/v7/src/compiler/rtlopt/rcse1.scm b/v7/src/compiler/rtlopt/rcse1.scm
index 3190a773f..8cf9020b0 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 4.3 1987/12/31 05:49:33 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcse1.scm,v 4.4 1987/12/31 07:01:21 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -166,8 +166,21 @@ MIT in each case. |#
 	       (stack-reference-invalidate! address)
 	       (if (not volatile?)
 		   (insert-stack-destination! address (insert-source!))))
-	      (else
+	      ((interpreter-register-reference? address)
+	       (let ((hash (expression-hash address)))
+		 (let ((memory-invalidate!
+			(lambda ()
+			  (hash-table-delete! hash
+					      (hash-table-lookup hash
+								 address)))))
+		   (if volatile?
+		       (memory-invalidate!)
+		       (assignment-memory-insertion address
+						    hash
+						    insert-source!
+						    memory-invalidate!)))))
 
+	      (else
 	       (let ((address (expression-canonicalize address)))
 		 (rtl:set-assign-address! statement address)
 		 (full-expression-hash address
@@ -195,21 +208,25 @@ MIT in each case. |#
 				      element-address-varies?))))))
 		       (if (or volatile? volatile?*)
 			   (memory-invalidate!)
-			   (let ((address
-				  (find-cheapest-expression address hash
-							    false)))
-			     (let ((element (insert-source!)))
-			       (memory-invalidate!)
-			       (insert-memory-destination!
-				address
-				element
-				(modulo (+ (symbol-hash 'ASSIGN) hash)
-					(hash-table-size)))))))))
+			   (assignment-memory-insertion address
+							hash
+							insert-source!
+							memory-invalidate!)))))
 		 ;; **** Kludge.  Works only because stack-pointer
 		 ;; gets used in very fixed way by code generator.
 		 (if (stack-push/pop? address)
 		     (stack-pointer-adjust!
 		      (rtl:address-number address))))))))))
+
+(define (assignment-memory-insertion address hash insert-source!
+				     memory-invalidate!)
+  (let ((address (find-cheapest-expression address hash false)))
+    (let ((element (insert-source!)))
+      (memory-invalidate!)
+      (insert-memory-destination!
+       address
+       element
+       (modulo (+ (symbol-hash 'ASSIGN) hash) (hash-table-size))))))
 
 (define (trivial-action volatile? insert-source!)
   (if (not volatile?)
diff --git a/v7/src/compiler/rtlopt/rcse2.scm b/v7/src/compiler/rtlopt/rcse2.scm
index 590d070b4..7f87df56a 100644
--- a/v7/src/compiler/rtlopt/rcse2.scm
+++ b/v7/src/compiler/rtlopt/rcse2.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcse2.scm,v 4.2 1987/12/30 07:13:20 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcse2.scm,v 4.3 1987/12/31 07:01:04 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -107,11 +107,10 @@ MIT in each case. |#
        (expression-address-varies? (element-expression element))))
 
 (define (expression-address-varies? expression)
-  (if (memq (rtl:expression-type expression)
-	    '(OFFSET PRE-INCREMENT POST-INCREMENT))
-      (not (= regnum:regs-pointer
-	      (rtl:register-number (rtl:address-register expression))))
-      (rtl:any-subexpression? expression expression-address-varies?)))
+  (and (not (interpreter-register-reference? expression))
+       (or (memq (rtl:expression-type expression)
+		 '(OFFSET PRE-INCREMENT POST-INCREMENT)))
+       (rtl:any-subexpression? expression expression-address-varies?)))
 
 (define (expression-invalidate! expression)
   ;; Delete any expression which refers to this expression from the
diff --git a/v7/src/compiler/rtlopt/rcseep.scm b/v7/src/compiler/rtlopt/rcseep.scm
index f4be81545..07998d9ec 100644
--- a/v7/src/compiler/rtlopt/rcseep.scm
+++ b/v7/src/compiler/rtlopt/rcseep.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcseep.scm,v 4.1 1987/12/08 13:56:02 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcseep.scm,v 4.2 1987/12/31 07:00:47 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -73,4 +73,8 @@ MIT in each case. |#
 	(if (eq? (rtl:expression-type x) (rtl:expression-type y))
 	    (expression-equivalent? x y false)
 	    (rtl:any-subexpression? x loop))))
-  (loop x))
\ No newline at end of file
+  (loop x))
+
+(define-integrable (interpreter-register-reference? expression)
+  (and (rtl:offset? expression)
+       (interpreter-regs-pointer? (rtl:offset-register expression))))
\ No newline at end of file