diff --git a/basis/compiler/cfg/representations/coalescing/authors.txt b/basis/compiler/cfg/representations/coalescing/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/compiler/cfg/representations/coalescing/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/compiler/cfg/representations/coalescing/coalescing-tests.factor b/basis/compiler/cfg/representations/coalescing/coalescing-tests.factor new file mode 100644 index 0000000000..f22fe0d147 --- /dev/null +++ b/basis/compiler/cfg/representations/coalescing/coalescing-tests.factor @@ -0,0 +1,43 @@ +USING: arrays sequences kernel namespaces accessors compiler.cfg +compiler.cfg.instructions +compiler.cfg.registers +compiler.cfg.debugger +compiler.cfg.representations.coalescing +tools.test ; +IN: compiler.cfg.representations.coalescing.tests + +: test-scc ( -- ) + cfg new 0 get >>entry compute-components ; + +V{ + T{ ##prologue } + T{ ##branch } +} 0 test-bb + +V{ + T{ ##peek f 2 D 0 } + T{ ##load-integer f 0 0 } + T{ ##branch } +} 1 test-bb + +V{ + T{ ##load-integer f 1 0 } + T{ ##branch } +} 2 test-bb + +V{ + T{ ##phi f 3 } +} 3 test-bb + +0 { 1 2 } edges +1 3 edge +2 3 edge + +1 get 0 2array +2 get 1 2array 2array 3 get instructions>> first (>>inputs) + +[ ] [ test-scc ] unit-test + +[ t ] [ 0 vreg>scc 1 vreg>scc = ] unit-test +[ t ] [ 0 vreg>scc 3 vreg>scc = ] unit-test +[ f ] [ 2 vreg>scc 3 vreg>scc = ] unit-test diff --git a/basis/compiler/cfg/representations/coalescing/coalescing.factor b/basis/compiler/cfg/representations/coalescing/coalescing.factor new file mode 100644 index 0000000000..20610649bc --- /dev/null +++ b/basis/compiler/cfg/representations/coalescing/coalescing.factor @@ -0,0 +1,43 @@ +! Copyright (C) 2010 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors assocs compiler.cfg.def-use +compiler.cfg.instructions compiler.cfg.rpo disjoint-sets fry +kernel namespaces sequences ; +IN: compiler.cfg.representations.coalescing + +! Find all strongly connected components in the graph where the +! edges are ##phi or ##copy vreg uses +SYMBOL: components + +: init-components ( cfg components -- ) + '[ + instructions>> [ + defs-vreg [ _ add-atom ] when* + ] each + ] each-basic-block ; + +GENERIC# visit-insn 1 ( insn disjoint-set -- ) + +M: ##copy visit-insn + [ [ dst>> ] [ src>> ] bi ] dip equate ; + +M: ##phi visit-insn + [ [ inputs>> values ] [ dst>> ] bi ] dip equate-all-with ; + +M: insn visit-insn 2drop ; + +: merge-components ( cfg components -- ) + '[ + instructions>> [ + _ visit-insn + ] each + ] each-basic-block ; + +: compute-components ( cfg -- ) + + [ init-components ] + [ merge-components ] + [ components set drop ] 2tri ; + +: vreg>scc ( vreg -- scc ) + components get representative ; diff --git a/basis/compiler/cfg/representations/preferred/preferred.factor b/basis/compiler/cfg/representations/preferred/preferred.factor index e4114c9249..e1a9ec0d93 100644 --- a/basis/compiler/cfg/representations/preferred/preferred.factor +++ b/basis/compiler/cfg/representations/preferred/preferred.factor @@ -80,7 +80,7 @@ PRIVATE> : each-rep ( insn vreg-quot: ( vreg rep -- ) -- ) [ each-def-rep ] [ each-use-rep ] [ each-temp-rep ] 2tri ; inline -: with-vreg-reps ( ..a cfg vreg-quot: ( ..a vreg rep -- ..b ) -- ..b ) +: with-vreg-reps ( cfg vreg-quot: ( vreg rep -- ) -- ) '[ [ basic-block set ] [ [ diff --git a/basis/compiler/cfg/representations/representations-tests.factor b/basis/compiler/cfg/representations/representations-tests.factor index b8860d1445..dcd7fc7241 100644 --- a/basis/compiler/cfg/representations/representations-tests.factor +++ b/basis/compiler/cfg/representations/representations-tests.factor @@ -3,7 +3,9 @@ compiler.cfg.instructions compiler.cfg.registers compiler.cfg.representations.preferred cpu.architecture kernel namespaces tools.test sequences arrays system literals layouts math compiler.constants compiler.cfg.representations.conversion -compiler.cfg.representations.rewrite make ; +compiler.cfg.representations.rewrite +compiler.cfg.comparisons +make ; IN: compiler.cfg.representations [ { double-rep double-rep } ] [ @@ -116,8 +118,51 @@ V{ } ] [ 1 get instructions>> ] unit-test -! But its ok to untag-fixnum the result of a peek if there are -! no usages of it as a tagged-rep +! We cannot untag-fixnum the result of a peek if there are usages +! of it as a tagged-rep +V{ + T{ ##prologue } + T{ ##branch } +} 0 test-bb + +V{ + T{ ##peek f 1 D 0 } + T{ ##branch } +} 1 test-bb + +V{ + T{ ##replace f 1 R 0 } + T{ ##epilogue } + T{ ##return } +} 2 test-bb + +V{ + T{ ##mul f 2 1 1 } + T{ ##replace f 2 D 0 } + T{ ##branch } +} 3 test-bb + +V{ + T{ ##epilogue } + T{ ##return } +} 4 test-bb + +0 1 edge +1 { 2 3 } edges +3 { 3 4 } edges +2 4 edge + +[ ] [ test-representations ] unit-test + +[ + V{ + T{ ##peek f 1 D 0 } + T{ ##branch } + } +] [ 1 get instructions>> ] unit-test + +! But its ok to untag-fixnum the result of a peek if all usages use +! it as int-rep V{ T{ ##prologue } T{ ##branch } @@ -135,7 +180,9 @@ V{ V{ T{ ##add f 2 1 1 } + T{ ##mul f 3 1 1 } T{ ##replace f 2 D 0 } + T{ ##replace f 3 D 1 } T{ ##branch } } 3 test-bb @@ -187,6 +234,93 @@ V{ [ t ] [ 1 get instructions>> 4 swap nth ##scalar>integer? ] unit-test +! Test phi node behavior +V{ + T{ ##prologue } + T{ ##branch } +} 0 test-bb + +V{ + T{ ##load-integer f 1 1 } + T{ ##branch } +} 1 test-bb + +V{ + T{ ##load-integer f 2 2 } + T{ ##branch } +} 2 test-bb + +V{ + T{ ##phi f 3 } + T{ ##replace f 3 D 0 } + T{ ##branch } +} 3 test-bb + +V{ + T{ ##epilogue } + T{ ##return } +} 4 test-bb + +1 get 1 2array +2 get 2 2array 2array 3 get instructions>> first (>>inputs) + +0 { 1 2 } edges +1 3 edge +2 3 edge +3 4 edge + +[ ] [ test-representations ] unit-test + +[ T{ ##load-tagged f 1 $[ 1 tag-fixnum ] } ] +[ 1 get instructions>> first ] +unit-test + +[ T{ ##load-tagged f 2 $[ 2 tag-fixnum ] } ] +[ 2 get instructions>> first ] +unit-test + +! ##load-reference corner case +V{ + T{ ##prologue } + T{ ##branch } +} 0 test-bb + +V{ + T{ ##peek f 0 D 0 } + T{ ##peek f 1 D 1 } + T{ ##add f 2 0 1 } + T{ ##branch } +} 1 test-bb + +V{ + T{ ##load-reference f 3 f } + T{ ##branch } +} 2 test-bb + +V{ + T{ ##phi f 4 } + T{ ##replace f 4 D 0 } + T{ ##branch } +} 3 test-bb + +V{ + T{ ##epilogue } + T{ ##return } +} 4 test-bb + +1 get 2 2array +2 get 3 2array 2array 3 get instructions>> first (>>inputs) + +0 { 1 2 } edges +1 3 edge +2 3 edge +3 4 edge + +[ ] [ test-representations ] unit-test + +! Don't untag the f! +[ 2 ] [ 2 get instructions>> length ] unit-test + cpu x86.32? [ ! Make sure load-constant is converted into load-double @@ -223,7 +357,7 @@ cpu x86.32? [ V{ T{ ##peek f 1 D 0 } - T{ ##compare-imm-branch f 1 2 } + T{ ##compare-imm-branch f 1 2 cc= } } 1 test-bb V{ @@ -268,12 +402,25 @@ cpu x86.32? [ test-representations 0 get instructions>> ; -! Converting a ##load-integer into a ##load-tagged -V{ - T{ ##prologue } - T{ ##branch } -} 0 test-bb +! Don't convert the def site into anything but tagged-rep since +! we might lose precision +5 \ vreg-counter set-global +[ f ] [ + V{ + T{ ##peek f 0 D 0 } + T{ ##peek f 1 D 1 } + T{ ##tagged>integer f 2 1 } + T{ ##add-float f 3 0 0 } + T{ ##store-memory-imm f 3 2 0 float-rep f } + T{ ##store-memory-imm f 3 2 4 float-rep f } + T{ ##mul-float f 4 0 0 } + T{ ##replace f 4 D 0 } + } test-peephole + [ ##single>double-float? ] any? +] unit-test + +! Converting a ##load-integer into a ##load-tagged [ V{ T{ ##load-tagged f 1 $[ 100 tag-fixnum ] } diff --git a/basis/compiler/cfg/representations/representations.factor b/basis/compiler/cfg/representations/representations.factor index ea32da2527..100da7a53f 100644 --- a/basis/compiler/cfg/representations/representations.factor +++ b/basis/compiler/cfg/representations/representations.factor @@ -3,10 +3,12 @@ USING: accessors combinators namespaces compiler.cfg compiler.cfg.registers +compiler.cfg.predecessors compiler.cfg.loop-detection compiler.cfg.representations.rewrite compiler.cfg.representations.peephole -compiler.cfg.representations.selection ; +compiler.cfg.representations.selection +compiler.cfg.representations.coalescing ; IN: compiler.cfg.representations ! Virtual register representation selection. This is where @@ -16,12 +18,12 @@ IN: compiler.cfg.representations : select-representations ( cfg -- cfg' ) needs-loops + needs-predecessors { + [ compute-components ] [ compute-possibilities ] - [ compute-restrictions ] [ compute-representations ] - [ compute-phi-representations ] [ insert-conversions ] [ ] } cleave diff --git a/basis/compiler/cfg/representations/rewrite/rewrite.factor b/basis/compiler/cfg/representations/rewrite/rewrite.factor index 678417c8f7..b0da0d190a 100644 --- a/basis/compiler/cfg/representations/rewrite/rewrite.factor +++ b/basis/compiler/cfg/representations/rewrite/rewrite.factor @@ -85,6 +85,8 @@ GENERIC: conversions-for-insn ( insn -- ) M: ##phi conversions-for-insn , ; +M: ##copy conversions-for-insn , ; + M: insn conversions-for-insn , ; : conversions-for-block ( bb -- ) diff --git a/basis/compiler/cfg/representations/selection/selection.factor b/basis/compiler/cfg/representations/selection/selection.factor index bd0b8b1e2e..23e1f78766 100644 --- a/basis/compiler/cfg/representations/selection/selection.factor +++ b/basis/compiler/cfg/representations/selection/selection.factor @@ -1,37 +1,71 @@ ! Copyright (C) 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs compiler.cfg compiler.cfg.instructions -compiler.cfg.loop-detection compiler.cfg.registers -compiler.cfg.representations.preferred compiler.cfg.rpo -compiler.cfg.utilities compiler.utilities cpu.architecture -deques dlists fry kernel locals math namespaces sequences sets ; +USING: accessors arrays assocs byte-arrays combinators +disjoint-sets fry kernel locals math namespaces sequences sets +compiler.cfg +compiler.cfg.instructions +compiler.cfg.loop-detection +compiler.cfg.registers +compiler.cfg.representations.preferred +compiler.cfg.representations.coalescing +compiler.cfg.rpo +compiler.cfg.utilities +compiler.utilities +cpu.architecture ; FROM: namespaces => set ; IN: compiler.cfg.representations.selection -! For every vreg, compute possible representations. +SYMBOL: scc-infos + +TUPLE: scc-info reps all-uses-untagged? ; + +: ( -- reps ) + V{ } clone t \ scc-info boa ; + +: scc-info ( vreg -- info ) + vreg>scc scc-infos get [ drop ] cache ; + +: handle-def ( vreg rep -- ) + swap scc-info reps>> push ; + +: handle-use ( vreg rep -- ) + int-rep eq? [ scc-info f >>all-uses-untagged? ] unless drop ; + +GENERIC: collect-scc-info ( insn -- ) + +M: ##load-reference collect-scc-info + [ dst>> ] [ obj>> ] bi { + { [ dup float? ] [ drop { float-rep double-rep } ] } + { [ dup byte-array? ] [ drop vector-reps ] } + [ drop { } ] + } cond handle-def ; + +M: vreg-insn collect-scc-info + [ [ handle-use ] each-use-rep ] + [ [ 1array handle-def ] each-def-rep ] + [ [ 1array handle-def ] each-temp-rep ] + tri ; + +M: insn collect-scc-info drop ; + +: collect-scc-infos ( cfg -- ) + H{ } clone scc-infos set + [ [ collect-scc-info ] each-non-phi ] each-basic-block ; + SYMBOL: possibilities -: possible ( vreg -- reps ) possibilities get at ; +: permitted-reps ( scc-info -- seq ) + reps>> [ ] [ intersect ] map-reduce + tagged-rep over member-eq? [ tagged-rep suffix ] unless ; + +: scc-reps ( scc-info -- seq ) + dup permitted-reps + 2dup [ all-uses-untagged?>> ] [ { tagged-rep } = ] bi* and + [ 2drop { tagged-rep int-rep } ] [ nip ] if ; : compute-possibilities ( cfg -- ) - H{ } clone [ '[ swap _ adjoin-at ] with-vreg-reps ] keep - [ members ] assoc-map possibilities set ; - -! Compute vregs for which dereferencing cannot be hoisted past -! conditionals, because they might be immediate. -:: check-restriction ( vreg rep -- ) - rep tagged-rep eq? [ - vreg possibilities get - [ { tagged-rep int-rep } intersect ] change-at - ] when ; - -: compute-restrictions ( cfg -- ) - [ - [ - dup ##load-reference? - [ drop ] [ [ check-restriction ] each-def-rep ] if - ] each-non-phi - ] each-basic-block ; + collect-scc-infos + scc-infos get [ scc-reps ] assoc-map possibilities set ; ! For every vreg, compute the cost of keeping it in every possible ! representation. @@ -45,16 +79,20 @@ SYMBOL: costs : 10^ ( n -- x ) 10 product ; -: increase-cost ( rep vreg factor -- ) +: increase-cost ( rep scc factor -- ) ! Increase cost of keeping vreg in rep, making a choice of rep less ! likely. If the rep is not in the cost alist, it means this ! representation is prohibited. [ costs get at 2dup key? ] dip '[ [ current-loop-nesting 10^ _ * + ] change-at ] [ 2drop ] if ; +: possible-reps ( scc -- reps ) + possibilities get at ; + :: increase-costs ( vreg preferred factor -- ) - vreg possible [ - dup preferred eq? [ drop ] [ vreg factor increase-cost ] if + vreg vreg>scc :> scc + scc possible-reps [ + dup preferred eq? [ drop ] [ scc factor increase-cost ] if ] each ; inline UNION: inert-tag-untag-insn @@ -98,11 +136,7 @@ M: vreg-insn compute-insn-costs init-costs [ [ basic-block set ] - [ - [ - compute-insn-costs - ] each-non-phi - ] bi + [ [ compute-insn-costs ] each-non-phi ] bi ] each-basic-block ; ! For every vreg, compute preferred representation, that minimizes costs. @@ -111,52 +145,7 @@ M: vreg-insn compute-insn-costs [ >alist alist-min first ] assoc-map ; : compute-representations ( cfg -- ) - compute-costs costs get minimize-costs representations set ; - -! PHI nodes require special treatment -! If the output of a phi instruction is only used as the input to another -! phi instruction, then we want to use the same representation for both -! if possible. -SYMBOL: phis - -: collect-phis ( cfg -- ) - H{ } clone phis set - [ - phis get - '[ [ inputs>> values ] [ dst>> ] bi _ set-at ] each-phi - ] each-basic-block ; - -SYMBOL: work-list - -: add-to-work-list ( vregs -- ) - work-list get push-all-front ; - -: rep-assigned ( vregs -- vregs' ) - representations get '[ _ key? ] filter ; - -: rep-not-assigned ( vregs -- vregs' ) - representations get '[ _ key? not ] filter ; - -: add-ready-phis ( -- ) - phis get keys rep-assigned add-to-work-list ; - -: process-phi ( dst -- ) - ! If dst = phi(src1,src2,...) and dst's representation has been - ! determined, assign that representation to each one of src1,... - ! that does not have a representation yet, and process those, too. - dup phis get at* [ - [ rep-of ] [ rep-not-assigned ] bi* - [ [ set-rep-of ] with each ] [ add-to-work-list ] bi - ] [ 2drop ] if ; - -: remaining-phis ( -- ) - phis get keys rep-not-assigned { } assert-sequence= ; - -: process-phis ( -- ) - work-list set - add-ready-phis - work-list get [ process-phi ] slurp-deque - remaining-phis ; - -: compute-phi-representations ( cfg -- ) - collect-phis process-phis ; + compute-costs costs get minimize-costs + [ components get [ disjoint-set-members ] keep ] dip + '[ dup _ representative _ at ] H{ } map>assoc + representations set ; diff --git a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor index 0c9d386544..0b1b8ab0fe 100644 --- a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor +++ b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor @@ -2302,11 +2302,14 @@ V{ } 3 test-bb V{ - T{ ##phi f 3 H{ { 2 1 } { 3 2 } } } + T{ ##phi f 3 } T{ ##replace f 3 D 0 } T{ ##return } } 4 test-bb +2 get 1 2array +3 get 2 2array 2array 4 get instructions>> first (>>inputs) + test-diamond [ ] [ diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 855e272f02..a77337d1a0 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -87,6 +87,20 @@ UNION: vector-rep int-vector-rep float-vector-rep ; +CONSTANT: vector-reps + { + char-16-rep + uchar-16-rep + short-8-rep + ushort-8-rep + int-4-rep + uint-4-rep + longlong-2-rep + ulonglong-2-rep + float-4-rep + double-2-rep + } + UNION: representation any-rep tagged-rep diff --git a/basis/disjoint-sets/disjoint-sets.factor b/basis/disjoint-sets/disjoint-sets.factor index 05df13f073..a158302ecc 100644 --- a/basis/disjoint-sets/disjoint-sets.factor +++ b/basis/disjoint-sets/disjoint-sets.factor @@ -74,6 +74,10 @@ GENERIC: disjoint-set-member? ( a disjoint-set -- ? ) M: disjoint-set disjoint-set-member? parents>> key? ; +GENERIC: disjoint-set-members ( disjoint-set -- seq ) + +M: disjoint-set disjoint-set-members parents>> keys ; + GENERIC: equiv-set-size ( a disjoint-set -- n ) M: disjoint-set equiv-set-size [ representative ] keep count ;