: number-blocks ( bbs -- )
H{ } zip-index-as numbers set ;
+: blocks>insns ( bbs -- insns )
+ [ instructions>> ] map concat ;
+
: cfg>insns ( cfg -- insns )
- linearization-order [ instructions>> ] map concat ;
+ linearization-order blocks>insns ;
+
+: cfg>insns-rpo ( cfg -- insns )
+ reverse-post-order blocks>insns ;
--- /dev/null
+USING: compiler.cfg.instructions compiler.cfg.ssa.interference
+help.markup help.syntax kernel make sequences ;
+IN: compiler.cfg.ssa.destruction.coalescing
+
+HELP: class-element-map
+{ $var-description "Maps leaders to equivalence class elements which are sequences of " { $link vreg-info } " instances." } ;
+
+HELP: coalesce-elements
+{ $values { "merged" "??" } { "follower" "vreg" } { "leader" "vreg" } }
+{ $description "Delete follower's class, and set leaders's class to merged." } ;
+
+HELP: coalesce-insn
+{ $values { "insn" insn } }
+{ $description "Generic word supposed to be called in a " { $link make } " context which generates a list of eliminatable vreg copies. The word either eliminates copies immediately in case of " { $link ##phi } " and " { $link ##tagged>integer } " instructions or appends copies to the make sequence so that they are handled later by " { $link coalesce-cfg } "." } ;
+
+HELP: coalesce-vregs
+{ $values { "merged" "??" } { "follower" "vreg" } { "leader" "vreg" } }
+{ $description "Sets 'leader' as the leader of 'follower'." } ;
+
+HELP: try-eliminate-copy
+{ $values { "follower" "vreg" } { "leader" "vreg" } { "must?" boolean } }
+{ $description "Tries to eliminate a vreg copy from 'leader' to 'follower'. If 'must?' is " { $link t } " then a " { $link vregs-shouldn't-interfere } " error is thrown if the vregs interfere." }
+{ $see-also try-eliminate-copies vregs-interfere? } ;
+
+HELP: try-eliminate-copies
+{ $values { "pairs" "a sequence of vreg pairs" } { "must?" boolean } }
+{ $description "Tries to eliminate the vreg copies in the " { $link sequence } " 'pairs'. If 'must?' is " { $link t } " then a " { $link vregs-shouldn't-interfere } " error is thrown if any of the vregs interfere." }
+{ $see-also try-eliminate-copy } ;
+
+ARTICLE: "compiler.cfg.ssa.destruction.coalescing" "Vreg Coalescing"
+"This compiler pass eliminates redundant vreg copies."
+$nl
+"Main entry point:"
+{ $subsections coalesce-cfg }
+"Vreg copy elimination:"
+{ $subsections
+ try-eliminate-copies
+ try-eliminate-copy
+} ;
--- /dev/null
+USING: assocs compiler.cfg.def-use compiler.cfg.instructions
+compiler.cfg.ssa.destruction.coalescing compiler.cfg.ssa.destruction.leaders
+cpu.architecture grouping kernel make namespaces random sequences tools.test ;
+QUALIFIED: sets
+IN: compiler.cfg.ssa.destruction.coalescing.tests
+
+! init-coalescing
+{
+ H{ { 123 123 } { 77 77 } }
+} [
+ H{ { 123 "bb1" } { 77 "bb2" } } defs set
+ init-coalescing
+ leader-map get
+] unit-test
+
+! try-eliminate-copy
+{ } [
+ 10 10 f try-eliminate-copy
+] unit-test
+
+! coalesce-insn
+{ V{ { 2 1 } } } [
+ [
+ T{ ##copy { src 1 } { dst 2 } { rep int-rep } } coalesce-insn
+ ] V{ } make
+] unit-test
+
+{ V{ { 3 4 } { 7 8 } } } [
+ [
+ T{ ##parallel-copy { values V{ { 3 4 } { 7 8 } } } } coalesce-insn
+ ] V{ } make
+] unit-test
+
+! All this work to make the 'values' order non-deterministic.
+: make-phi-inputs ( -- assoc )
+ H{ } clone [
+ { 2287 2288 } [
+ 10 iota 1 sample first rot set-at
+ ] with each
+ ] keep ;
+
+{ t } [
+ 10 [
+ { 2286 2287 2288 } sets:unique leader-map set
+ 2286 make-phi-inputs ##phi new-insn
+ coalesce-insn
+ 2286 leader
+ ] replicate all-equal?
+] unit-test
--- /dev/null
+USING: accessors arrays assocs compiler.cfg.def-use
+compiler.cfg.instructions compiler.cfg.linearization
+compiler.cfg.registers compiler.cfg.ssa.destruction.leaders
+compiler.cfg.ssa.interference cpu.architecture fry kernel make
+namespaces sequences sets sorting ;
+FROM: namespaces => set ;
+IN: compiler.cfg.ssa.destruction.coalescing
+
+: zip-scalar ( scalar seq -- pairs )
+ [ 2array ] with map ;
+
+SYMBOL: class-element-map
+
+: value-of ( vreg -- value )
+ dup insn-of dup ##tagged>integer? [ nip src>> ] [ drop ] if ;
+
+: init-coalescing ( -- )
+ defs get
+ [ keys unique leader-map set ]
+ [
+ [ [ dup dup value-of ] dip <vreg-info> 1array ] assoc-map
+ class-element-map set
+ ] bi ;
+
+: coalesce-elements ( merged follower leader -- )
+ class-element-map get [ delete-at ] [ set-at ] bi-curry bi* ;
+
+: coalesce-vregs ( merged follower leader -- )
+ 2dup swap leader-map get set-at coalesce-elements ;
+
+: vregs-interfere? ( vreg1 vreg2 -- merged/f ? )
+ [ class-element-map get at ] bi@ sets-interfere? ;
+
+ERROR: vregs-shouldn't-interfere vreg1 vreg2 ;
+
+: try-eliminate-copy ( follower leader must? -- )
+ -rot leaders 2dup = [ 3drop ] [
+ 2dup vregs-interfere? [
+ drop rot [ vregs-shouldn't-interfere ] [ 2drop ] if
+ ] [ -rot coalesce-vregs drop ] if
+ ] if ;
+
+: try-eliminate-copies ( pairs must? -- )
+ '[ first2 _ try-eliminate-copy ] each ;
+
+GENERIC: coalesce-insn ( insn -- )
+
+M: insn coalesce-insn drop ;
+
+M: alien-call-insn coalesce-insn drop ;
+
+M: vreg-insn coalesce-insn
+ [ temp-vregs [ leader-map get conjoin ] each ]
+ [
+ [ defs-vregs ] [ uses-vregs ] bi
+ 2dup [ empty? not ] both? [
+ [ first ] bi@
+ 2dup [ rep-of reg-class-of ] bi@ eq?
+ [ 2array , ] [ 2drop ] if
+ ] [ 2drop ] if
+ ] bi ;
+
+M: ##copy coalesce-insn
+ [ dst>> ] [ src>> ] bi 2array , ;
+
+M: ##parallel-copy coalesce-insn
+ values>> % ;
+
+M: ##tagged>integer coalesce-insn
+ [ dst>> ] [ src>> ] bi t try-eliminate-copy ;
+
+M: ##phi coalesce-insn
+ [ dst>> ] [ inputs>> values ] bi zip-scalar
+ natural-sort t try-eliminate-copies ;
+
+: coalesce-cfg ( cfg -- )
+ init-coalescing
+ cfg>insns-rpo [ [ coalesce-insn ] each ] V{ } make
+ f try-eliminate-copies ;
compiler.cfg.ssa.interference help.markup help.syntax kernel sequences ;
IN: compiler.cfg.ssa.destruction
-HELP: class-element-map
-{ $var-description "Maps leaders to equivalence class elements which are sequences of " { $link vreg-info } " instances." } ;
-
HELP: cleanup-cfg
{ $values { "cfg" cfg } }
{ $description "In this step, " { $link ##parallel-copy } " instructions are substituted with more concreete " { $link ##copy } " instructions. " { $link ##phi } " instructions are removed here." } ;
-HELP: coalesce-elements
-{ $values { "merged" "??" } { "follower" "vreg" } { "leader" "vreg" } }
-{ $description "Delete follower's class, and set leaders's class to merged." } ;
-
-HELP: coalesce-vregs
-{ $values { "merged" "??" } { "follower" "vreg" } { "leader" "vreg" } }
-{ $description "Sets 'leader' as the leader of 'follower'." } ;
-
-HELP: copies
-{ $var-description "Sequence of copies (tuples of { vreg-dst vreg-src}) that maybe can be eliminated later." }
-{ $see-also init-coalescing } ;
-
-HELP: try-eliminate-copy
-{ $values { "follower" "vreg" } { "leader" "vreg" } { "must?" boolean } }
-{ $description "Tries to eliminate a vreg copy from 'leader' to 'follower'. If 'must?' is " { $link t } " then a " { $link vregs-shouldn't-interfere } " error is thrown if the vregs interfere." }
-{ $see-also try-eliminate-copies vregs-interfere? } ;
-
-HELP: try-eliminate-copies
-{ $values { "pairs" "a sequence of vreg pairs" } { "must?" boolean } }
-{ $description "Tries to eliminate the vreg copies in the " { $link sequence } " 'pairs'. If 'must?' is " { $link t } " then a " { $link vregs-shouldn't-interfere } " error is thrown if any of the vregs interfere." }
-{ $see-also try-eliminate-copy } ;
-
ARTICLE: "compiler.cfg.ssa.destruction" "SSA Destruction"
"Because of the design of the register allocator, this pass has three peculiar properties."
{ $list
}
$nl
"Main entry point:"
-{ $subsections destruct-ssa }
-"Vreg copy elimination:"
-{ $subsections
- perform-coalescing
- try-eliminate-copies
- try-eliminate-copy
-} ;
+{ $subsections destruct-ssa } ;
ABOUT: "compiler.cfg.ssa.destruction"
-USING: alien.syntax assocs compiler.cfg.def-use
-compiler.cfg.instructions compiler.cfg.registers
+USING: alien.syntax compiler.cfg.instructions compiler.cfg.registers
compiler.cfg.ssa.destruction compiler.cfg.ssa.destruction.leaders
compiler.cfg.ssa.destruction.private compiler.cfg.utilities
-cpu.architecture cpu.x86.assembler.operands grouping kernel make math
-math.functions math.order math.ranges namespaces random sequences
-tools.test ;
-QUALIFIED: sets
+cpu.architecture cpu.x86.assembler.operands kernel make namespaces
+sequences tools.test ;
IN: compiler.cfg.ssa.destruction.tests
! cleanup-insn
[ cleanup-insn ] V{ } make
] unit-test
-! init-coalescing
-{
- H{ { 123 123 } { 77 77 } }
-} [
- H{ { 123 "bb1" } { 77 "bb2" } } defs set
- init-coalescing
- leader-map get
-] unit-test
-
! destruct-ssa
{ } [
H{ { 36 23 } { 23 23 } } leader-map set
}
} 0 insns>block block>cfg destruct-ssa
] unit-test
-
-! try-eliminate-copy
-{ } [
- 10 10 f try-eliminate-copy
-] unit-test
-
-! prepare-insn
-{ V{ { 2 1 } } } [
- V{ } clone copies set
- T{ ##copy { src 1 } { dst 2 } { rep int-rep } } prepare-insn
- copies get
-] unit-test
-
-{ V{ { 3 4 } { 7 8 } } } [
- V{ } clone copies set
- T{ ##parallel-copy { values V{ { 3 4 } { 7 8 } } } } prepare-insn
- copies get
-] unit-test
-
-! All this work to make the 'values' order non-deterministic.
-: make-phi-inputs ( -- assoc )
- H{ } clone [
- { 2287 2288 } [
- 10 iota 1 sample first rot set-at
- ] with each
- ] keep ;
-
-{ t } [
- 10 [
- { 2286 2287 2288 } sets:unique leader-map set
- 2286 make-phi-inputs ##phi new-insn
- prepare-insn
- 2286 leader
- ] replicate all-equal?
-] unit-test
-
-! Test is just to ensure the my-euler word compiles. See #1345
-: my-euler-step ( min m n -- min' )
- dup sqrt 1 mod [ - min ] [ 2drop ] if ; inline
-
-: my-euler ( -- answer )
- 33 2500 [1,b] [ dup [1,b] [ my-euler-step ] with each ] each ;
! Copyright (C) 2009, 2011 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs combinators compiler.cfg.def-use
-compiler.cfg.dominance compiler.cfg.instructions
-compiler.cfg.liveness compiler.cfg.parallel-copy
-compiler.cfg.registers compiler.cfg.rpo compiler.cfg.ssa.cssa
-compiler.cfg.ssa.destruction.leaders
-compiler.cfg.ssa.interference
+USING: accessors assocs compiler.cfg.def-use compiler.cfg.dominance
+compiler.cfg.instructions compiler.cfg.liveness
+compiler.cfg.parallel-copy compiler.cfg.rpo compiler.cfg.ssa.cssa
+compiler.cfg.ssa.destruction.coalescing compiler.cfg.ssa.destruction.leaders
compiler.cfg.ssa.interference.live-ranges compiler.cfg.utilities
-cpu.architecture fry kernel make namespaces sequences sets sorting ;
+kernel make sequences ;
FROM: namespaces => set ;
IN: compiler.cfg.ssa.destruction
-SYMBOL: class-element-map
-
<PRIVATE
-SYMBOL: copies
-
-: value-of ( vreg -- value )
- dup insn-of dup ##tagged>integer? [ nip src>> ] [ drop ] if ;
-
-: init-coalescing ( -- )
- defs get
- [ keys unique leader-map set ]
- [
- [ [ dup dup value-of ] dip <vreg-info> 1array ] assoc-map
- class-element-map set
- ] bi
- V{ } clone copies set ;
-
-: coalesce-elements ( merged follower leader -- )
- class-element-map get [ delete-at ] [ set-at ] bi-curry bi* ;
-
-: coalesce-vregs ( merged follower leader -- )
- 2dup swap leader-map get set-at coalesce-elements ;
-
-GENERIC: prepare-insn ( insn -- )
-
-M: insn prepare-insn drop ;
-
-M: alien-call-insn prepare-insn drop ;
-
-M: vreg-insn prepare-insn
- [ temp-vregs [ leader-map get conjoin ] each ]
- [
- [ defs-vregs ] [ uses-vregs ] bi
- 2dup [ empty? not ] both? [
- [ first ] bi@
- 2dup [ rep-of reg-class-of ] bi@ eq?
- [ 2array copies get push ] [ 2drop ] if
- ] [ 2drop ] if
- ] bi ;
-
-M: ##copy prepare-insn
- [ dst>> ] [ src>> ] bi 2array copies get push ;
-
-M: ##parallel-copy prepare-insn
- values>> copies get push-all ;
-
-: leaders ( vreg1 vreg2 -- vreg1' vreg2' )
- [ leader ] bi@ ;
-
-: vregs-interfere? ( vreg1 vreg2 -- merged/f ? )
- [ class-element-map get at ] bi@ sets-interfere? ;
-
-ERROR: vregs-shouldn't-interfere vreg1 vreg2 ;
-
-: try-eliminate-copy ( follower leader must? -- )
- -rot leaders 2dup = [ 3drop ] [
- 2dup vregs-interfere? [
- drop rot [ vregs-shouldn't-interfere ] [ 2drop ] if
- ] [ -rot coalesce-vregs drop ] if
- ] if ;
-
-: try-eliminate-copies ( pairs must? -- )
- '[ first2 _ try-eliminate-copy ] each ;
-
-M: ##tagged>integer prepare-insn
- [ dst>> ] [ src>> ] bi t try-eliminate-copy ;
-
-: zip-scalar ( scalar seq -- pairs )
- [ 2array ] with map ;
-
-M: ##phi prepare-insn
- [ dst>> ] [ inputs>> values ] bi zip-scalar
- natural-sort t try-eliminate-copies ;
-
-: prepare-coalescing ( cfg -- )
- init-coalescing [ [ prepare-insn ] each ] simple-analysis ;
-
-: perform-coalescing ( cfg -- )
- prepare-coalescing copies get f try-eliminate-copies ;
-
GENERIC: cleanup-insn ( insn -- )
: useful-copy? ( insn -- ? )
compute-insns
compute-live-sets
compute-live-ranges
- perform-coalescing
+ coalesce-cfg
cleanup-cfg
compute-live-sets
} apply-passes ;
-USING: compiler.cfg.ssa.destruction.private help.markup help.syntax math ;
+USING: compiler.cfg.ssa.destruction.coalescing help.markup help.syntax math ;
IN: compiler.cfg.ssa.destruction.leaders
HELP: ?leader
HELP: leader-map
{ $var-description "A map from vregs to canonical representatives due to coalescing done by SSA destruction. Used by liveness analysis and the register allocator, so we can use the original SSA names to get certain info (reaching definitions, representations). By default, each vreg is its own leader." }
-{ $see-also init-coalescing perform-coalescing } ;
+{ $see-also init-coalescing } ;
ARTICLE: "compiler.cfg.ssa.destruction.leaders" "Leader book-keeping" "This vocab defines words for getting the leaders of vregs." ;
: leader ( vreg -- vreg' ) leader-map get compress-path ;
: ?leader ( vreg -- vreg' ) [ leader ] keep or ; inline
+
+: leaders ( vreg1 vreg2 -- vreg1' vreg2' )
+ [ leader ] bi@ ;
projects / factor.git / commitdiff