{-# LANGUAGE ScopedTypeVariables #-}-- | Graph coloring register allocator.moduleRegAlloc.Graph.Main(regAlloc )whereimportGhcPrelude importqualifiedGraphColor asColorimportRegAlloc.Liveness importRegAlloc.Graph.Spill importRegAlloc.Graph.SpillClean importRegAlloc.Graph.SpillCost importRegAlloc.Graph.Stats importRegAlloc.Graph.TrivColorable importInstruction importTargetReg importRegClass importReg importBag importDynFlags importOutputable importPlatform importUniqFM importUniqSet importUniqSupply importUtil (seqList )importData.MaybeimportControl.Monad-- | The maximum number of build\/spill cycles we'll allow.---- It should only take 3 or 4 cycles for the allocator to converge.-- If it takes any longer than this it's probably in an infinite loop,-- so it's better just to bail out and report a bug.maxSpinCount::IntmaxSpinCount =10-- | The top level of the graph coloring register allocator.regAlloc::(Outputable statics ,Outputable instr ,Instruction instr )=>DynFlags ->UniqFM (UniqSet RealReg )-- ^ registers we can use for allocation->UniqSet Int-- ^ set of available spill slots.->[LiveCmmDecl statics instr ]-- ^ code annotated with liveness information.->UniqSM ([NatCmmDecl statics instr ],[RegAllocStats statics instr ])-- ^ code with registers allocated and stats for each stage of-- allocationregAlloc 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.letplatform =targetPlatform dflags triv =trivColorable platform (targetVirtualRegSqueeze platform )(targetRealRegSqueeze platform )(code_final ,debug_codeGraphs ,_)<-regAlloc_spin dflags 0triv regsFree slotsFree []code return(code_final ,reversedebug_codeGraphs )-- | Perform solver iterations for the graph coloring allocator.---- We extract a register confict graph from the provided cmm code,-- and try to colour it. If that works then we use the solution rewrite-- the code with real hregs. If coloring doesn't work we add spill code-- and try to colour it again. After `maxSpinCount` iterations we give up.--regAlloc_spin::(Instruction instr ,Outputable instr ,Outputable statics )=>DynFlags ->Int-- ^ Number of solver iterations we've already performed.->Color.Triv VirtualReg RegClass RealReg -- ^ Function for calculating whether a register is trivially-- colourable.->UniqFM (UniqSet RealReg )-- ^ Free registers that we can allocate.->UniqSet Int-- ^ Free stack slots that we can use.->[RegAllocStats statics instr ]-- ^ Current regalloc stats to add to.->[LiveCmmDecl statics instr ]-- ^ Liveness annotated code to allocate.->UniqSM ([NatCmmDecl statics instr ],[RegAllocStats statics instr ],Color.Graph VirtualReg RegClass RealReg )regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code =doletplatform =targetPlatform dflags -- If any of these dump flags are turned on we want to hang on to-- intermediate structures in the allocator - otherwise tell the-- allocator to ditch them early so we don't end up creating space leaks.letdump =or[dopt Opt_D_dump_asm_regalloc_stages dflags ,dopt Opt_D_dump_asm_stats dflags ,dopt Opt_D_dump_asm_conflicts dflags ]-- Check that we're not running off down the garden path.when(spinCount >maxSpinCount )$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 $mapppr $nonDetEltsUniqSet $unionManyUniqSets $nonDetEltsUFM regsFree )-- This is non-deterministic but we do not-- currently support deterministic code-generation.-- See Note [Unique Determinism and code generation]$$ text "slotsFree = "<> ppr (sizeUniqSet slotsFree ))-- Build the register conflict graph from the cmm 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. If we don't do this now then when the call to-- Color.colorGraph forces bits of it, the heap will be filled with-- half evaluated pieces of graph and zillions of apply thunks.seqGraph graph `seq`return()-- Build a map of the cost of spilling each instruction.-- This is a lazy binding, so the map will only be computed if we-- actually have to spill to the stack.letspillCosts =foldl'plusSpillCostInfo zeroSpillCostInfo $map(slurpSpillCostInfo platform )code -- The function to choose regs to leave uncolored.letspill =chooseSpill spillCosts -- Record startup state in our log.letstat1 =ifspinCount ==0thenJust$RegAllocStatsStart {raLiveCmm=code ,raGraph=graph ,raSpillCosts=spillCosts }elseNothing-- Try and color the graph.let(graph_colored ,rsSpill ,rmCoalesce )={-# SCC"ColorGraph"#-}Color.colorGraph (gopt Opt_RegsIterative dflags )spinCount regsFree triv spill graph -- Rewrite registers in the code that have been coalesced.letpatchF reg |RegVirtual vr <-reg =caselookupUFM rmCoalesce vr ofJustvr' ->patchF (RegVirtual vr' )Nothing->reg |otherwise=reg letcode_coalesced =map(patchEraseLive patchF )code -- Check whether we've found a coloring.ifisEmptyUniqSet rsSpill -- Coloring was successful because no registers needed to be spilled.thendo-- if -fasm-lint is turned on then validate the graph.-- This checks for bugs in the graph allocator itself.letgraph_colored_lint =ifgopt Opt_DoAsmLinting dflags thenColor.validateGraph (text "")True-- Require all nodes to be colored.graph_colored elsegraph_colored -- Rewrite the code to use real hregs, using the colored graph.letcode_patched =map(patchRegsFromGraph platform graph_colored_lint )code_coalesced -- Clean out unneeded SPILL/RELOAD meta instructions.-- The spill code generator just spills the entire live range-- of a vreg, but it might not need to be on the stack for-- its entire lifetime.letcode_spillclean =map(cleanSpills platform )code_patched -- Strip off liveness information from the allocated code.-- Also rewrite SPILL/RELOAD meta instructions into real machine-- instructions along the wayletcode_final =map(stripLive dflags )code_spillclean -- Record what happened in this stage for debuggingletstat =RegAllocStatsColored {raCode=code ,raGraph=graph ,raGraphColored=graph_colored_lint ,raCoalesced=rmCoalesce ,raCodeCoalesced=code_coalesced ,raPatched=code_patched ,raSpillClean=code_spillclean ,raFinal=code_final ,raSRMs=foldl'addSRM (0,0,0)$mapcountSRMs code_spillclean }-- Bundle up all the register allocator statistics.-- .. but make sure to drop them on the floor if they're not-- needed, otherwise we'll get a space leak.letstatList =ifdump then[stat ]++maybeToListstat1 ++debug_codeGraphs else[]-- Ensure all the statistics are evaluated, to avoid space leaks.seqList statList (return())return(code_final ,statList ,graph_colored_lint )-- Coloring was unsuccessful. We need to spill some register to the-- stack, make a new graph, and try to color it again.elsedo-- if -fasm-lint is turned on then validate the graphletgraph_colored_lint =ifgopt Opt_DoAsmLinting dflags thenColor.validateGraph (text "")False-- don't require nodes to be coloredgraph_colored elsegraph_colored -- Spill uncolored regs to the stack.(code_spilled ,slotsFree' ,spillStats )<-regSpill platform code_coalesced slotsFree rsSpill -- Recalculate liveness information.-- NOTE: we have to reverse the SCCs here to get them back into-- the reverse-dependency order required by computeLiveness.-- If they're not in the correct order that function will panic.code_relive <-mapM(regLiveness platform .reverseBlocksInTops )code_spilled -- Record what happened in this stage for debugging.letstat =RegAllocStatsSpill {raCode=code ,raGraph=graph_colored_lint ,raCoalesced=rmCoalesce ,raSpillStats=spillStats ,raSpillCosts=spillCosts ,raSpilled=code_spilled }-- Bundle up all the register allocator statistics.-- .. but make sure to drop them on the floor if they're not-- needed, otherwise we'll get a space leak.letstatList =ifdump then[stat ]++maybeToListstat1 ++debug_codeGraphs else[]-- Ensure all the statistics are evaluated, to avoid space leaks.seqList statList (return())regAlloc_spin dflags (spinCount +1)triv regsFree slotsFree' statList code_relive -- | Build a graph from the liveness and coalesce information in this code.buildGraph::Instruction instr =>[LiveCmmDecl statics instr ]->UniqSM (Color.Graph VirtualReg RegClass RealReg )buildGraph code =do-- Slurp out the conflicts and reg->reg moves from this code.let(conflictList ,moveList )=unzip$mapslurpConflicts code -- Slurp out the spill/reload coalesces.letmoveList2 =mapslurpReloadCoalesce code -- Add the reg-reg conflicts to the graph.letconflictBag =unionManyBags conflictList letgraph_conflict =foldrBag graphAddConflictSet Color.initGraph conflictBag -- Add the coalescences edges to the graph.letmoveBag =unionBags (unionManyBags moveList2 )(unionManyBags moveList )letgraph_coalesce =foldrBag graphAddCoalesce graph_conflict moveBag returngraph_coalesce -- | 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 ->Color.Graph VirtualReg RegClass RealReg graphAddConflictSet set graph =letvirtuals =mkUniqSet [vr |RegVirtual vr <-nonDetEltsUniqSet set ]graph1 =Color.addConflicts virtuals classOfVirtualReg graph graph2 =foldr(\(r1 ,r2 )->Color.addExclusion r1 classOfVirtualReg r2 )graph1 [(vr ,rr )|RegVirtual vr <-nonDetEltsUniqSet set ,RegReal rr <-nonDetEltsUniqSet set ]-- See Note [Unique Determinism and code generation]ingraph2 -- | 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 ->Color.Graph VirtualReg RegClass RealReg graphAddCoalesce (r1 ,r2 )graph |RegReal rr <-r1 ,RegVirtual vr <-r2 =Color.addPreference (vr ,classOfVirtualReg vr )rr 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 |otherwise=panic "graphAddCoalesce"-- | Patch registers in code using the reg -> reg mapping in this graph.patchRegsFromGraph::(Outputable statics ,Outputable instr ,Instruction instr )=>Platform ->Color.Graph VirtualReg RegClass RealReg ->LiveCmmDecl statics instr ->LiveCmmDecl statics instr patchRegsFromGraph platform graph code =patchEraseLive patchF code where-- Function to lookup the hardreg for a virtual reg from the graph.patchF reg -- leave real regs alone.|RegReal {}<-reg =reg -- this virtual has a regular node in the graph.|RegVirtual vr <-reg ,Justnode <-Color.lookupNode graph vr =caseColor.nodeColornode ofJustcolor ->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 platform (targetVirtualRegSqueeze platform )(targetRealRegSqueeze platform ))graph )------- for when laziness just isn't what you wanted...-- We need to deepSeq the whole graph before trying to colour it to avoid-- space leaks.seqGraph::Color.Graph VirtualReg RegClass RealReg ->()seqGraph graph =seqNodes (nonDetEltsUFM (Color.graphMapgraph ))-- See Note [Unique Determinism and code generation]seqNodes::[Color.Node VirtualReg RegClass RealReg ]->()seqNodes ns =casens of[]->()(n :ns )->seqNode n `seq`seqNodes ns seqNode::Color.Node VirtualReg RegClass RealReg ->()seqNode node =seqVirtualReg (Color.nodeIdnode )`seq`seqRegClass (Color.nodeClassnode )`seq`seqMaybeRealReg (Color.nodeColornode )`seq`(seqVirtualRegList (nonDetEltsUniqSet (Color.nodeConflictsnode )))`seq`(seqRealRegList (nonDetEltsUniqSet (Color.nodeExclusionsnode )))`seq`(seqRealRegList (Color.nodePreferencenode ))`seq`(seqVirtualRegList (nonDetEltsUniqSet (Color.nodeCoalescenode )))-- It's OK to use nonDetEltsUniqSet for seqseqVirtualReg::VirtualReg ->()seqVirtualReg reg =reg `seq`()seqRealReg::RealReg ->()seqRealReg reg =reg `seq`()seqRegClass::RegClass ->()seqRegClass c =c `seq`()seqMaybeRealReg::MaybeRealReg ->()seqMaybeRealReg mr =casemr ofNothing->()Justr ->seqRealReg r seqVirtualRegList::[VirtualReg ]->()seqVirtualRegList rs =casers of[]->()(r :rs )->seqVirtualReg r `seq`seqVirtualRegList rs seqRealRegList::[RealReg ]->()seqRealRegList rs =casers of[]->()(r :rs )->seqRealReg r `seq`seqRealRegList rs