From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Tue, 31 Mar 1992 19:50:01 +0000 (+0000)
Subject: Add FIXNUM-LSH rewrite rule so that shifts by constants will always be
X-Git-Tag: 20090517-FFI~9536
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=00b8534aa7fb490453e9da04acf608f73d5e6ced;p=mit-scheme.git

Add FIXNUM-LSH rewrite rule so that shifts by constants will always be
combined.
---

diff --git a/v7/src/compiler/machines/bobcat/rulrew.scm b/v7/src/compiler/machines/bobcat/rulrew.scm
index 2cfe82882..995917318 100644
--- a/v7/src/compiler/machines/bobcat/rulrew.scm
+++ b/v7/src/compiler/machines/bobcat/rulrew.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rulrew.scm,v 1.4 1991/10/25 06:50:06 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rulrew.scm,v 1.5 1992/03/31 19:50:01 jinx Exp $
 
 Copyright (c) 1990-91 Massachusetts Institute of Technology
 
@@ -148,6 +148,7 @@ MIT in each case. |#
    (rtl:constant-fixnum-test operand-1
      (lambda (n)
        (or (zero? n)
+	   (= -1 n)
 	   (integer-log-base-2? n)))))
   (rtl:make-fixnum-2-args 'MULTIPLY-FIXNUM operand-1 operand-2 overflow?))
 
@@ -187,6 +188,14 @@ MIT in each case. |#
 		(integer-log-base-2? n))))))
   (rtl:make-fixnum-2-args operator operand-1 operand-2 overflow?))
 
+(define-rule rewriting
+  (FIXNUM-2-ARGS FIXNUM-LSH
+		 (? operand-1)
+		 (REGISTER (? operand-2 register-known-value))
+		 (? overflow?))
+  (QUALIFIER (rtl:constant-fixnum-test operand-2 (lambda (n) true)))
+  (rtl:make-fixnum-2-args 'FIXNUM-LSH operand-1 operand-2 overflow?))
+
 (define (rtl:constant-fixnum? expression)
   (and (rtl:constant? expression)
        (fix:fixnum? (rtl:constant-value expression))))