From 00b8534aa7fb490453e9da04acf608f73d5e6ced Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Tue, 31 Mar 1992 19:50:01 +0000 Subject: [PATCH] Add FIXNUM-LSH rewrite rule so that shifts by constants will always be combined. --- v7/src/compiler/machines/bobcat/rulrew.scm | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) 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)))) -- 2.25.1