*** empty log message ***
authorChris Hanson <org/chris-hanson/cph>
Sun, 21 Dec 1986 23:44:21 +0000 (23:44 +0000)
committerChris Hanson <org/chris-hanson/cph>
Sun, 21 Dec 1986 23:44:21 +0000 (23:44 +0000)
v7/src/compiler/rtlopt/rcse1.scm

index 9500f71635865feb5c4f959a836dac46a7be4327..7f99cb979f3ed6fd9eda16625618c02d680cf619 100644 (file)
@@ -38,7 +38,7 @@
 ;;;; RTL Common Subexpression Elimination
 ;;;  Based on the GNU C Compiler
 
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcse1.scm,v 1.96 1986/12/20 22:52:56 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcse1.scm,v 1.97 1986/12/21 23:44:21 cph Exp $
 
 (declare (usual-integrations))
 (using-syntax (access compiler-syntax-table compiler-package)
              (else
               (lambda (volatile? insert-source!)
                 (let ((memory-invalidate!
-                       (if (destination-safe? address)
-                           (lambda () 'DONE)
-                           (memory-invalidator
-                            (expression-varies? address)))))
+                       (cond ((stack-push/pop? address)
+                              (lambda () 'DONE))
+                             ((heap-allocate? address)
+                              (lambda ()
+                                (register-expression-invalidate!
+                                 (rtl:address-register address))))
+                             (else
+                              (memory-invalidator
+                               (expression-varies? address))))))
                   (full-expression-hash address
                     (lambda (hash volatile?* in-memory?*)
                       (cond (volatile?* (memory-invalidate!))
 (define (register-expression-varies? expression)
   (not (= regnum:regs-pointer (rtl:register-number expression))))
 
-(define (destination-safe? expression)
-  ;; Pushing on the stack and consing can't invalidate anything.
-  (and (memq (rtl:expression-type expression) '(PRE-INCREMENT POST-INCREMENT))
-       (or (interpreter-stack-pointer? (rtl:address-register expression))
-          (interpreter-free-pointer? (rtl:address-register expression)))))
-
 (define (stack-push/pop? expression)
-  (and (memq (rtl:expression-type expression) '(PRE-INCREMENT POST-INCREMENT))
+  (and (pre/post-increment? expression)
        (interpreter-stack-pointer? (rtl:address-register expression))))
+
+(define (heap-allocate? expression)
+  (and (pre/post-increment? expression)
+       (interpreter-free-pointer? (rtl:address-register expression))))
+
+(define-integrable (pre/post-increment? expression)
+  (memq (rtl:expression-type expression) '(PRE-INCREMENT POST-INCREMENT)))
 \f
 ;;;; Stack References