steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add more algebraic simplifications: comparison of a comparison, comparison where first is immediate

db4
Slava Pestov 2008-11-06 09:27:52 -06:00
parent 1c1333fbe9
commit 64cbf619a9
2 changed files with 135 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
View File

@ -42,25 +42,75 @@ M: ##mul-imm rewrite
: tag-fixnum-expr? ( expr -- ? )
dup op>> \ ##shl-imm eq?
[ in2>> vn>expr value>> tag-bits get = ] [ drop f ] if ;
[ in2>> vn>constant tag-bits get = ] [ drop f ] if ;
: rewrite-tagged-comparison? ( insn -- ? )
#! Are we comparing two tagged fixnums? Then untag them.
dup ##compare-imm-branch? [
[ src1>> vreg>expr tag-fixnum-expr? ]
[ src2>> tag-mask get bitand 0 = ]
bi and
] [ drop f ] if ; inline
[ src1>> vreg>expr tag-fixnum-expr? ]
[ src2>> tag-mask get bitand 0 = ]
bi and ; inline
: rewrite-tagged-comparison ( insn -- insn' )
: (rewrite-tagged-comparison) ( insn -- src1 src2 cc )
[ src1>> vreg>expr in1>> vn>vreg ]
[ src2>> tag-bits get neg shift ]
[ cc>> ]
tri
f \ ##compare-imm-branch boa ;
tri ; inline
GENERIC: rewrite-tagged-comparison ( insn -- insn' )
M: ##compare-imm-branch rewrite-tagged-comparison
(rewrite-tagged-comparison) f \ ##compare-imm-branch boa ;
M: ##compare-imm rewrite-tagged-comparison
[ dst>> ] [ (rewrite-tagged-comparison) ] bi
f \ ##compare-imm boa ;
M: ##compare-imm-branch rewrite
dup rewrite-boolean-comparison? [ rewrite-boolean-comparison ] when
dup rewrite-tagged-comparison? [ rewrite-tagged-comparison ] when ;
dup ##compare-imm-branch? [
dup rewrite-tagged-comparison? [ rewrite-tagged-comparison ] when
] when ;
: flip-comparison? ( insn -- ? )
dup cc>> cc= eq? [ src1>> vreg>expr constant-expr? ] [ drop f ] if ;
: flip-comparison ( insn -- insn' )
[ dst>> ]
[ src2>> ]
[ src1>> vreg>vn vn>constant ] tri
cc= f \ ##compare-imm boa ;
M: ##compare rewrite
dup flip-comparison? [
flip-comparison
dup number-values
rewrite
] when ;
: rewrite-redundant-comparison? ( insn -- ? )
[ src1>> vreg>expr compare-expr? ]
[ src2>> \ f tag-number = ]
[ cc>> { cc= cc/= } memq? ]
tri and and ; inline
: rewrite-redundant-comparison ( insn -- insn' )
[ cc>> ] [ dst>> ] [ src1>> vreg>expr dup op>> ] tri {
{ \ ##compare [ >compare-expr< f \ ##compare boa ] }
{ \ ##compare-imm [ >compare-imm-expr< f \ ##compare-imm boa ] }
{ \ ##compare-float [ >compare-expr< f \ ##compare-float boa ] }
} case
swap cc= eq? [ [ negate-cc ] change-cc ] when ;
M: ##compare-imm rewrite
dup rewrite-redundant-comparison? [
rewrite-redundant-comparison
dup number-values rewrite
] when
dup ##compare-imm? [
dup rewrite-tagged-comparison? [
rewrite-tagged-comparison
dup number-values rewrite
] when
] when ;
M: insn rewrite ;

76
basis/compiler/cfg/value-numbering/value-numbering-tests.factor
View File

@ -1,6 +1,6 @@
IN: compiler.cfg.value-numbering.tests
USING: compiler.cfg.value-numbering compiler.cfg.instructions
compiler.cfg.registers cpu.architecture tools.test kernel ;
compiler.cfg.registers cpu.architecture tools.test kernel math ;
[
{
T{ ##peek f V int-regs 45 D 1 }
@ -66,3 +66,77 @@ compiler.cfg.registers cpu.architecture tools.test kernel ;
T{ ##replace f V int-regs 3 D 0 }
} value-numbering
] unit-test
[
{
T{ ##load-indirect f V int-regs 1 + }
T{ ##peek f V int-regs 2 D 0 }
T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc> }
T{ ##compare f V int-regs 6 V int-regs 2 V int-regs 1 cc> }
T{ ##replace f V int-regs 4 D 0 }
}
] [
{
T{ ##load-indirect f V int-regs 1 + }
T{ ##peek f V int-regs 2 D 0 }
T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc> }
T{ ##compare-imm f V int-regs 6 V int-regs 4 7 cc/= }
T{ ##replace f V int-regs 6 D 0 }
} value-numbering
] unit-test
[
{
T{ ##load-indirect f V int-regs 1 + }
T{ ##peek f V int-regs 2 D 0 }
T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc<= }
T{ ##compare f V int-regs 6 V int-regs 2 V int-regs 1 cc> }
T{ ##replace f V int-regs 6 D 0 }
}
] [
{
T{ ##load-indirect f V int-regs 1 + }
T{ ##peek f V int-regs 2 D 0 }
T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc<= }
T{ ##compare-imm f V int-regs 6 V int-regs 4 7 cc= }
T{ ##replace f V int-regs 6 D 0 }
} value-numbering
] unit-test
[
{
T{ ##peek f V int-regs 8 D 0 }
T{ ##peek f V int-regs 9 D -1 }
T{ ##unbox-float f V double-float-regs 10 V int-regs 8 }
T{ ##unbox-float f V double-float-regs 11 V int-regs 9 }
T{ ##compare-float f V int-regs 12 V double-float-regs 10 V double-float-regs 11 cc< }
T{ ##compare-float f V int-regs 14 V double-float-regs 10 V double-float-regs 11 cc>= }
T{ ##replace f V int-regs 14 D 0 }
}
] [
{
T{ ##peek f V int-regs 8 D 0 }
T{ ##peek f V int-regs 9 D -1 }
T{ ##unbox-float f V double-float-regs 10 V int-regs 8 }
T{ ##unbox-float f V double-float-regs 11 V int-regs 9 }
T{ ##compare-float f V int-regs 12 V double-float-regs 10 V double-float-regs 11 cc< }
T{ ##compare-imm f V int-regs 14 V int-regs 12 7 cc= }
T{ ##replace f V int-regs 14 D 0 }
} value-numbering
] unit-test
[
{
T{ ##peek f V int-regs 29 D -1 }
T{ ##peek f V int-regs 30 D -2 }
T{ ##compare f V int-regs 33 V int-regs 29 V int-regs 30 cc<= }
T{ ##compare-branch f V int-regs 29 V int-regs 30 cc<= }
}
] [
{
T{ ##peek f V int-regs 29 D -1 }
T{ ##peek f V int-regs 30 D -2 }
T{ ##compare f V int-regs 33 V int-regs 29 V int-regs 30 cc<= }
T{ ##compare-imm-branch f V int-regs 33 7 cc/= }
} value-numbering
] unit-test