From: Mark Friedman <edu/mit/csail/zurich/markf>
Date: Tue, 26 Apr 1988 18:56:24 +0000 (+0000)
Subject: Added a new test in optimize-rtl called rtl:optimizable?
X-Git-Tag: 20090517-FFI~12799
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=925a1f33ec36304614c54299ba7645e9635c9d90;p=mit-scheme.git

Added a new test in optimize-rtl called rtl:optimizable?
Currently it is only used to prevent the optimization of
OBJECT->FIXNUM. This is done to prevent an explosion in the
number of rules necessary in the back end. See the commant in
optimize-rtl for more info.
---

diff --git a/v7/src/compiler/rtlopt/rcompr.scm b/v7/src/compiler/rtlopt/rcompr.scm
index fcf956091..8da5e0f3e 100644
--- a/v7/src/compiler/rtlopt/rcompr.scm
+++ b/v7/src/compiler/rtlopt/rcompr.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcompr.scm,v 1.3 1987/08/07 17:07:52 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcompr.scm,v 1.4 1988/04/26 18:56:24 markf Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -66,38 +66,50 @@ MIT in each case. |#
 
 (define (optimize-rtl live rinst rtl)
   (if (rtl:assign? rtl)
-      (let ((address (rtl:assign-address rtl)))
-	(if (rtl:register? address)
-	    (let ((register (rtl:register-number address))
-		  (next (rinst-next rinst)))
-	      (if (and (pseudo-register? register)
-		       (= 2 (register-n-refs register))
-		       (rinst-dead-register? next register)
-		       (rtl:any-subexpression? (rinst-rtl next)
-			 (lambda (expression)
-			   (and (rtl:register? expression)
-				(= (rtl:register-number expression)
-				   register)))))
-		  (begin
-		    (let ((dead (rinst-dead-registers rinst)))
-		      (for-each increment-register-live-length! dead)
-		      (set-rinst-dead-registers!
-		       next
-		       (eqv-set-union dead
-				      (delv! register
-					     (rinst-dead-registers next)))))
-		    (for-each-regset-member live 
-		      decrement-register-live-length!)
-		    (rtl:modify-subexpressions (rinst-rtl next)
-		      (lambda (expression set-expression!)
-			(if (and (rtl:register? expression)
-				 (= (rtl:register-number expression)
-				    register))
-			    (set-expression! (rtl:assign-expression rtl)))))
-		    (set-rinst-rtl! rinst false)
-		    (reset-register-n-refs! register)
-		    (reset-register-n-deaths! register)
-		    (reset-register-live-length! register)
-		    (set-register-bblock! register false))))))))
+      ;;; In order to avoid a combinatorial explosion in the number of
+      ;;; rules required in the lapgen phase we create a class of
+      ;;; expression types which we don't want optimized. We will
+      ;;; explicitly assign these expression types to registers during
+      ;;; rtl generation and then we need only create rules for how to
+      ;;; generate assignments to registers. Some day we will have
+      ;;; some facility for subrule hierarchies which may avoid the
+      ;;; combinatorial explosion. When that happens the next test may
+      ;;; be removed.
+      (if (rtl:optimizable? (rtl:assign-expression rtl))
+	  (let ((address (rtl:assign-address rtl)))
+	    (if (rtl:register? address)
+		(let ((register (rtl:register-number address))
+		      (next (rinst-next rinst)))
+		  (if (and (pseudo-register? register)
+			   (= 2 (register-n-refs register))
+			   (rinst-dead-register? next register)
+			   (rtl:any-subexpression?
+			    (rinst-rtl next)
+			    (lambda (expression)
+			      (and (rtl:register? expression)
+				   (= (rtl:register-number expression)
+				      register)))))
+		      (begin
+			(let ((dead (rinst-dead-registers rinst)))
+			  (for-each increment-register-live-length! dead)
+			  (set-rinst-dead-registers!
+			   next
+			   (eqv-set-union dead
+					  (delv! register
+						 (rinst-dead-registers next)))))
+			(for-each-regset-member live 
+						decrement-register-live-length!)
+			(rtl:modify-subexpressions
+			 (rinst-rtl next)
+			 (lambda (expression set-expression!)
+			   (if (and (rtl:register? expression)
+				    (= (rtl:register-number expression)
+				       register))
+			       (set-expression! (rtl:assign-expression rtl)))))
+			(set-rinst-rtl! rinst false)
+			(reset-register-n-refs! register)
+			(reset-register-n-deaths! register)
+			(reset-register-live-length! register)
+			(set-register-bblock! register false)))))))))
 
 )
\ No newline at end of file