From 80eb5068e2184ddd225b70f4be8d1084f4b49c73 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 2 Jul 2009 17:55:35 -0500
Subject: [PATCH] fix bug in rewriting #add -- wasn't checking small-enough?,
and change negative adds to subtractions/negative subtractions to adds
---
.../value-numbering/rewrite/rewrite.factor | 63 +++++++++++--------
1 file changed, 38 insertions(+), 25 deletions(-)
mode change 100644 => 100755 basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
diff --git a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
old mode 100644
new mode 100755
index bdb906da79..418543603a
--- a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
+++ b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
@@ -1,11 +1,11 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators combinators.short-circuit
-compiler.cfg.hats compiler.cfg.instructions
+arrays compiler.cfg.hats compiler.cfg.instructions
compiler.cfg.value-numbering.expressions
compiler.cfg.value-numbering.graph
compiler.cfg.value-numbering.simplify fry kernel layouts math
-namespaces sequences cpu.architecture math.bitwise locals ;
+namespaces sequences cpu.architecture math.bitwise ;
IN: compiler.cfg.value-numbering.rewrite
GENERIC: rewrite ( insn -- insn' )
@@ -113,38 +113,45 @@ M: ##compare-imm rewrite
] when
] when ;
+: (new-imm-insn) ( insn dst src1 n op -- new-insn/insn )
+ [ cell-bits bits ] dip over small-enough? [
+ new-insn dup number-values nip
+ ] [
+ 2drop 2drop
+ ] if ; inline
+
+: new-imm-insn ( insn dst src n op -- n' op' )
+ 2dup [ sgn ] dip 2array
+ {
+ { { -1 ##add-imm } [ drop neg \ ##sub-imm (new-imm-insn) ] }
+ { { -1 ##sub-imm } [ drop neg \ ##add-imm (new-imm-insn) ] }
+ [ drop (new-imm-insn) ]
+ } case ; inline
+
: combine-imm? ( insn op -- ? )
[ src1>> vreg>expr op>> ] dip = ;
-:: combine-imm ( insn quot op -- insn )
- insn
- [ dst>> ]
- [ src1>> vreg>expr [ in1>> vn>vreg ] [ in2>> vn>constant ] bi ]
- [ src2>> ] tri
-
- quot call cell-bits bits
-
- dup small-enough? [
- op new-insn dup number-values
- ] [
- 3drop insn
- ] if ; inline
+: combine-imm ( insn quot op -- insn )
+ [
+ {
+ [ ]
+ [ dst>> ]
+ [ src1>> vreg>expr [ in1>> vn>vreg ] [ in2>> vn>constant ] bi ]
+ [ src2>> ]
+ } cleave
+ ] [ call ] [ ] tri* new-imm-insn ; inline
M: ##add-imm rewrite
{
- { [ dup \ ##add-imm combine-imm? ]
- [ [ + ] \ ##add-imm combine-imm ] }
- { [ dup \ ##sub-imm combine-imm? ]
- [ [ - ] \ ##sub-imm combine-imm ] }
+ { [ dup \ ##add-imm combine-imm? ] [ [ + ] \ ##add-imm combine-imm ] }
+ { [ dup \ ##sub-imm combine-imm? ] [ [ - ] \ ##sub-imm combine-imm ] }
[ ]
} cond ;
M: ##sub-imm rewrite
{
- { [ dup \ ##add-imm combine-imm? ]
- [ [ - ] \ ##add-imm combine-imm ] }
- { [ dup \ ##sub-imm combine-imm? ]
- [ [ + ] \ ##sub-imm combine-imm ] }
+ { [ dup \ ##add-imm combine-imm? ] [ [ - ] \ ##add-imm combine-imm ] }
+ { [ dup \ ##sub-imm combine-imm? ] [ [ + ] \ ##sub-imm combine-imm ] }
[ ]
} cond ;
@@ -169,8 +176,14 @@ M: ##xor-imm rewrite
dup \ ##xor-imm combine-imm?
[ [ bitxor ] \ ##xor-imm combine-imm ] when ;
+: rewrite-add>add-imm? ( insn -- ? )
+ src2>> {
+ [ vreg>expr constant-expr? ]
+ [ vreg>constant small-enough? ]
+ } 1&& ;
+
M: ##add rewrite
- dup src2>> vreg>expr constant-expr? [
+ dup rewrite-add>add-imm? [
[ dst>> ]
[ src1>> ]
[ src2>> vreg>constant ] tri \ ##add-imm new-insn