diff --git a/basis/compiler/cfg/branch-folding/branch-folding-tests.factor b/basis/compiler/cfg/branch-folding/branch-folding-tests.factor deleted file mode 100644 index 1d43ea0af3..0000000000 --- a/basis/compiler/cfg/branch-folding/branch-folding-tests.factor +++ /dev/null @@ -1,89 +0,0 @@ -IN: compiler.cfg.branch-folding.tests -USING: compiler.cfg.branch-folding compiler.cfg.instructions -compiler.cfg compiler.cfg.registers compiler.cfg.debugger -arrays compiler.cfg.phi-elimination compiler.cfg.dce -compiler.cfg.predecessors compiler.cfg.comparisons -kernel accessors assocs sequences classes namespaces -tools.test cpu.architecture ; - -V{ T{ ##branch } } 0 test-bb - -V{ - T{ ##peek f V int-regs 0 D 0 } - T{ ##compare-branch f V int-regs 0 V int-regs 0 cc< } -} 1 test-bb - -V{ - T{ ##load-immediate f V int-regs 1 1 } - T{ ##branch } -} 2 test-bb - -V{ - T{ ##load-immediate f V int-regs 2 2 } - T{ ##branch } -} 3 test-bb - -V{ - T{ ##phi f V int-regs 3 { } } - T{ ##replace f V int-regs 3 D 0 } - T{ ##return } -} 4 test-bb - -4 get instructions>> first -2 get V int-regs 1 2array -3 get V int-regs 2 2array 2array ->>inputs drop - -test-diamond - -[ ] [ cfg new 0 get >>entry fold-branches compute-predecessors eliminate-phis drop ] unit-test - -[ 1 ] [ 1 get successors>> length ] unit-test -[ t ] [ 1 get successors>> first 3 get eq? ] unit-test - -[ T{ ##copy f V int-regs 3 V int-regs 2 } ] -[ 3 get successors>> first instructions>> first ] -unit-test - -[ 2 ] [ 4 get instructions>> length ] unit-test - -V{ - T{ ##peek f V int-regs 0 D 0 } - T{ ##branch } -} 0 test-bb - -V{ - T{ ##peek f V int-regs 1 D 1 } - T{ ##compare-branch f V int-regs 1 V int-regs 1 cc< } -} 1 test-bb - -V{ - T{ ##copy f V int-regs 2 V int-regs 0 } - T{ ##branch } -} 2 test-bb - -V{ - T{ ##phi f V int-regs 3 V{ } } - T{ ##branch } -} 3 test-bb - -V{ - T{ ##replace f V int-regs 3 D 0 } - T{ ##return } -} 4 test-bb - -1 get V int-regs 1 2array -2 get V int-regs 0 2array 2array 3 get instructions>> first (>>inputs) - -test-diamond - -[ ] [ - cfg new 0 get >>entry - compute-predecessors - fold-branches - compute-predecessors - eliminate-dead-code - drop -] unit-test - -[ 1 ] [ 3 get instructions>> first inputs>> assoc-size ] unit-test \ No newline at end of file diff --git a/basis/compiler/cfg/branch-folding/branch-folding.factor b/basis/compiler/cfg/branch-folding/branch-folding.factor deleted file mode 100644 index 04842552b7..0000000000 --- a/basis/compiler/cfg/branch-folding/branch-folding.factor +++ /dev/null @@ -1,33 +0,0 @@ -! Copyright (C) 2009 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors combinators.short-circuit kernel sequences vectors -compiler.cfg.instructions -compiler.cfg.comparisons -compiler.cfg.rpo -compiler.cfg ; -IN: compiler.cfg.branch-folding - -! Fold comparisons where both inputs are the same. Predecessors must be -! recomputed after this - -: fold-branch? ( bb -- ? ) - instructions>> last { - [ ##compare-branch? ] - [ [ src1>> ] [ src2>> ] bi = ] - } 1&& ; - -: chosen-successor ( bb -- succ ) - [ instructions>> last cc>> { cc= cc<= cc>= } memq? 0 1 ? ] - [ successors>> ] - bi nth ; - -: fold-branch ( bb -- ) - dup chosen-successor 1vector >>successors - instructions>> [ pop* ] [ [ \ ##branch new-insn ] dip push ] bi ; - -: fold-branches ( cfg -- cfg' ) - dup [ - dup fold-branch? - [ fold-branch ] [ drop ] if - ] each-basic-block - cfg-changed ; \ No newline at end of file diff --git a/basis/compiler/cfg/branch-splitting/branch-splitting.factor b/basis/compiler/cfg/branch-splitting/branch-splitting.factor index 0dd963125f..9d6e59e4da 100644 --- a/basis/compiler/cfg/branch-splitting/branch-splitting.factor +++ b/basis/compiler/cfg/branch-splitting/branch-splitting.factor @@ -65,15 +65,15 @@ UNION: irrelevant ##peek ##replace ##inc-d ##inc-r ; : split-instructions? ( insns -- ? ) [ irrelevant? not ] count 5 <= ; -: split-branches? ( bb -- ? ) +: split-branch? ( bb -- ? ) { [ dup successors>> [ back-edge? ] with any? not ] - [ predecessors>> length 1 4 between? ] + [ predecessors>> length 2 4 between? ] [ instructions>> split-instructions? ] } 1&& ; : split-branches ( cfg -- cfg' ) dup [ - dup split-branches? [ split-branch ] [ drop ] if + dup split-branch? [ split-branch ] [ drop ] if ] each-basic-block cfg-changed ; diff --git a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor index b360eed80b..2a82139e13 100644 --- a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor +++ b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: sequences accessors layouts kernel math namespaces -combinators fry locals +combinators fry compiler.tree.propagation.info compiler.cfg.hats compiler.cfg.stacks @@ -21,32 +21,8 @@ IN: compiler.cfg.intrinsics.fixnum : tag-literal ( n -- tagged ) literal>> [ tag-fixnum ] [ \ f tag-number ] if* ; -: emit-fixnum-imm-op1 ( infos insn -- dst ) - [ ds-pop ds-drop ] [ first tag-literal ] [ ] tri* call ; inline - -: emit-fixnum-imm-op2 ( infos insn -- dst ) - [ ds-drop ds-pop ] [ second tag-literal ] [ ] tri* call ; inline - -: (emit-fixnum-op) ( insn -- dst ) - [ 2inputs ] dip call ; inline - -:: emit-fixnum-op ( node insn imm-insn -- ) - [let | infos [ node node-input-infos ] | - infos second value-info-small-tagged? - [ infos imm-insn emit-fixnum-imm-op2 ] - [ insn (emit-fixnum-op) ] if - ds-push - ] ; inline - -:: emit-commutative-fixnum-op ( node insn imm-insn -- ) - [let | infos [ node node-input-infos ] | - { - { [ infos first value-info-small-tagged? ] [ infos imm-insn emit-fixnum-imm-op1 ] } - { [ infos second value-info-small-tagged? ] [ infos imm-insn emit-fixnum-imm-op2 ] } - [ insn (emit-fixnum-op) ] - } cond - ds-push - ] ; inline +: emit-fixnum-op ( insn -- dst ) + [ 2inputs ] dip call ds-push ; inline : emit-fixnum-shift-fast ( node -- ) dup node-input-infos dup second value-info-small-fixnum? [ @@ -66,34 +42,11 @@ IN: compiler.cfg.intrinsics.fixnum : emit-fixnum-log2 ( -- ) ds-pop ^^log2 tag-bits get ^^sub-imm ^^tag-fixnum ds-push ; -: (emit-fixnum*fast) ( -- dst ) - 2inputs ^^untag-fixnum ^^mul ; +: emit-fixnum*fast ( -- ) + 2inputs ^^untag-fixnum ^^mul ds-push ; -: (emit-fixnum*fast-imm1) ( infos -- dst ) - [ ds-pop ds-drop ] [ first literal>> ] bi* ^^mul-imm ; - -: (emit-fixnum*fast-imm2) ( infos -- dst ) - [ ds-drop ds-pop ] [ second literal>> ] bi* ^^mul-imm ; - -: emit-fixnum*fast ( node -- ) - node-input-infos - dup first value-info-small-fixnum? drop f - [ - (emit-fixnum*fast-imm1) - ] [ - dup second value-info-small-fixnum? - [ (emit-fixnum*fast-imm2) ] [ drop (emit-fixnum*fast) ] if - ] if - ds-push ; - -: (emit-fixnum-comparison) ( cc -- quot1 quot2 ) - [ ^^compare ] [ ^^compare-imm ] bi-curry ; inline - -: emit-eq ( node -- ) - cc= (emit-fixnum-comparison) emit-commutative-fixnum-op ; - -: emit-fixnum-comparison ( node cc -- ) - (emit-fixnum-comparison) emit-fixnum-op ; +: emit-fixnum-comparison ( cc -- ) + '[ _ ^^compare ] emit-fixnum-op ; : emit-bignum>fixnum ( -- ) ds-pop ^^bignum>integer ^^tag-fixnum ds-push ; diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor index 5283581bdd..ed94ec36d9 100644 --- a/basis/compiler/cfg/intrinsics/intrinsics.factor +++ b/basis/compiler/cfg/intrinsics/intrinsics.factor @@ -103,20 +103,20 @@ IN: compiler.cfg.intrinsics { \ math.private:fixnum+ [ drop [ ##fixnum-add ] emit-fixnum-overflow-op ] } { \ math.private:fixnum- [ drop [ ##fixnum-sub ] emit-fixnum-overflow-op ] } { \ math.private:fixnum* [ drop [ i i ##fixnum-mul ] emit-fixnum-overflow-op ] } - { \ math.private:fixnum+fast [ [ ^^add ] [ ^^add-imm ] emit-commutative-fixnum-op ] } - { \ math.private:fixnum-fast [ [ ^^sub ] [ ^^sub-imm ] emit-fixnum-op ] } - { \ math.private:fixnum-bitand [ [ ^^and ] [ ^^and-imm ] emit-commutative-fixnum-op ] } - { \ math.private:fixnum-bitor [ [ ^^or ] [ ^^or-imm ] emit-commutative-fixnum-op ] } - { \ math.private:fixnum-bitxor [ [ ^^xor ] [ ^^xor-imm ] emit-commutative-fixnum-op ] } + { \ math.private:fixnum+fast [ drop [ ^^add ] emit-fixnum-op ] } + { \ math.private:fixnum-fast [ drop [ ^^sub ] emit-fixnum-op ] } + { \ math.private:fixnum-bitand [ drop [ ^^and ] emit-fixnum-op ] } + { \ math.private:fixnum-bitor [ drop [ ^^or ] emit-fixnum-op ] } + { \ math.private:fixnum-bitxor [ drop [ ^^xor ] emit-fixnum-op ] } { \ math.private:fixnum-shift-fast [ emit-fixnum-shift-fast ] } { \ math.private:fixnum-bitnot [ drop emit-fixnum-bitnot ] } { \ math.integers.private:fixnum-log2 [ drop emit-fixnum-log2 ] } - { \ math.private:fixnum*fast [ emit-fixnum*fast ] } - { \ math.private:fixnum< [ cc< emit-fixnum-comparison ] } - { \ math.private:fixnum<= [ cc<= emit-fixnum-comparison ] } - { \ math.private:fixnum>= [ cc>= emit-fixnum-comparison ] } - { \ math.private:fixnum> [ cc> emit-fixnum-comparison ] } - { \ kernel:eq? [ emit-eq ] } + { \ math.private:fixnum*fast [ drop emit-fixnum*fast ] } + { \ math.private:fixnum< [ drop cc< emit-fixnum-comparison ] } + { \ math.private:fixnum<= [ drop cc<= emit-fixnum-comparison ] } + { \ math.private:fixnum>= [ drop cc>= emit-fixnum-comparison ] } + { \ math.private:fixnum> [ drop cc> emit-fixnum-comparison ] } + { \ kernel:eq? [ drop cc= emit-fixnum-comparison ] } { \ math.private:bignum>fixnum [ drop emit-bignum>fixnum ] } { \ math.private:fixnum>bignum [ drop emit-fixnum>bignum ] } { \ math.private:float+ [ drop [ ^^add-float ] emit-float-op ] } diff --git a/basis/compiler/cfg/local/local.factor b/basis/compiler/cfg/local/local.factor index 5d78397998..2f5f5b18e3 100644 --- a/basis/compiler/cfg/local/local.factor +++ b/basis/compiler/cfg/local/local.factor @@ -1,10 +1,14 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: fry accessors kernel assocs compiler.cfg.liveness compiler.cfg.rpo ; +USING: locals accessors kernel assocs namespaces +compiler.cfg compiler.cfg.liveness compiler.cfg.rpo ; IN: compiler.cfg.local -: optimize-basic-block ( bb init-quot insn-quot -- ) - [ '[ live-in keys @ ] ] [ '[ _ change-instructions drop ] ] bi* bi ; inline +:: optimize-basic-block ( bb init-quot insn-quot -- ) + bb basic-block set + bb live-in keys init-quot call + bb insn-quot change-instructions drop ; inline -: local-optimization ( cfg init-quot: ( live-in -- ) insn-quot: ( insns -- insns' ) -- cfg' ) - [ dup ] 2dip '[ _ _ optimize-basic-block ] each-basic-block ; inline \ No newline at end of file +:: local-optimization ( cfg init-quot: ( live-in -- ) insn-quot: ( insns -- insns' ) -- cfg' ) + cfg [ init-quot insn-quot optimize-basic-block ] each-basic-block + cfg ; inline \ No newline at end of file diff --git a/basis/compiler/cfg/optimizer/optimizer.factor b/basis/compiler/cfg/optimizer/optimizer.factor index 5b0892a0ee..e16fb734e1 100644 --- a/basis/compiler/cfg/optimizer/optimizer.factor +++ b/basis/compiler/cfg/optimizer/optimizer.factor @@ -9,7 +9,6 @@ compiler.cfg.branch-splitting compiler.cfg.alias-analysis compiler.cfg.value-numbering compiler.cfg.dce -compiler.cfg.branch-folding compiler.cfg.write-barrier compiler.cfg.liveness compiler.cfg.rpo @@ -36,7 +35,6 @@ SYMBOL: check-optimizer? compute-liveness alias-analysis value-numbering - fold-branches compute-predecessors eliminate-dead-code eliminate-write-barriers diff --git a/basis/compiler/cfg/stack-analysis/stack-analysis-tests.factor b/basis/compiler/cfg/stack-analysis/stack-analysis-tests.factor index 23b1098cd6..9fbf7acf78 100644 --- a/basis/compiler/cfg/stack-analysis/stack-analysis-tests.factor +++ b/basis/compiler/cfg/stack-analysis/stack-analysis-tests.factor @@ -91,9 +91,9 @@ IN: compiler.cfg.stack-analysis.tests ! Sync before a back-edge, not after ! ##peeks should be inserted before a ##loop-entry ! Don't optimize out the constants -[ 1 t ] [ +[ t ] [ [ 1000 [ ] times ] test-stack-analysis eliminate-dead-code linearize - [ [ ##add-imm? ] count ] [ [ ##load-immediate? ] any? ] bi + [ ##load-immediate? ] any? ] unit-test ! Correct height tracking diff --git a/basis/compiler/cfg/value-numbering/expressions/expressions.factor b/basis/compiler/cfg/value-numbering/expressions/expressions.factor index bf750231c7..76ad3d892f 100644 --- a/basis/compiler/cfg/value-numbering/expressions/expressions.factor +++ b/basis/compiler/cfg/value-numbering/expressions/expressions.factor @@ -1,7 +1,8 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors classes kernel math namespaces combinators -compiler.cfg.instructions compiler.cfg.value-numbering.graph ; +combinators.short-circuit compiler.cfg.instructions +compiler.cfg.value-numbering.graph ; IN: compiler.cfg.value-numbering.expressions ! Referentially-transparent expressions @@ -11,15 +12,29 @@ TUPLE: binary-expr < expr in1 in2 ; TUPLE: commutative-expr < binary-expr ; TUPLE: compare-expr < binary-expr cc ; TUPLE: constant-expr < expr value ; +TUPLE: reference-expr < expr value ; : ( constant -- expr ) f swap constant-expr boa ; inline M: constant-expr equal? over constant-expr? [ - [ [ value>> ] bi@ = ] - [ [ value>> class ] bi@ = ] 2bi - and + { + [ [ value>> class ] bi@ = ] + [ [ value>> ] bi@ = ] + } 2&& + ] [ 2drop f ] if ; + +: ( constant -- expr ) + f swap reference-expr boa ; inline + +M: reference-expr equal? + over reference-expr? [ + [ value>> ] bi@ { + { [ 2dup eq? ] [ 2drop t ] } + { [ 2dup [ float? ] both? ] [ fp-bitwise= ] } + [ 2drop f ] + } cond ] [ 2drop f ] if ; ! Expressions whose values are inputs to the basic block. We @@ -39,6 +54,8 @@ GENERIC: >expr ( insn -- expr ) M: ##load-immediate >expr val>> ; +M: ##load-reference >expr obj>> ; + M: ##unary >expr [ class ] [ src>> vreg>vn ] bi unary-expr boa ; diff --git a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor index a0e8dd6146..3f7173c355 100755 --- a/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor +++ b/basis/compiler/cfg/value-numbering/rewrite/rewrite.factor @@ -1,8 +1,9 @@ ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors locals combinators combinators.short-circuit arrays +USING: accessors combinators combinators.short-circuit arrays fry kernel layouts math namespaces sequences cpu.architecture -math.bitwise classes +math.bitwise math.order classes vectors +compiler.cfg compiler.cfg.hats compiler.cfg.comparisons compiler.cfg.instructions @@ -11,6 +12,12 @@ compiler.cfg.value-numbering.graph compiler.cfg.value-numbering.simplify ; IN: compiler.cfg.value-numbering.rewrite +: vreg-small-constant? ( vreg -- ? ) + vreg>expr { + [ constant-expr? ] + [ value>> small-enough? ] + } 1&& ; + ! Outputs f to mean no change GENERIC: rewrite* ( insn -- insn/f ) @@ -76,48 +83,6 @@ M: ##compare-imm rewrite-tagged-comparison [ dst>> ] [ (rewrite-tagged-comparison) ] bi i \ ##compare-imm new-insn ; -M: ##compare-imm-branch rewrite* - { - { [ dup rewrite-boolean-comparison? ] [ rewrite-boolean-comparison ] } - { [ dup rewrite-tagged-comparison? ] [ rewrite-tagged-comparison ] } - [ drop f ] - } cond ; - -:: >compare-imm ( insn swap? -- insn' ) - insn dst>> - insn src1>> - insn src2>> swap? [ swap ] when vreg>constant - insn cc>> swap? [ swap-cc ] when - i \ ##compare-imm new-insn ; inline - -: vreg-small-constant? ( vreg -- ? ) - vreg>expr { - [ constant-expr? ] - [ value>> small-enough? ] - } 1&& ; - -M: ##compare rewrite* - dup [ src1>> ] [ src2>> ] bi - [ vreg-small-constant? ] bi@ 2array { - { { f t } [ f >compare-imm ] } - { { t f } [ t >compare-imm ] } - [ 2drop f ] - } case ; - -:: >compare-imm-branch ( insn swap? -- insn' ) - insn src1>> - insn src2>> swap? [ swap ] when vreg>constant - insn cc>> swap? [ swap-cc ] when - \ ##compare-imm-branch new-insn ; inline - -M: ##compare-branch rewrite* - dup [ src1>> ] [ src2>> ] bi - [ vreg-small-constant? ] bi@ 2array { - { { f t } [ f >compare-imm-branch ] } - { { t f } [ t >compare-imm-branch ] } - [ 2drop f ] - } case ; - : rewrite-redundant-comparison? ( insn -- ? ) { [ src1>> vreg>expr compare-expr? ] @@ -133,10 +98,109 @@ M: ##compare-branch rewrite* } case swap cc= eq? [ [ negate-cc ] change-cc ] when ; +ERROR: bad-comparison ; + +: (fold-compare-imm) ( insn -- ? ) + [ [ src1>> vreg>constant ] [ src2>> ] bi ] [ cc>> ] bi + pick integer? + [ [ <=> ] dip evaluate-cc ] + [ + 2nip { + { cc= [ f ] } + { cc/= [ t ] } + [ bad-comparison ] + } case + ] if ; + +: fold-compare-imm? ( insn -- ? ) + src1>> vreg>expr [ constant-expr? ] [ reference-expr? ] bi or ; + +: fold-branch ( ? -- insn ) + 0 1 ? + basic-block get [ nth 1vector ] change-successors drop + \ ##branch new-insn ; + +: fold-compare-imm-branch ( insn -- insn/f ) + (fold-compare-imm) fold-branch ; + +M: ##compare-imm-branch rewrite* + { + { [ dup rewrite-boolean-comparison? ] [ rewrite-boolean-comparison ] } + { [ dup rewrite-tagged-comparison? ] [ rewrite-tagged-comparison ] } + { [ dup fold-compare-imm? ] [ fold-compare-imm-branch ] } + [ drop f ] + } cond ; + +: swap-compare ( src1 src2 cc swap? -- src1 src2 cc ) + [ [ swap ] dip swap-cc ] when ; inline + +: >compare-imm-branch ( insn swap? -- insn' ) + [ + [ src1>> ] + [ src2>> ] + [ cc>> ] + tri + ] dip + swap-compare + [ vreg>constant ] dip + \ ##compare-imm-branch new-insn ; inline + +: self-compare? ( insn -- ? ) + [ src1>> ] [ src2>> ] bi [ vreg>vn ] bi@ = ; inline + +: (rewrite-self-compare) ( insn -- ? ) + cc>> { cc= cc<= cc>= } memq? ; + +: rewrite-self-compare-branch ( insn -- insn' ) + (rewrite-self-compare) fold-branch ; + +M: ##compare-branch rewrite* + { + { [ dup src1>> vreg-small-constant? ] [ t >compare-imm-branch ] } + { [ dup src2>> vreg-small-constant? ] [ f >compare-imm-branch ] } + { [ dup self-compare? ] [ rewrite-self-compare-branch ] } + [ drop f ] + } cond ; + +: >compare-imm ( insn swap? -- insn' ) + [ + { + [ dst>> ] + [ src1>> ] + [ src2>> ] + [ cc>> ] + } cleave + ] dip + swap-compare + [ vreg>constant ] dip + i \ ##compare-imm new-insn ; inline + +: >boolean-insn ( insn ? -- insn' ) + [ dst>> ] dip + { + { t [ t \ ##load-reference new-insn ] } + { f [ \ f tag-number \ ##load-immediate new-insn ] } + } case ; + +: rewrite-self-compare ( insn -- insn' ) + dup (rewrite-self-compare) >boolean-insn ; + +M: ##compare rewrite* + { + { [ dup src1>> vreg-small-constant? ] [ t >compare-imm ] } + { [ dup src2>> vreg-small-constant? ] [ f >compare-imm ] } + { [ dup self-compare? ] [ rewrite-self-compare ] } + [ drop f ] + } cond ; + +: fold-compare-imm ( insn -- insn' ) + dup (fold-compare-imm) >boolean-insn ; + M: ##compare-imm rewrite* { { [ dup rewrite-redundant-comparison? ] [ rewrite-redundant-comparison ] } { [ dup rewrite-tagged-comparison? ] [ rewrite-tagged-comparison ] } + { [ dup fold-compare-imm? ] [ fold-compare-imm ] } [ drop f ] } cond ; @@ -160,22 +224,19 @@ M: ##shl-imm constant-fold* drop shift ; [ [ src1>> vreg>constant ] [ src2>> ] [ ] tri constant-fold* ] bi \ ##load-immediate new-insn ; inline -:: new-imm-insn ( insn dst src1 src2 op -- new-insn/insn ) - src2 small-enough? [ dst src1 src2 op new-insn ] [ insn ] if ; inline - : reassociate? ( insn -- ? ) [ src1>> vreg>expr op>> ] [ class ] bi = ; inline : reassociate ( insn op -- insn ) [ { - [ ] [ dst>> ] [ src1>> vreg>expr [ in1>> vn>vreg ] [ in2>> vn>constant ] bi ] [ src2>> ] [ ] } cleave constant-fold* - ] dip new-imm-insn ; inline + ] dip + over small-enough? [ new-insn ] [ 2drop 2drop f ] if ; inline M: ##add-imm rewrite* { @@ -185,8 +246,8 @@ M: ##add-imm rewrite* } cond ; : sub-imm>add-imm ( insn -- insn' ) - dup [ dst>> ] [ src1>> ] [ src2>> neg ] tri dup small-enough? - [ \ ##add-imm new-insn nip ] [ 2drop 2drop f ] if ; + [ dst>> ] [ src1>> ] [ src2>> neg ] tri dup small-enough? + [ \ ##add-imm new-insn ] [ 3drop f ] if ; M: ##sub-imm rewrite* { @@ -247,12 +308,11 @@ M: ##sar-imm rewrite* [ drop f ] } cond ; -:: insn>imm-insn ( insn op swap? -- ) - insn - insn dst>> - insn src1>> - insn src2>> swap? [ swap ] when vreg>constant - op new-imm-insn ; inline +: insn>imm-insn ( insn op swap? -- ) + swap [ + [ [ dst>> ] [ src1>> ] [ src2>> ] tri ] dip + [ swap ] when vreg>constant + ] dip new-insn ; inline : rewrite-arithmetic ( insn op -- ? ) { diff --git a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor index 6ed0a74da5..4c431b8a5c 100644 --- a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor +++ b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor @@ -2,7 +2,9 @@ IN: compiler.cfg.value-numbering.tests USING: compiler.cfg.value-numbering compiler.cfg.instructions compiler.cfg.registers compiler.cfg.debugger compiler.cfg.comparisons cpu.architecture tools.test kernel math combinators.short-circuit -accessors sequences compiler.cfg vectors arrays layouts ; +accessors sequences compiler.cfg.predecessors +compiler.cfg.phi-elimination compiler.cfg.dce compiler.cfg.liveness +compiler.cfg assocs vectors arrays layouts namespaces ; : trim-temps ( insns -- insns ) [ @@ -17,6 +19,55 @@ accessors sequences compiler.cfg vectors arrays layouts ; { } init-value-numbering value-numbering-step ; +! Folding constants together +[ + { + T{ ##load-reference f V int-regs 0 0.0 } + T{ ##load-reference f V int-regs 1 -0.0 } + T{ ##replace f V int-regs 0 D 0 } + T{ ##replace f V int-regs 1 D 1 } + } +] [ + { + T{ ##load-reference f V int-regs 0 0.0 } + T{ ##load-reference f V int-regs 1 -0.0 } + T{ ##replace f V int-regs 0 D 0 } + T{ ##replace f V int-regs 1 D 1 } + } test-value-numbering +] unit-test + +[ + { + T{ ##load-reference f V int-regs 0 0.0 } + T{ ##load-reference f V int-regs 1 0.0 } + T{ ##replace f V int-regs 0 D 0 } + T{ ##replace f V int-regs 0 D 1 } + } +] [ + { + T{ ##load-reference f V int-regs 0 0.0 } + T{ ##load-reference f V int-regs 1 0.0 } + T{ ##replace f V int-regs 0 D 0 } + T{ ##replace f V int-regs 1 D 1 } + } test-value-numbering +] unit-test + +[ + { + T{ ##load-reference f V int-regs 0 t } + T{ ##load-reference f V int-regs 1 t } + T{ ##replace f V int-regs 0 D 0 } + T{ ##replace f V int-regs 0 D 1 } + } +] [ + { + T{ ##load-reference f V int-regs 0 t } + T{ ##load-reference f V int-regs 1 t } + T{ ##replace f V int-regs 0 D 0 } + T{ ##replace f V int-regs 1 D 1 } + } test-value-numbering +] unit-test + ! Copy propagation [ { @@ -805,4 +856,479 @@ cell 8 = [ T{ ##add f V int-regs 3 V int-regs 0 V int-regs 2 } } test-value-numbering ] unit-test -] when \ No newline at end of file + + [ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##load-immediate f V int-regs 2 140737488355328 } + T{ ##add f V int-regs 3 V int-regs 0 V int-regs 2 } + } + ] [ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##load-immediate f V int-regs 2 140737488355328 } + T{ ##add f V int-regs 3 V int-regs 0 V int-regs 2 } + } test-value-numbering + ] unit-test + + [ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##load-immediate f V int-regs 2 2147483647 } + T{ ##add-imm f V int-regs 3 V int-regs 0 2147483647 } + T{ ##add-imm f V int-regs 4 V int-regs 3 2147483647 } + } + ] [ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##load-immediate f V int-regs 2 2147483647 } + T{ ##add f V int-regs 3 V int-regs 0 V int-regs 2 } + T{ ##add f V int-regs 4 V int-regs 3 V int-regs 2 } + } test-value-numbering + ] unit-test +] when + +! Branch folding +[ + { + T{ ##load-immediate f V int-regs 1 1 } + T{ ##load-immediate f V int-regs 2 2 } + T{ ##load-immediate f V int-regs 3 5 } + } +] [ + { + T{ ##load-immediate f V int-regs 1 1 } + T{ ##load-immediate f V int-regs 2 2 } + T{ ##compare f V int-regs 3 V int-regs 1 V int-regs 2 cc= } + } test-value-numbering +] unit-test + +[ + { + T{ ##load-immediate f V int-regs 1 1 } + T{ ##load-immediate f V int-regs 2 2 } + T{ ##load-reference f V int-regs 3 t } + } +] [ + { + T{ ##load-immediate f V int-regs 1 1 } + T{ ##load-immediate f V int-regs 2 2 } + T{ ##compare f V int-regs 3 V int-regs 1 V int-regs 2 cc/= } + } test-value-numbering +] unit-test + +[ + { + T{ ##load-immediate f V int-regs 1 1 } + T{ ##load-immediate f V int-regs 2 2 } + T{ ##load-reference f V int-regs 3 t } + } +] [ + { + T{ ##load-immediate f V int-regs 1 1 } + T{ ##load-immediate f V int-regs 2 2 } + T{ ##compare f V int-regs 3 V int-regs 1 V int-regs 2 cc< } + } test-value-numbering +] unit-test + +[ + { + T{ ##load-immediate f V int-regs 1 1 } + T{ ##load-immediate f V int-regs 2 2 } + T{ ##load-immediate f V int-regs 3 5 } + } +] [ + { + T{ ##load-immediate f V int-regs 1 1 } + T{ ##load-immediate f V int-regs 2 2 } + T{ ##compare f V int-regs 3 V int-regs 2 V int-regs 1 cc< } + } test-value-numbering +] unit-test + +[ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##load-immediate f V int-regs 1 5 } + } +] [ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##compare f V int-regs 1 V int-regs 0 V int-regs 0 cc< } + } test-value-numbering +] unit-test + +[ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##load-reference f V int-regs 1 t } + } +] [ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##compare f V int-regs 1 V int-regs 0 V int-regs 0 cc<= } + } test-value-numbering +] unit-test + +[ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##load-immediate f V int-regs 1 5 } + } +] [ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##compare f V int-regs 1 V int-regs 0 V int-regs 0 cc> } + } test-value-numbering +] unit-test + +[ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##load-reference f V int-regs 1 t } + } +] [ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##compare f V int-regs 1 V int-regs 0 V int-regs 0 cc>= } + } test-value-numbering +] unit-test + +[ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##load-immediate f V int-regs 1 5 } + } +] [ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##compare f V int-regs 1 V int-regs 0 V int-regs 0 cc/= } + } test-value-numbering +] unit-test + +[ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##load-reference f V int-regs 1 t } + } +] [ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##compare f V int-regs 1 V int-regs 0 V int-regs 0 cc= } + } test-value-numbering +] unit-test + +: test-branch-folding ( insns -- insns' n ) + + [ V{ 0 1 } clone >>successors basic-block set test-value-numbering ] keep + successors>> first ; + +[ + { + T{ ##load-immediate f V int-regs 1 1 } + T{ ##load-immediate f V int-regs 2 2 } + T{ ##branch } + } + 1 +] [ + { + T{ ##load-immediate f V int-regs 1 1 } + T{ ##load-immediate f V int-regs 2 2 } + T{ ##compare-branch f V int-regs 1 V int-regs 2 cc= } + } test-branch-folding +] unit-test + +[ + { + T{ ##load-immediate f V int-regs 1 1 } + T{ ##load-immediate f V int-regs 2 2 } + T{ ##branch } + } + 0 +] [ + { + T{ ##load-immediate f V int-regs 1 1 } + T{ ##load-immediate f V int-regs 2 2 } + T{ ##compare-branch f V int-regs 1 V int-regs 2 cc/= } + } test-branch-folding +] unit-test + +[ + { + T{ ##load-immediate f V int-regs 1 1 } + T{ ##load-immediate f V int-regs 2 2 } + T{ ##branch } + } + 0 +] [ + { + T{ ##load-immediate f V int-regs 1 1 } + T{ ##load-immediate f V int-regs 2 2 } + T{ ##compare-branch f V int-regs 1 V int-regs 2 cc< } + } test-branch-folding +] unit-test + +[ + { + T{ ##load-immediate f V int-regs 1 1 } + T{ ##load-immediate f V int-regs 2 2 } + T{ ##branch } + } + 1 +] [ + { + T{ ##load-immediate f V int-regs 1 1 } + T{ ##load-immediate f V int-regs 2 2 } + T{ ##compare-branch f V int-regs 2 V int-regs 1 cc< } + } test-branch-folding +] unit-test + +[ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##branch } + } + 1 +] [ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##compare-branch f V int-regs 0 V int-regs 0 cc< } + } test-branch-folding +] unit-test + +[ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##branch } + } + 0 +] [ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##compare-branch f V int-regs 0 V int-regs 0 cc<= } + } test-branch-folding +] unit-test + +[ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##branch } + } + 1 +] [ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##compare-branch f V int-regs 0 V int-regs 0 cc> } + } test-branch-folding +] unit-test + +[ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##branch } + } + 0 +] [ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##compare-branch f V int-regs 0 V int-regs 0 cc>= } + } test-branch-folding +] unit-test + +[ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##branch } + } + 0 +] [ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##compare-branch f V int-regs 0 V int-regs 0 cc= } + } test-branch-folding +] unit-test + +[ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##branch } + } + 1 +] [ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##compare-branch f V int-regs 0 V int-regs 0 cc/= } + } test-branch-folding +] unit-test + +[ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##load-reference f V int-regs 1 t } + T{ ##branch } + } + 0 +] [ + { + T{ ##peek f V int-regs 0 D 0 } + T{ ##compare f V int-regs 1 V int-regs 0 V int-regs 0 cc<= } + T{ ##compare-imm-branch f V int-regs 1 5 cc/= } + } test-branch-folding +] unit-test + +! More branch folding tests +V{ T{ ##branch } } 0 test-bb + +V{ + T{ ##peek f V int-regs 0 D 0 } + T{ ##compare-branch f V int-regs 0 V int-regs 0 cc< } +} 1 test-bb + +V{ + T{ ##load-immediate f V int-regs 1 1 } + T{ ##branch } +} 2 test-bb + +V{ + T{ ##load-immediate f V int-regs 2 2 } + T{ ##branch } +} 3 test-bb + +V{ + T{ ##phi f V int-regs 3 { } } + T{ ##replace f V int-regs 3 D 0 } + T{ ##return } +} 4 test-bb + +4 get instructions>> first +2 get V int-regs 1 2array +3 get V int-regs 2 2array 2array +>>inputs drop + +test-diamond + +[ ] [ + cfg new 0 get >>entry + compute-liveness + value-numbering + compute-predecessors + eliminate-phis drop +] unit-test + +[ 1 ] [ 1 get successors>> length ] unit-test + +[ t ] [ 1 get successors>> first 3 get eq? ] unit-test + +[ T{ ##copy f V int-regs 3 V int-regs 2 } ] +[ 3 get successors>> first instructions>> first ] +unit-test + +[ 2 ] [ 4 get instructions>> length ] unit-test + +V{ + T{ ##peek f V int-regs 0 D 0 } + T{ ##branch } +} 0 test-bb + +V{ + T{ ##peek f V int-regs 1 D 1 } + T{ ##compare-branch f V int-regs 1 V int-regs 1 cc< } +} 1 test-bb + +V{ + T{ ##copy f V int-regs 2 V int-regs 0 } + T{ ##branch } +} 2 test-bb + +V{ + T{ ##phi f V int-regs 3 V{ } } + T{ ##branch } +} 3 test-bb + +V{ + T{ ##replace f V int-regs 3 D 0 } + T{ ##return } +} 4 test-bb + +1 get V int-regs 1 2array +2 get V int-regs 0 2array 2array 3 get instructions>> first (>>inputs) + +test-diamond + +[ ] [ + cfg new 0 get >>entry + compute-predecessors + compute-liveness + value-numbering + compute-predecessors + eliminate-dead-code + drop +] unit-test + +[ t ] [ 1 get successors>> first 3 get eq? ] unit-test + +[ 1 ] [ 3 get instructions>> first inputs>> assoc-size ] unit-test + +V{ T{ ##prologue } T{ ##branch } } 0 test-bb + +V{ + T{ ##peek { dst V int-regs 15 } { loc D 0 } } + T{ ##copy { dst V int-regs 16 } { src V int-regs 15 } } + T{ ##copy { dst V int-regs 17 } { src V int-regs 15 } } + T{ ##copy { dst V int-regs 18 } { src V int-regs 15 } } + T{ ##copy { dst V int-regs 19 } { src V int-regs 15 } } + T{ ##compare + { dst V int-regs 20 } + { src1 V int-regs 18 } + { src2 V int-regs 19 } + { cc cc= } + { temp V int-regs 22 } + } + T{ ##copy { dst V int-regs 21 } { src V int-regs 20 } } + T{ ##compare-imm-branch + { src1 V int-regs 21 } + { src2 5 } + { cc cc/= } + } +} 1 test-bb + +V{ + T{ ##copy { dst V int-regs 23 } { src V int-regs 15 } } + T{ ##copy { dst V int-regs 24 } { src V int-regs 15 } } + T{ ##load-reference { dst V int-regs 25 } { obj t } } + T{ ##branch } +} 2 test-bb + +V{ + T{ ##replace { src V int-regs 25 } { loc D 0 } } + T{ ##epilogue } + T{ ##return } +} 3 test-bb + +V{ + T{ ##copy { dst V int-regs 26 } { src V int-regs 15 } } + T{ ##copy { dst V int-regs 27 } { src V int-regs 15 } } + T{ ##add + { dst V int-regs 28 } + { src1 V int-regs 26 } + { src2 V int-regs 27 } + } + T{ ##branch } +} 4 test-bb + +V{ + T{ ##replace { src V int-regs 28 } { loc D 0 } } + T{ ##epilogue } + T{ ##return } +} 5 test-bb + +0 get 1 get 1vector >>successors drop +1 get 2 get 4 get V{ } 2sequence >>successors drop +2 get 3 get 1vector >>successors drop +4 get 5 get 1vector >>successors drop + +[ ] [ + cfg new 0 get >>entry + compute-liveness value-numbering eliminate-dead-code drop +] unit-test + +[ f ] [ 1 get instructions>> [ ##peek? ] any? ] unit-test \ No newline at end of file diff --git a/basis/compiler/cfg/value-numbering/value-numbering.factor b/basis/compiler/cfg/value-numbering/value-numbering.factor index 9e6e058b52..e49555e06e 100644 --- a/basis/compiler/cfg/value-numbering/value-numbering.factor +++ b/basis/compiler/cfg/value-numbering/value-numbering.factor @@ -2,6 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: namespaces assocs biassocs classes kernel math accessors sorting sets sequences fry +compiler.cfg compiler.cfg.local compiler.cfg.liveness compiler.cfg.renaming @@ -11,6 +12,8 @@ compiler.cfg.value-numbering.simplify compiler.cfg.value-numbering.rewrite ; IN: compiler.cfg.value-numbering +! Local value numbering. Predecessors must be recomputed after this + : number-input-values ( live-in -- ) [ [ f next-input-expr simplify ] dip set-vn ] each ; @@ -32,4 +35,5 @@ IN: compiler.cfg.value-numbering [ rewrite ] map dup rename-uses ; : value-numbering ( cfg -- cfg' ) - [ init-value-numbering ] [ value-numbering-step ] local-optimization ; + [ init-value-numbering ] [ value-numbering-step ] local-optimization + cfg-changed ; diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor index 8f7bc077b4..9f573019c2 100644 --- a/basis/compiler/tests/codegen.factor +++ b/basis/compiler/tests/codegen.factor @@ -318,4 +318,7 @@ M: cucumber equal? "The cucumber has no equal" throw ; cell 4 = [ [ 0 ] [ 101 [ dup fixnum-fast 1 fixnum+fast 20 fixnum-shift-fast 20 fixnum-shift-fast ] compile-call ] unit-test -] when \ No newline at end of file +] when + +! Regression from Slava's value numbering changes +[ 1 ] [ 31337 [ dup fixnum<= [ 1 ] [ 2 ] if ] compile-call ] unit-test \ No newline at end of file