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

add constant folding for integer ops, refactor some rewrites

db4
Doug Coleman 2009-07-02 19:03:21 -05:00
parent f11ba00667
commit e7a227ad40
1 changed files with 30 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5,7 +5,7 @@ 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 ; namespaces sequences cpu.architecture math.bitwise locals ;
IN: compiler.cfg.value-numbering.rewrite IN: compiler.cfg.value-numbering.rewrite
GENERIC: rewrite ( insn -- insn' ) GENERIC: rewrite ( insn -- insn' )
@ -113,12 +113,20 @@ M: ##compare-imm rewrite
] when ] when
] when ; ] when ;
: constant-fold ( insn -- insn' )
dup dst>> vreg>expr dup constant-expr? [
[ dst>> ] [ value>> ] bi* \ ##load-immediate new-insn
dup number-values
] [
drop
] if ;
: (new-imm-insn) ( insn dst src1 n op -- new-insn/insn ) : (new-imm-insn) ( insn dst src1 n op -- new-insn/insn )
[ cell-bits bits ] dip over small-enough? [ [ cell-bits bits ] dip over small-enough? [
new-insn dup number-values nip new-insn dup number-values nip
] [ ] [
2drop 2drop 2drop 2drop
] if ; inline ] if constant-fold ; inline
: new-imm-insn ( insn dst src n op -- n' op' ) : new-imm-insn ( insn dst src n op -- n' op' )
2dup [ sgn ] dip 2array 2dup [ sgn ] dip 2array
@ -131,7 +139,7 @@ M: ##compare-imm rewrite
: 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 )
[ [
{ {
[ ] [ ]
@ -141,17 +149,24 @@ M: ##compare-imm rewrite
} cleave } cleave
] [ call ] [ ] tri* new-imm-insn ; inline ] [ call ] [ ] tri* new-imm-insn ; inline
:: combine-imm ( insn quot op -- insn )
insn op combine-imm? [
insn quot op (combine-imm)
] [
insn
] if ; inline
M: ##add-imm rewrite M: ##add-imm rewrite
{ {
{ [ dup \ ##add-imm combine-imm? ] [ [ + ] \ ##add-imm combine-imm ] } { [ dup \ ##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? ] [ [ - ] \ ##add-imm combine-imm ] } { [ dup \ ##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 ;
@ -160,32 +175,27 @@ M: ##mul-imm rewrite
[ [ dst>> ] [ src1>> ] bi ] [ log2 ] bi* \ ##shl-imm new-insn [ [ dst>> ] [ src1>> ] bi ] [ log2 ] bi* \ ##shl-imm new-insn
dup number-values dup number-values
] [ ] [
drop dup \ ##mul-imm combine-imm? drop [ * ] \ ##mul-imm combine-imm
[ [ * ] \ ##mul-imm combine-imm ] when
] if ; ] if ;
M: ##and-imm rewrite M: ##and-imm rewrite [ bitand ] \ ##and-imm combine-imm ;
dup \ ##and-imm combine-imm?
[ [ bitand ] \ ##and-imm combine-imm ] when ;
M: ##or-imm rewrite M: ##or-imm rewrite [ bitor ] \ ##or-imm combine-imm ;
dup \ ##or-imm combine-imm?
[ [ bitor ] \ ##or-imm combine-imm ] when ;
M: ##xor-imm rewrite M: ##xor-imm rewrite [ bitxor ] \ ##xor-imm combine-imm ;
dup \ ##xor-imm combine-imm?
[ [ bitxor ] \ ##xor-imm combine-imm ] when ;
: rewrite-add>add-imm? ( insn -- ? ) : rewrite-add? ( insn -- ? )
src2>> { src2>> {
[ vreg>expr constant-expr? ] [ vreg>expr constant-expr? ]
[ vreg>constant small-enough? ] [ vreg>constant small-enough? ]
} 1&& ; } 1&& ;
M: ##add rewrite M: ##add rewrite
dup rewrite-add>add-imm? [ dup rewrite-add? [
[ dst>> ] [ dst>> ]
[ src1>> ] [ src1>> ]
[ src2>> vreg>constant ] tri \ ##add-imm new-insn [ src2>> vreg>constant ] tri \ ##add-imm new-insn
dup number-values dup number-values
] when ; ] when ;
M: ##sub rewrite constant-fold ;