X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAlloc%2FGraph%2FMain.hs;h=5fa771cfb8b97c3332d681c42120c32f43107dc6;hp=fe99aba12067361b29854cd7a3b57fbc005cdb30;hb=703ca1542c8e0983cc9d8eebce6e9f3dd3fd71e2;hpb=ee6bba6f3d80c56b47bc623bc6e4f076be1f046f diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs index fe99aba..5fa771c 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Main.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs @@ -5,8 +5,7 @@ -- module RegAlloc.Graph.Main ( - regAlloc, - regDotColor + regAlloc ) where @@ -17,9 +16,12 @@ import RegAlloc.Graph.Spill import RegAlloc.Graph.SpillClean import RegAlloc.Graph.SpillCost import RegAlloc.Graph.Stats -import Regs -import Instrs -import PprMach +import RegAlloc.Graph.TrivColorable +import Instruction +import TargetReg +import RegClass +import Reg + import UniqSupply import UniqSet @@ -43,23 +45,40 @@ maxSpinCount = 10 -- | The top level of the graph coloring register allocator. -- regAlloc - :: DynFlags - -> UniqFM (UniqSet Reg) -- ^ the registers we can use for allocation + :: (Outputable instr, Instruction instr) + => DynFlags + -> UniqFM (UniqSet RealReg) -- ^ the registers we can use for allocation -> UniqSet Int -- ^ the set of available spill slots. - -> [LiveCmmTop] -- ^ code annotated with liveness information. - -> UniqSM ( [NatCmmTop], [RegAllocStats] ) + -> [LiveCmmTop instr] -- ^ code annotated with liveness information. + -> UniqSM ( [NatCmmTop instr], [RegAllocStats instr] ) -- ^ code with registers allocated and stats for each stage of -- allocation regAlloc dflags regsFree slotsFree code = do + -- TODO: the regClass function is currently hard coded to the default target + -- architecture. Would prefer to determine this from dflags. + -- There are other uses of targetRegClass later in this module. + let triv = trivColorable + targetVirtualRegSqueeze + targetRealRegSqueeze + (code_final, debug_codeGraphs, _) - <- regAlloc_spin dflags 0 trivColorable regsFree slotsFree [] code + <- regAlloc_spin dflags 0 + triv + regsFree slotsFree [] code return ( code_final , reverse debug_codeGraphs ) -regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code +regAlloc_spin + dflags + spinCount + (triv :: Color.Triv VirtualReg RegClass RealReg) + (regsFree :: UniqFM (UniqSet RealReg)) + slotsFree + debug_codeGraphs + code = do -- if any of these dump flags are turned on we want to hang on to -- intermediate structures in the allocator - otherwise tell the @@ -74,12 +93,13 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code $ pprPanic "regAlloc_spin: max build/spill cycle count exceeded." ( text "It looks like the register allocator is stuck in an infinite loop." $$ text "max cycles = " <> int maxSpinCount - $$ text "regsFree = " <> (hcat $ punctuate space $ map (docToSDoc . pprUserReg) + $$ text "regsFree = " <> (hcat $ punctuate space $ map ppr $ uniqSetToList $ unionManyUniqSets $ eltsUFM regsFree) $$ text "slotsFree = " <> ppr (sizeUniqSet slotsFree)) -- build a conflict graph from the code. - graph <- {-# SCC "BuildGraph" #-} buildGraph code + (graph :: Color.Graph VirtualReg RegClass RealReg) + <- {-# SCC "BuildGraph" #-} buildGraph code -- VERY IMPORTANT: -- We really do want the graph to be fully evaluated _before_ we start coloring. @@ -115,9 +135,15 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code regsFree triv spill graph -- rewrite regs in the code that have been coalesced - let patchF reg = case lookupUFM rmCoalesce reg of - Just reg' -> patchF reg' - Nothing -> reg + let patchF reg + | RegVirtual vr <- reg + = case lookupUFM rmCoalesce vr of + Just vr' -> patchF (RegVirtual vr') + Nothing -> reg + + | otherwise + = reg + let code_coalesced = map (patchEraseLive patchF) code @@ -139,12 +165,12 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code -- clean out unneeded SPILL/RELOADs let code_spillclean = map cleanSpills code_patched - -- strip off liveness information - let code_nat = map stripLive code_spillclean + -- strip off liveness information, + -- and rewrite SPILL/RELOAD pseudos into real instructions along the way + let code_final = map stripLive code_spillclean - -- rewrite SPILL/RELOAD pseudos into real instructions - let spillNatTop = mapGenBlockTop spillNatBlock - let code_final = map spillNatTop code_nat +-- let spillNatTop = mapGenBlockTop spillNatBlock +-- let code_final = map spillNatTop code_nat -- record what happened in this stage for debugging let stat = @@ -213,8 +239,9 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code -- | Build a graph from the liveness and coalesce information in this code. buildGraph - :: [LiveCmmTop] - -> UniqSM (Color.Graph Reg RegClass Reg) + :: Instruction instr + => [LiveCmmTop instr] + -> UniqSM (Color.Graph VirtualReg RegClass RealReg) buildGraph code = do @@ -241,19 +268,20 @@ buildGraph code -- graphAddConflictSet :: UniqSet Reg - -> Color.Graph Reg RegClass Reg - -> Color.Graph Reg RegClass Reg + -> Color.Graph VirtualReg RegClass RealReg + -> Color.Graph VirtualReg RegClass RealReg graphAddConflictSet set graph - = let reals = filterUFM isRealReg set - virtuals = filterUFM (not . isRealReg) set + = let virtuals = mkUniqSet + [ vr | RegVirtual vr <- uniqSetToList set ] - graph1 = Color.addConflicts virtuals regClass graph - graph2 = foldr (\(r1, r2) -> Color.addExclusion r1 regClass r2) + graph1 = Color.addConflicts virtuals classOfVirtualReg graph + + graph2 = foldr (\(r1, r2) -> Color.addExclusion r1 classOfVirtualReg r2) graph1 - [ (a, b) - | a <- uniqSetToList virtuals - , b <- uniqSetToList reals] + [ (vr, rr) + | RegVirtual vr <- uniqSetToList set + , RegReal rr <- uniqSetToList set] in graph2 @@ -263,47 +291,68 @@ graphAddConflictSet set graph -- graphAddCoalesce :: (Reg, Reg) - -> Color.Graph Reg RegClass Reg - -> Color.Graph Reg RegClass Reg + -> Color.Graph VirtualReg RegClass RealReg + -> Color.Graph VirtualReg RegClass RealReg graphAddCoalesce (r1, r2) graph - | RealReg _ <- r1 - = Color.addPreference (regWithClass r2) r1 graph + | RegReal rr <- r1 + , RegVirtual vr <- r2 + = Color.addPreference (vr, classOfVirtualReg vr) rr graph - | RealReg _ <- r2 - = Color.addPreference (regWithClass r1) r2 graph + | RegReal rr <- r2 + , RegVirtual vr <- r1 + = Color.addPreference (vr, classOfVirtualReg vr) rr graph + + | RegVirtual vr1 <- r1 + , RegVirtual vr2 <- r2 + = Color.addCoalesce + (vr1, classOfVirtualReg vr1) + (vr2, classOfVirtualReg vr2) + graph + + -- We can't coalesce two real regs, but there could well be existing + -- hreg,hreg moves in the input code. We'll just ignore these + -- for coalescing purposes. + | RegReal _ <- r1 + , RegReal _ <- r2 + = graph + +graphAddCoalesce _ _ + = panic "graphAddCoalesce: bogus" - | otherwise - = Color.addCoalesce (regWithClass r1) (regWithClass r2) graph - - where regWithClass r = (r, regClass r) - -- | Patch registers in code using the reg -> reg mapping in this graph. patchRegsFromGraph - :: Color.Graph Reg RegClass Reg - -> LiveCmmTop -> LiveCmmTop + :: (Outputable instr, Instruction instr) + => Color.Graph VirtualReg RegClass RealReg + -> LiveCmmTop instr -> LiveCmmTop instr patchRegsFromGraph graph code = let -- a function to lookup the hardreg for a virtual reg from the graph. patchF reg -- leave real regs alone. - | isRealReg reg + | RegReal{} <- reg = reg -- this virtual has a regular node in the graph. - | Just node <- Color.lookupNode graph reg + | RegVirtual vr <- reg + , Just node <- Color.lookupNode graph vr = case Color.nodeColor node of - Just color -> color - Nothing -> reg + Just color -> RegReal color + Nothing -> RegVirtual vr -- no node in the graph for this virtual, bad news. | otherwise = pprPanic "patchRegsFromGraph: register mapping failed." ( text "There is no node in the graph for register " <> ppr reg $$ ppr code - $$ Color.dotGraph (\_ -> text "white") trivColorable graph) + $$ Color.dotGraph + (\_ -> text "white") + (trivColorable + targetVirtualRegSqueeze + targetRealRegSqueeze) + graph) in patchEraseLive patchF code @@ -311,34 +360,39 @@ patchRegsFromGraph graph code ----- -- for when laziness just isn't what you wanted... -- -seqGraph :: Color.Graph Reg RegClass Reg -> () +seqGraph :: Color.Graph VirtualReg RegClass RealReg -> () seqGraph graph = seqNodes (eltsUFM (Color.graphMap graph)) -seqNodes :: [Color.Node Reg RegClass Reg] -> () +seqNodes :: [Color.Node VirtualReg RegClass RealReg] -> () seqNodes ns = case ns of [] -> () (n : ns) -> seqNode n `seq` seqNodes ns -seqNode :: Color.Node Reg RegClass Reg -> () +seqNode :: Color.Node VirtualReg RegClass RealReg -> () seqNode node - = seqReg (Color.nodeId node) - `seq` seqRegClass (Color.nodeClass node) - `seq` seqMaybeReg (Color.nodeColor node) - `seq` (seqRegList (uniqSetToList (Color.nodeConflicts node))) - `seq` (seqRegList (uniqSetToList (Color.nodeExclusions node))) - `seq` (seqRegList (Color.nodePreference node)) - `seq` (seqRegList (uniqSetToList (Color.nodeCoalesce node))) - -seqReg :: Reg -> () -seqReg reg + = seqVirtualReg (Color.nodeId node) + `seq` seqRegClass (Color.nodeClass node) + `seq` seqMaybeRealReg (Color.nodeColor node) + `seq` (seqVirtualRegList (uniqSetToList (Color.nodeConflicts node))) + `seq` (seqRealRegList (uniqSetToList (Color.nodeExclusions node))) + `seq` (seqRealRegList (Color.nodePreference node)) + `seq` (seqVirtualRegList (uniqSetToList (Color.nodeCoalesce node))) + +seqVirtualReg :: VirtualReg -> () +seqVirtualReg reg = case reg of - RealReg _ -> () VirtualRegI _ -> () VirtualRegHi _ -> () VirtualRegF _ -> () VirtualRegD _ -> () +seqRealReg :: RealReg -> () +seqRealReg reg + = case reg of + RealRegSingle _ -> () + RealRegPair _ _ -> () + seqRegClass :: RegClass -> () seqRegClass c = case c of @@ -346,17 +400,23 @@ seqRegClass c RcFloat -> () RcDouble -> () -seqMaybeReg :: Maybe Reg -> () -seqMaybeReg mr +seqMaybeRealReg :: Maybe RealReg -> () +seqMaybeRealReg mr = case mr of Nothing -> () - Just r -> seqReg r + Just r -> seqRealReg r + +seqVirtualRegList :: [VirtualReg] -> () +seqVirtualRegList rs + = case rs of + [] -> () + (r : rs) -> seqVirtualReg r `seq` seqVirtualRegList rs -seqRegList :: [Reg] -> () -seqRegList rs +seqRealRegList :: [RealReg] -> () +seqRealRegList rs = case rs of [] -> () - (r : rs) -> seqReg r `seq` seqRegList rs + (r : rs) -> seqRealReg r `seq` seqRealRegList rs seqList :: [a] -> () seqList ls