fix bug in rewriting #add -- wasn't checking small-enough?, and change negative adds to subtractions/negative subtractions to adds

db4
Doug Coleman 2009-07-02 17:55:35 -05:00
parent 2cb94598b3
commit 80eb5068e2
1 changed files with 38 additions and 25 deletions

View File

@ -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. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators combinators.short-circuit 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.expressions
compiler.cfg.value-numbering.graph compiler.cfg.value-numbering.graph
compiler.cfg.value-numbering.simplify fry kernel layouts math 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 IN: compiler.cfg.value-numbering.rewrite
GENERIC: rewrite ( insn -- insn' ) GENERIC: rewrite ( insn -- insn' )
@ -113,38 +113,45 @@ M: ##compare-imm rewrite
] when ] when
] 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 -- ? ) : combine-imm? ( insn op -- ? )
[ src1>> vreg>expr op>> ] dip = ; [ src1>> vreg>expr op>> ] dip = ;
:: combine-imm ( insn quot op -- insn ) : combine-imm ( insn quot op -- insn )
insn [
[ dst>> ] {
[ src1>> vreg>expr [ in1>> vn>vreg ] [ in2>> vn>constant ] bi ] [ ]
[ src2>> ] tri [ dst>> ]
[ src1>> vreg>expr [ in1>> vn>vreg ] [ in2>> vn>constant ] bi ]
quot call cell-bits bits [ src2>> ]
} cleave
dup small-enough? [ ] [ call ] [ ] tri* new-imm-insn ; inline
op new-insn dup number-values
] [
3drop insn
] if ; inline
M: ##add-imm rewrite M: ##add-imm rewrite
{ {
{ [ dup \ ##add-imm combine-imm? ] { [ dup \ ##add-imm combine-imm? ] [ [ + ] \ ##add-imm combine-imm ] }
[ [ + ] \ ##add-imm combine-imm ] } { [ dup \ ##sub-imm combine-imm? ] [ [ - ] \ ##sub-imm combine-imm ] }
{ [ dup \ ##sub-imm combine-imm? ]
[ [ - ] \ ##sub-imm combine-imm ] }
[ ] [ ]
} cond ; } cond ;
M: ##sub-imm rewrite M: ##sub-imm rewrite
{ {
{ [ dup \ ##add-imm combine-imm? ] { [ dup \ ##add-imm combine-imm? ] [ [ - ] \ ##add-imm combine-imm ] }
[ [ - ] \ ##add-imm combine-imm ] } { [ dup \ ##sub-imm combine-imm? ] [ [ + ] \ ##sub-imm combine-imm ] }
{ [ dup \ ##sub-imm combine-imm? ]
[ [ + ] \ ##sub-imm combine-imm ] }
[ ] [ ]
} cond ; } cond ;
@ -169,8 +176,14 @@ M: ##xor-imm rewrite
dup \ ##xor-imm combine-imm? dup \ ##xor-imm combine-imm?
[ [ bitxor ] \ ##xor-imm combine-imm ] when ; [ [ bitxor ] \ ##xor-imm combine-imm ] when ;
: rewrite-add>add-imm? ( insn -- ? )
src2>> {
[ vreg>expr constant-expr? ]
[ vreg>constant small-enough? ]
} 1&& ;
M: ##add rewrite M: ##add rewrite
dup src2>> vreg>expr constant-expr? [ dup rewrite-add>add-imm? [
[ dst>> ] [ dst>> ]
[ src1>> ] [ src1>> ]
[ src2>> vreg>constant ] tri \ ##add-imm new-insn [ src2>> vreg>constant ] tri \ ##add-imm new-insn