diff --git a/basis/compiler/cfg/branch-splitting/authors.txt b/basis/compiler/cfg/branch-splitting/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/compiler/cfg/branch-splitting/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ 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 new file mode 100644 index 0000000000..2b3d88191c --- /dev/null +++ b/basis/compiler/cfg/branch-splitting/branch-splitting.factor @@ -0,0 +1,29 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors combinators.short-circuit compiler.cfg.def-use +compiler.cfg.rpo kernel math sequences ; +IN: compiler.cfg.branch-splitting + +: split-branch ( branch -- ) + [ + [ instructions>> ] [ predecessors>> ] bi [ + instructions>> [ pop* ] [ push-all ] bi + ] with each + ] [ + [ successors>> ] [ predecessors>> ] bi [ + [ drop clone ] change-successors drop + ] with each + ] bi ; + +: split-branches? ( bb -- ? ) + { + [ predecessors>> length 1 >= ] + [ successors>> length 1 <= ] + [ instructions>> [ defs-vregs ] any? not ] + [ instructions>> [ temp-vregs ] any? not ] + } 1&& ; + +: split-branches ( cfg -- cfg' ) + dup [ + dup split-branches? [ split-branch ] [ drop ] if + ] each-basic-block f >>post-order ; diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index 5b3e1af930..4ce9c59e7e 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -248,4 +248,4 @@ INSN: _reload dst class n ; INSN: _copy dst src class ; INSN: _spill-counts counts ; -SYMBOL: temp-spill +SYMBOL: spill-temp diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor b/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor index 7579b46175..feb9ac2504 100644 --- a/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor +++ b/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor @@ -68,12 +68,12 @@ T{ live-interval [ { T{ _copy { dst 5 } { src 4 } { class int-regs } } - T{ _spill { src 0 } { class int-regs } { n 6 } } - T{ _copy { dst 0 } { src 1 } { class int-regs } } - T{ _reload { dst 1 } { class int-regs } { n 6 } } - T{ _spill { src 0 } { class float-regs } { n 7 } } - T{ _copy { dst 0 } { src 1 } { class float-regs } } - T{ _reload { dst 1 } { class float-regs } { n 7 } } + T{ _spill { src 1 } { class int-regs } { n spill-temp } } + T{ _copy { dst 1 } { src 0 } { class int-regs } } + T{ _reload { dst 0 } { class int-regs } { n spill-temp } } + T{ _spill { src 1 } { class float-regs } { n spill-temp } } + T{ _copy { dst 1 } { src 0 } { class float-regs } } + T{ _reload { dst 0 } { class float-regs } { n spill-temp } } } ] [ { @@ -87,10 +87,10 @@ T{ live-interval [ { - T{ _spill { src 0 } { class int-regs } { n 3 } } - T{ _copy { dst 0 } { src 2 } { class int-regs } } + T{ _spill { src 2 } { class int-regs } { n spill-temp } } T{ _copy { dst 2 } { src 1 } { class int-regs } } - T{ _reload { dst 1 } { class int-regs } { n 3 } } + T{ _copy { dst 1 } { src 0 } { class int-regs } } + T{ _reload { dst 0 } { class int-regs } { n spill-temp } } } ] [ { @@ -102,10 +102,10 @@ T{ live-interval [ { - T{ _spill { src 0 } { class int-regs } { n 3 } } + T{ _spill { src 0 } { class int-regs } { n spill-temp } } T{ _copy { dst 0 } { src 2 } { class int-regs } } T{ _copy { dst 2 } { src 1 } { class int-regs } } - T{ _reload { dst 1 } { class int-regs } { n 3 } } + T{ _reload { dst 1 } { class int-regs } { n spill-temp } } } ] [ { @@ -136,7 +136,7 @@ T{ live-interval ] unit-test [ - { T{ _spill { src 4 } { class int-regs } { n 4 } } } + { T{ _spill { src 4 } { class int-regs } { n spill-temp } } } ] [ { T{ register->memory { from 4 } { to 4 } { reg-class int-regs } } @@ -162,10 +162,10 @@ T{ live-interval { T{ _copy { dst 1 } { src 0 } { class int-regs } } T{ _copy { dst 2 } { src 0 } { class int-regs } } - T{ _spill { src 3 } { class int-regs } { n 5 } } + T{ _spill { src 4 } { class int-regs } { n spill-temp } } T{ _copy { dst 4 } { src 0 } { class int-regs } } - T{ _copy { dst 3 } { src 4 } { class int-regs } } - T{ _reload { dst 0 } { class int-regs } { n 5 } } + T{ _copy { dst 0 } { src 3 } { class int-regs } } + T{ _reload { dst 3 } { class int-regs } { n spill-temp } } } ] [ { @@ -182,10 +182,10 @@ T{ live-interval T{ _copy { dst 2 } { src 0 } { class int-regs } } T{ _copy { dst 9 } { src 1 } { class int-regs } } T{ _copy { dst 1 } { src 0 } { class int-regs } } - T{ _spill { src 3 } { class int-regs } { n 10 } } + T{ _spill { src 4 } { class int-regs } { n spill-temp } } T{ _copy { dst 4 } { src 0 } { class int-regs } } - T{ _copy { dst 3 } { src 4 } { class int-regs } } - T{ _reload { dst 0 } { class int-regs } { n 10 } } + T{ _copy { dst 0 } { src 3 } { class int-regs } } + T{ _reload { dst 3 } { class int-regs } { n spill-temp } } } ] [ { diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve.factor b/basis/compiler/cfg/linear-scan/resolve/resolve.factor index 182686a0fa..bd7528291d 100644 --- a/basis/compiler/cfg/linear-scan/resolve/resolve.factor +++ b/basis/compiler/cfg/linear-scan/resolve/resolve.factor @@ -68,10 +68,10 @@ M: memory->memory >insn [ from>> ] [ to>> ] bi = [ "Not allowed" throw ] unless ; M: register->memory >insn - [ from>> ] [ reg-class>> ] [ to>> ] tri _spill ; + [ from>> ] [ reg-class>> ] bi spill-temp _spill ; M: memory->register >insn - [ to>> ] [ reg-class>> ] [ from>> ] tri _reload ; + [ to>> ] [ reg-class>> ] bi spill-temp _reload ; M: register->register >insn [ to>> ] [ from>> ] [ reg-class>> ] tri _copy ; @@ -82,10 +82,10 @@ M: memory->memory >collision-table [ from>> ] [ to>> ] bi = [ "Not allowed" throw ] unless ; M: register->memory >collision-table - [ from>> ] [ reg-class>> ] [ to>> ] tri _spill ; + [ from>> ] [ reg-class>> ] bi spill-temp _spill ; M: memory->register >collision-table - [ to>> ] [ reg-class>> ] [ from>> ] tri _reload ; + [ to>> ] [ reg-class>> ] bi spill-temp _reload ; M: register->register >collision-table [ to>> ] [ from>> ] [ reg-class>> ] tri _copy ; @@ -119,10 +119,6 @@ M: register->register to-loc drop register ; : independent-assignment? ( operations -- pair ) to-reg froms get key? not ; -: init-temp-spill ( operations -- ) - [ [ to>> ] [ from>> ] bi max ] [ max ] map-reduce - 1 + temp-spill set ; - : set-tos/froms ( operations -- ) [ [ [ from-reg ] keep ] H{ } map>assoc froms set ] [ [ [ to-reg ] keep ] H{ } map>assoc tos set ] @@ -130,26 +126,40 @@ M: register->register to-loc drop register ; :: (trace-chain) ( obj hashtable -- ) obj to-reg froms get at* [ + dup , obj over hashtable clone [ maybe-set-at ] keep swap - [ (trace-chain) ] [ , drop ] if + [ (trace-chain) ] [ 2drop ] if ] [ - drop hashtable , + drop ] if ; : trace-chain ( obj -- seq ) [ + dup , dup dup associate (trace-chain) - ] { } make [ keys ] map concat reverse ; + ] { } make prune reverse ; + : trace-chains ( seq -- seq' ) [ trace-chain ] map concat ; -: break-cycle-n ( operations -- operations' ) +ERROR: resolve-error ; + +: split-cycle ( operations -- chain spilled-operation ) unclip [ - [ from>> temp-spill get ] + [ set-tos/froms ] + [ + [ start? ] find nip + [ resolve-error ] unless* trace-chain + ] bi + ] dip ; + +: break-cycle-n ( operations -- operations' ) + split-cycle [ + [ from>> spill-temp ] [ reg-class>> ] bi \ register->memory boa ] [ - [ to>> temp-spill [ get ] [ inc ] bi swap ] + [ to>> spill-temp swap ] [ reg-class>> ] bi \ memory->register boa ] bi [ 1array ] bi@ surround ; @@ -182,9 +192,7 @@ M: register->register to-loc drop register ; : mapping-instructions ( mappings -- insns ) [ - [ init-temp-spill ] - [ set-tos/froms ] - [ parallel-mappings ] tri + [ set-tos/froms ] [ parallel-mappings ] bi [ [ >insn ] each ] { } make ] with-scope ;