1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
-- | Register coalescing.
--
module RegAlloc.Graph.Coalesce (
regCoalesce,
slurpJoinMovs
)
where
import RegAlloc.Liveness
import Instruction
import Reg
import Cmm
import Bag
import UniqFM
import UniqSet
import UniqSupply
import Data.List
-- | Do register coalescing on this top level thing
-- For Reg -> Reg moves, if the first reg dies at the same time the second reg is born
-- then the mov only serves to join live ranges. The two regs can be renamed to be
-- the same and the move instruction safely erased.
regCoalesce
:: Instruction instr
=> [LiveCmmTop instr]
-> UniqSM [LiveCmmTop instr]
regCoalesce code
= do
let joins = foldl' unionBags emptyBag
$ map slurpJoinMovs code
let alloc = foldl' buildAlloc emptyUFM
$ bagToList joins
let patched = map (patchEraseLive (sinkReg alloc)) code
return patched
buildAlloc :: UniqFM Reg -> (Reg, Reg) -> UniqFM Reg
buildAlloc fm (r1, r2)
= let rmin = min r1 r2
rmax = max r1 r2
in addToUFM fm rmax rmin
sinkReg :: UniqFM Reg -> Reg -> Reg
sinkReg fm r
= case lookupUFM fm r of
Nothing -> r
Just r' -> sinkReg fm r'
-- | Slurp out mov instructions that only serve to join live ranges.
-- During a mov, if the source reg dies and the destiation reg is born
-- then we can rename the two regs to the same thing and eliminate the move.
--
slurpJoinMovs
:: Instruction instr
=> LiveCmmTop instr
-> Bag (Reg, Reg)
slurpJoinMovs live
= slurpCmm emptyBag live
where
slurpCmm rs CmmData{} = rs
slurpCmm rs (CmmProc _ _ _ (ListGraph blocks)) = foldl' slurpComp rs blocks
slurpComp rs (BasicBlock _ blocks) = foldl' slurpBlock rs blocks
slurpBlock rs (BasicBlock _ instrs) = foldl' slurpLI rs instrs
slurpLI rs (Instr _ Nothing) = rs
slurpLI rs (Instr instr (Just live))
| Just (r1, r2) <- takeRegRegMoveInstr instr
, elementOfUniqSet r1 $ liveDieRead live
, elementOfUniqSet r2 $ liveBorn live
-- only coalesce movs between two virtuals for now, else we end up with
-- allocatable regs in the live regs list..
, isVirtualReg r1 && isVirtualReg r2
= consBag (r1, r2) rs
| otherwise
= rs
slurpLI rs SPILL{} = rs
slurpLI rs RELOAD{} = rs
|
