1 USING: accessors arrays assocs compiler.cfg.def-use
2 compiler.cfg.instructions compiler.cfg.linearization
3 compiler.cfg.registers compiler.cfg.ssa.destruction.leaders
4 compiler.cfg.ssa.interference cpu.architecture fry kernel make
5 namespaces sequences sets sorting ;
6 IN: compiler.cfg.ssa.destruction.coalescing
8 : zip-scalar ( scalar seq -- pairs )
11 SYMBOL: class-element-map
13 : value-of ( vreg -- value )
14 dup insn-of dup ##tagged>integer? [ nip src>> ] [ drop ] if ;
16 : coalesce-elements ( merged follower leader -- )
17 class-element-map get [ delete-at ] [ set-at ] bi-curry bi* ;
19 : coalesce-vregs ( merged follower leader -- )
20 2dup swap leader-map get set-at coalesce-elements ;
22 : vregs-interfere? ( vreg1 vreg2 -- merged/f ? )
23 class-element-map get '[ _ at ] bi@ sets-interfere? ;
25 ERROR: vregs-shouldn't-interfere vreg1 vreg2 ;
27 : try-eliminate-copy ( follower leader must? -- )
28 -rot leaders 2dup = [ 3drop ] [
29 2dup vregs-interfere? [
30 drop rot [ throw-vregs-shouldn't-interfere ] [ 2drop ] if
31 ] [ -rot coalesce-vregs drop ] if
34 : try-eliminate-copies ( pairs must? -- )
35 '[ first2 _ try-eliminate-copy ] each ;
37 : initial-leaders ( insns -- leaders )
38 [ [ defs-vregs ] [ temp-vregs ] bi append ] map concat unique ;
40 : initial-class-elements ( -- class-elements )
41 defs get [ [ dup dup value-of ] dip <vreg-info> 1array ] assoc-map ;
43 : init-coalescing ( insns -- )
44 initial-leaders leader-map set
45 initial-class-elements class-element-map set ;
47 GENERIC: coalesce-now ( insn -- )
49 M: insn coalesce-now drop ;
51 M: ##tagged>integer coalesce-now
52 [ dst>> ] [ src>> ] bi t try-eliminate-copy ;
55 [ dst>> ] [ inputs>> values ] bi zip-scalar
56 natural-sort t try-eliminate-copies ;
58 GENERIC: coalesce-later ( insn -- )
60 M: insn coalesce-later drop ;
62 M: alien-call-insn coalesce-later drop ;
64 M: vreg-insn coalesce-later
65 [ defs-vregs ] [ uses-vregs ] bi zip ?first [ , ] when* ;
67 M: ##copy coalesce-later
68 [ dst>> ] [ src>> ] bi 2array , ;
70 M: ##parallel-copy coalesce-later
73 : eliminatable-copy? ( vreg1 vreg2 -- ? )
74 [ rep-of ] bi@ [ [ reg-class-of ] same? ] [ [ rep-size ] same? ] 2bi and ;
76 : coalesce-cfg ( cfg -- )
77 cfg>insns-rpo dup init-coalescing
78 [ [ [ coalesce-now ] [ coalesce-later ] bi ] each ] { } make
79 [ first2 eliminatable-copy? ] filter f try-eliminate-copies ;