projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Refactor cmmNativeGen so dumps can be emitted inline with NCG stages
[ghc-hetmet.git]
/
compiler
/
nativeGen
/
RegAllocColor.hs
diff --git
a/compiler/nativeGen/RegAllocColor.hs
b/compiler/nativeGen/RegAllocColor.hs
index
40e3bc3
..
5ce2a6c
100644
(file)
--- a/
compiler/nativeGen/RegAllocColor.hs
+++ b/
compiler/nativeGen/RegAllocColor.hs
@@
-63,7
+63,7
@@
regAlloc regsFree slotsFree code
<- regAlloc_spin 0 trivColorable regsFree slotsFree [] code
return ( code_final
<- regAlloc_spin 0 trivColorable regsFree slotsFree [] code
return ( code_final
- , debug_codeGraphs )
+ , reverse debug_codeGraphs )
regAlloc_spin (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code
= do
regAlloc_spin (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code
= do
@@
-84,6
+84,16
@@
regAlloc_spin (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code
let fmLife = plusUFMs_C (\(r1, l1) (r2, l2) -> (r1, l1 + l2))
$ map lifetimeCount code
let fmLife = plusUFMs_C (\(r1, l1) (r2, l2) -> (r1, l1 + l2))
$ map lifetimeCount code
+ -- record startup state
+ let stat1 =
+ if spinCount == 0
+ then Just $ RegAllocStatsStart
+ { raLiveCmm = code
+ , raGraph = graph
+ , raLifetimes = fmLife }
+ else Nothing
+
+
-- the function to choose regs to leave uncolored
let spill = chooseSpill_maxLife fmLife
-- the function to choose regs to leave uncolored
let spill = chooseSpill_maxLife fmLife
@@
-101,13
+111,11
@@
regAlloc_spin (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code
-- record what happened in this stage for debugging
let stat =
RegAllocStatsColored
-- record what happened in this stage for debugging
let stat =
RegAllocStatsColored
- { raLiveCmm = code
- , raGraph = graph_colored
- , raPatchedCmm = code_patched
- , raLifetimes = fmLife }
+ { raGraph = graph_colored
+ , raPatchedCmm = code_patched }
return ( code_nat
return ( code_nat
- , debug_codeGraphs ++ [stat]
+ , maybeToList stat1 ++ [stat] ++ debug_codeGraphs
, graph_colored)
else do
, graph_colored)
else do
@@
-122,14
+130,14
@@
regAlloc_spin (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs code
-- record what happened in this stage for debugging
let stat =
RegAllocStatsSpill
-- record what happened in this stage for debugging
let stat =
RegAllocStatsSpill
- { raLiveCmm = code_spilled
- , raGraph = graph_colored
+ { raGraph = graph_colored
, raSpillStats = spillStats
, raSpillStats = spillStats
- , raLifetimes = fmLife }
+ , raLifetimes = fmLife
+ , raSpilled = code_spilled }
-- try again
regAlloc_spin (spinCount + 1) triv regsFree slotsFree'
-- try again
regAlloc_spin (spinCount + 1) triv regsFree slotsFree'
- (debug_codeGraphs ++ [stat])
+ (maybeToList stat1 ++ [stat] ++ debug_codeGraphs)
code_relive
code_relive