ghc /compiler/nativeGen/RegAlloc/Graph/Coalesce.hs

Language Haskell Lines 96
MD5 Hash 0b9694a632de17e25e1836f36b39b8b5 Estimated Cost $1,334 (why?)
Repository https://bitbucket.org/carter/ghc.git View Raw File View Project SPDX
 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
94
95
-- | Register coalescing.
--

{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details

module RegAlloc.Graph.Coalesce (
	regCoalesce,
	slurpJoinMovs
)

where

import RegAlloc.Liveness
import Instruction
import Reg

import OldCmm
import Bag
import Digraph
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
	=> [LiveCmmDecl statics instr] 
	-> UniqSM [LiveCmmDecl statics 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
	=> LiveCmmDecl statics instr 
	-> Bag (Reg, Reg)

slurpJoinMovs live
	= slurpCmm emptyBag live
 where	
  	slurpCmm   rs  CmmData{}		    = rs
	slurpCmm   rs (CmmProc _ _ sccs) 	= foldl' slurpBlock rs (flattenSCCs sccs)
	slurpBlock rs (BasicBlock _ instrs)	= foldl' slurpLI    rs instrs
                
	slurpLI    rs (LiveInstr _	Nothing)    = rs
	slurpLI    rs (LiveInstr 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
		
	
Back to Top