From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 18 May 1987 23:24:33 +0000 (+0000)
Subject: Fix the memory-invalidation code for assignments to memory.
X-Git-Tag: 20090517-FFI~13504
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a70b1db7bf5da5675e596d97bea9cfd42be96235;p=mit-scheme.git

Fix the memory-invalidation code for assignments to memory.
Assignments to non-varying addresses were not invalidating the
destination of the assignment!  This was just screwed up.
---

diff --git a/v7/src/compiler/rtlopt/rcse1.scm b/v7/src/compiler/rtlopt/rcse1.scm
index a99a05f8a..d9c73be0a 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.103 1987/05/07 00:14:18 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcse1.scm,v 1.104 1987/05/18 23:24:33 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -107,22 +107,29 @@ MIT in each case. |#
 			(not (interpreter-frame-pointer? address)))
 		   (insert-register-destination! address (insert-source!))))
 	      (else
-	       (let ((memory-invalidate!
-		      (cond ((stack-push/pop? address)
-			     (lambda () 'DONE))
-			    ((heap-allocate? address)
-			     (lambda ()
-			       (register-expression-invalidate!
-				(rtl:address-register address))))
-			    (else
-			     (let ((predicate
-				    (if (expression-varies? address)
-					element-address-varies?
-					element-in-memory?)))
-			       (lambda ()
-				 (hash-table-delete-class! predicate)))))))
-		 (full-expression-hash address
-		   (lambda (hash volatile?* in-memory?*)
+	       (full-expression-hash address
+		 (lambda (hash volatile?* in-memory?*)
+		   (let ((memory-invalidate!
+			  (cond ((and (memq (rtl:expression-type address)
+					    '(PRE-INCREMENT POST-INCREMENT))
+				      (or (interpreter-stack-pointer?
+					   (rtl:address-register address))
+					  (interpreter-free-pointer?
+					   (rtl:address-register address))))
+				 (lambda ()
+				   (register-expression-invalidate!
+				    (rtl:address-register address))))
+				((expression-address-varies? address)
+				 (lambda ()
+				   (hash-table-delete-class!
+				    element-in-memory?)))
+				(else
+				 (lambda ()
+				   (hash-table-delete!
+				    hash
+				    (hash-table-lookup hash address))
+				   (hash-table-delete-class!
+				    element-address-varies?))))))
 		     (cond (volatile?* (memory-invalidate!))
 			   ((not volatile?)
 			    (let ((address
@@ -134,11 +141,7 @@ MIT in each case. |#
 				 address
 				 element
 				 (modulo (+ (symbol-hash 'ASSIGN) hash)
-					 n-buckets)))))))))
-	       ;; **** Kludge.  Works only because stack-pointer
-	       ;; gets used in very fixed way by code generator.
-	       (if (stack-push/pop? address)
-		   (stack-pointer-invalidate!))))))))
+					 n-buckets)))))))))))))))
 
 (define (trivial-action volatile? insert-source!)
   (if (not volatile?)
@@ -303,10 +306,20 @@ MIT in each case. |#
 (define (non-object-invalidate!)
   (hash-table-delete-class!
    (lambda (element)
-     (expression-not-object? (element-expression element)))))
+     (memq (rtl:expression-type (element-expression element))
+	   '(OBJECT->ADDRESS OBJECT->DATUM OBJECT->TYPE)))))
 
 (define (element-address-varies? element)
-  (expression-address-varies? (element-expression element)))
+  (and (element-in-memory? element)
+       (expression-address-varies? (element-expression element))))
+
+(define (expression-address-varies? expression)
+  (if (memq (rtl:expression-type expression)
+	    '(OFFSET PRE-INCREMENT POST-INCREMENT))
+      (let ((expression (rtl:address-register expression)))
+	(not (or (= regnum:regs-pointer (rtl:register-number expression))
+		 (= regnum:frame-pointer (rtl:register-number expression)))))
+      (rtl:any-subexpression? expression expression-address-varies?)))
 
 (define (expression-invalidate! expression)
   ;; Delete any expression which refers to this expression from the