)
where
-
------
import UniqSet
import Unique
-- Some basic register classes.
-- These aren't nessesarally in 1-to-1 correspondance with the allocatable
-- RegClasses in MachRegs.hs
---
data RegClass
-- general purpose regs
= ClassG32 -- 32 bit GPRs
-- This should be hand coded/cached for each particular architecture,
-- because the compute time is very long..
-
worst
:: (RegClass -> UniqSet Reg)
-> (Reg -> UniqSet Reg)
-- | For a node N of classN and neighbors of classesC
-- (bound classN classesC) is the maximum number of potential
-- colors for N that can be lost by coloring its neighbors.
---
-
bound
:: (RegClass -> UniqSet Reg)
-> (Reg -> UniqSet Reg)
--
-- A version of this should be constructed for each particular architecture,
-- possibly including uses of bound, so that alised registers don't get counted
--- twice, as per the paper.
---
+-- twice, as per the paper.
squeese
:: (RegClass -> UniqSet Reg)
-> (Reg -> UniqSet Reg)
-- | Determine all the regs that make up a certain class.
---
regsOfClass :: RegClass -> UniqSet Reg
regsOfClass c
= case c of
-- | Determine the common name of a reg
-- returns Nothing if this reg is not part of the machine.
-
regName :: Reg -> Maybe String
regName reg
= case reg of
-- 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]
-- | 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
-- | The top level of the graph coloring register allocator.
---
regAlloc
:: (Outputable instr, Instruction instr)
=> DynFlags
-- and rewrite SPILL/RELOAD pseudos into real instructions along the way
let code_final = map stripLive code_spillclean
--- let spillNatTop = mapGenBlockTop spillNatBlock
--- let code_final = map spillNatTop code_nat
-
-- record what happened in this stage for debugging
let stat =
RegAllocStatsColored
code_relive
-
-- | Build a graph from the liveness and coalesce information in this code.
-
buildGraph
:: Instruction instr
=> [LiveCmmTop instr]
-- | Add some conflict edges to the graph.
-- Conflicts between virtual and real regs are recorded as exclusions.
---
graphAddConflictSet
:: UniqSet Reg
-> Color.Graph VirtualReg RegClass RealReg
-- | Add some coalesence edges to the graph
-- Coalesences between virtual and real regs are recorded as preferences.
---
graphAddCoalesce
:: (Reg, Reg)
-> Color.Graph VirtualReg RegClass RealReg
{-# OPTIONS -fno-warn-missing-signatures #-}
--- Carries interesting info for debugging / profiling of the
+-- | Carries interesting info for debugging / profiling of the
-- graph coloring register allocator.
---
-
module RegAlloc.Graph.Stats (
RegAllocStats (..),
$$ (ppr (raCode s))
$$ text ""
--- $$ text "# Register conflict graph."
--- $$ Color.dotGraph regDotColor trivColorable (raGraph s)
--- $$ text ""
-
$$ (if (not $ isNullUFM $ raCoalesced s)
then text "# Registers coalesced."
$$ (vcat $ map ppr $ ufmToList $ raCoalesced s)
$$ text ""
else empty)
--- $$ text "# Spill costs. reg uses defs lifetime degree cost"
--- $$ vcat (map (pprSpillCostRecord (raGraph s)) $ eltsUFM $ raSpillCosts s)
--- $$ text ""
-
$$ text "# Spills inserted."
$$ ppr (raSpillStats s)
$$ text ""
ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
= text "# Colored"
--- $$ text "# Register conflict graph (initial)."
--- $$ Color.dotGraph regDotColor trivColorable (raGraph s)
--- $$ text ""
-
$$ text "# Code with liveness information."
$$ (ppr (raCode s))
$$ text ""
-- | Count spill/reload/reg-reg moves.
-- Lets us see how well the register allocator has done.
---
countSRMs
:: Instruction instr
=> LiveCmmTop instr -> (Int, Int, Int)
addSRM (s1, r1, m1) (s2, r2, m2)
= (s1+s2, r1+r2, m1+m2)
-
-
-
-
-
-{-
-toX11Color (r, g, b)
- = let rs = padL 2 '0' (showHex r "")
- gs = padL 2 '0' (showHex r "")
- bs = padL 2 '0' (showHex r "")
-
- padL n c s
- = replicate (n - length s) c ++ s
- in "#" ++ rs ++ gs ++ bs
--}