diff options
Diffstat (limited to 'compiler/nativeGen/RegAlloc/Graph')
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Graph/Coalesce.hs | 6 | ||||
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Graph/Main.hs | 43 | ||||
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Graph/Spill.hs | 12 | ||||
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Graph/SpillClean.hs | 109 | ||||
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Graph/SpillCost.hs | 13 | ||||
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Graph/Stats.hs | 70 | ||||
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs | 23 |
7 files changed, 141 insertions, 135 deletions
diff --git a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs index 1eaf00f3a2..a499e1d562 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs @@ -27,8 +27,8 @@ import Data.List -- the same and the move instruction safely erased. regCoalesce :: Instruction instr - => [LiveCmmTop instr] - -> UniqSM [LiveCmmTop instr] + => [LiveCmmTop statics instr] + -> UniqSM [LiveCmmTop statics instr] regCoalesce code = do @@ -61,7 +61,7 @@ sinkReg fm r -- then we can rename the two regs to the same thing and eliminate the move. slurpJoinMovs :: Instruction instr - => LiveCmmTop instr + => LiveCmmTop statics instr -> Bag (Reg, Reg) slurpJoinMovs live diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs index cdbe98755a..5321a34695 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Main.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs @@ -28,6 +28,7 @@ import UniqSet import UniqFM import Bag import Outputable +import Platform import DynFlags import Data.List @@ -44,12 +45,12 @@ maxSpinCount = 10 -- | The top level of the graph coloring register allocator. regAlloc - :: (Outputable instr, Instruction instr) + :: (Outputable statics, PlatformOutputable instr, Instruction instr) => DynFlags -> UniqFM (UniqSet RealReg) -- ^ the registers we can use for allocation -> UniqSet Int -- ^ the set of available spill slots. - -> [LiveCmmTop instr] -- ^ code annotated with liveness information. - -> UniqSM ( [NatCmmTop instr], [RegAllocStats instr] ) + -> [LiveCmmTop statics instr] -- ^ code annotated with liveness information. + -> UniqSM ( [NatCmmTop statics instr], [RegAllocStats statics instr] ) -- ^ code with registers allocated and stats for each stage of -- allocation @@ -58,9 +59,10 @@ regAlloc dflags regsFree slotsFree code -- 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 + let platform = targetPlatform dflags + triv = trivColorable platform + (targetVirtualRegSqueeze platform) + (targetRealRegSqueeze platform) (code_final, debug_codeGraphs, _) <- regAlloc_spin dflags 0 @@ -79,6 +81,7 @@ regAlloc_spin debug_codeGraphs code = do + let platform = 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. @@ -111,7 +114,7 @@ regAlloc_spin -- build a map of the cost of spilling each instruction -- this will only actually be computed if we have to spill something. let spillCosts = foldl' plusSpillCostInfo zeroSpillCostInfo - $ map slurpSpillCostInfo code + $ map (slurpSpillCostInfo platform) code -- the function to choose regs to leave uncolored let spill = chooseSpill spillCosts @@ -159,14 +162,14 @@ regAlloc_spin else graph_colored -- patch the registers using the info in the graph - let code_patched = map (patchRegsFromGraph graph_colored_lint) code_coalesced + let code_patched = map (patchRegsFromGraph platform graph_colored_lint) code_coalesced -- clean out unneeded SPILL/RELOADs - let code_spillclean = map cleanSpills code_patched + let code_spillclean = map (cleanSpills platform) code_patched -- strip off liveness information, -- and rewrite SPILL/RELOAD pseudos into real instructions along the way - let code_final = map stripLive code_spillclean + let code_final = map (stripLive platform) code_spillclean -- record what happened in this stage for debugging let stat = @@ -211,7 +214,7 @@ regAlloc_spin -- 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 . reverseBlocksInTops) code_spilled + code_relive <- mapM (regLiveness platform . reverseBlocksInTops) code_spilled -- record what happened in this stage for debugging let stat = @@ -239,7 +242,7 @@ regAlloc_spin -- | Build a graph from the liveness and coalesce information in this code. buildGraph :: Instruction instr - => [LiveCmmTop instr] + => [LiveCmmTop statics instr] -> UniqSM (Color.Graph VirtualReg RegClass RealReg) buildGraph code @@ -320,11 +323,11 @@ graphAddCoalesce _ _ -- | Patch registers in code using the reg -> reg mapping in this graph. patchRegsFromGraph - :: (Outputable instr, Instruction instr) - => Color.Graph VirtualReg RegClass RealReg - -> LiveCmmTop instr -> LiveCmmTop instr + :: (Outputable statics, PlatformOutputable instr, Instruction instr) + => Platform -> Color.Graph VirtualReg RegClass RealReg + -> LiveCmmTop statics instr -> LiveCmmTop statics instr -patchRegsFromGraph graph code +patchRegsFromGraph platform graph code = let -- a function to lookup the hardreg for a virtual reg from the graph. patchF reg @@ -343,12 +346,12 @@ patchRegsFromGraph graph code | otherwise = pprPanic "patchRegsFromGraph: register mapping failed." ( text "There is no node in the graph for register " <> ppr reg - $$ ppr code + $$ pprPlatform platform code $$ Color.dotGraph (\_ -> text "white") - (trivColorable - targetVirtualRegSqueeze - targetRealRegSqueeze) + (trivColorable platform + (targetVirtualRegSqueeze platform) + (targetRealRegSqueeze platform)) graph) in patchEraseLive patchF code diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs index 4eabb3b0b4..c4fb783688 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs @@ -41,13 +41,13 @@ import qualified Data.Set as Set -- regSpill :: Instruction instr - => [LiveCmmTop instr] -- ^ the code + => [LiveCmmTop statics instr] -- ^ the code -> UniqSet Int -- ^ available stack slots -> UniqSet VirtualReg -- ^ the regs to spill -> UniqSM - ([LiveCmmTop instr] -- code with SPILL and RELOAD meta instructions added. - , UniqSet Int -- left over slots - , SpillStats ) -- stats about what happened during spilling + ([LiveCmmTop statics instr] -- code with SPILL and RELOAD meta instructions added. + , UniqSet Int -- left over slots + , SpillStats ) -- stats about what happened during spilling regSpill code slotsFree regs @@ -81,8 +81,8 @@ regSpill code slotsFree regs regSpill_top :: Instruction instr => RegMap Int -- ^ map of vregs to slots they're being spilled to. - -> LiveCmmTop instr -- ^ the top level thing. - -> SpillM (LiveCmmTop instr) + -> LiveCmmTop statics instr -- ^ the top level thing. + -> SpillM (LiveCmmTop statics instr) regSpill_top regSlotMap cmm = case cmm of diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs index 38c33b708a..da13eab045 100644 --- a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs +++ b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs @@ -39,6 +39,7 @@ import UniqFM import Unique import State import Outputable +import Platform import Data.List import Data.Maybe @@ -52,22 +53,23 @@ type Slot = Int -- | Clean out unneeded spill\/reloads from this top level thing. -cleanSpills - :: Instruction instr - => LiveCmmTop instr -> LiveCmmTop instr +cleanSpills + :: Instruction instr + => Platform -> LiveCmmTop statics instr -> LiveCmmTop statics instr -cleanSpills cmm - = evalState (cleanSpin 0 cmm) initCleanS +cleanSpills platform cmm + = evalState (cleanSpin platform 0 cmm) initCleanS -- | do one pass of cleaning -cleanSpin - :: Instruction instr - => Int - -> LiveCmmTop instr - -> CleanM (LiveCmmTop instr) +cleanSpin + :: Instruction instr + => Platform + -> Int + -> LiveCmmTop statics instr + -> CleanM (LiveCmmTop statics instr) {- -cleanSpin spinCount code +cleanSpin _ spinCount code = do jumpValid <- gets sJumpValid pprTrace "cleanSpin" ( int spinCount @@ -78,7 +80,7 @@ cleanSpin spinCount code $ cleanSpin' spinCount code -} -cleanSpin spinCount code +cleanSpin platform spinCount code = do -- init count of cleaned spills\/reloads modify $ \s -> s @@ -86,7 +88,7 @@ cleanSpin spinCount code , sCleanedReloadsAcc = 0 , sReloadedBy = emptyUFM } - code_forward <- mapBlockTopM cleanBlockForward code + code_forward <- mapBlockTopM (cleanBlockForward platform) code code_backward <- cleanTopBackward code_forward -- During the cleaning of each block we collected information about what regs @@ -107,16 +109,17 @@ cleanSpin spinCount code then return code -- otherwise go around again - else cleanSpin (spinCount + 1) code_backward + else cleanSpin platform (spinCount + 1) code_backward -- | Clean one basic block -cleanBlockForward - :: Instruction instr - => LiveBasicBlock instr - -> CleanM (LiveBasicBlock instr) +cleanBlockForward + :: Instruction instr + => Platform + -> LiveBasicBlock instr + -> CleanM (LiveBasicBlock instr) -cleanBlockForward (BasicBlock blockId instrs) +cleanBlockForward platform (BasicBlock blockId instrs) = do -- see if we have a valid association for the entry to this block jumpValid <- gets sJumpValid @@ -124,7 +127,7 @@ cleanBlockForward (BasicBlock blockId instrs) Just assoc -> assoc Nothing -> emptyAssoc - instrs_reload <- cleanForward blockId assoc [] instrs + instrs_reload <- cleanForward platform blockId assoc [] instrs return $ BasicBlock blockId instrs_reload @@ -135,37 +138,38 @@ cleanBlockForward (BasicBlock blockId instrs) -- then we don't need to do the reload. -- cleanForward - :: Instruction instr - => BlockId -- ^ the block that we're currently in - -> Assoc Store -- ^ two store locations are associated if they have the same value - -> [LiveInstr instr] -- ^ acc - -> [LiveInstr instr] -- ^ instrs to clean (in backwards order) - -> CleanM [LiveInstr instr] -- ^ cleaned instrs (in forward order) - -cleanForward _ _ acc [] + :: Instruction instr + => Platform + -> BlockId -- ^ the block that we're currently in + -> Assoc Store -- ^ two store locations are associated if they have the same value + -> [LiveInstr instr] -- ^ acc + -> [LiveInstr instr] -- ^ instrs to clean (in backwards order) + -> CleanM [LiveInstr instr] -- ^ cleaned instrs (in forward order) + +cleanForward _ _ _ acc [] = return acc -- write out live range joins via spill slots to just a spill and a reg-reg move -- hopefully the spill will be also be cleaned in the next pass -- -cleanForward blockId assoc acc (li1 : li2 : instrs) +cleanForward platform blockId assoc acc (li1 : li2 : instrs) | LiveInstr (SPILL reg1 slot1) _ <- li1 , LiveInstr (RELOAD slot2 reg2) _ <- li2 , slot1 == slot2 = do modify $ \s -> s { sCleanedReloadsAcc = sCleanedReloadsAcc s + 1 } - cleanForward blockId assoc acc - (li1 : LiveInstr (mkRegRegMoveInstr reg1 reg2) Nothing : instrs) + cleanForward platform blockId assoc acc + (li1 : LiveInstr (mkRegRegMoveInstr platform reg1 reg2) Nothing : instrs) -cleanForward blockId assoc acc (li@(LiveInstr i1 _) : instrs) +cleanForward platform blockId assoc acc (li@(LiveInstr i1 _) : instrs) | Just (r1, r2) <- takeRegRegMoveInstr i1 = if r1 == r2 -- erase any left over nop reg reg moves while we're here -- this will also catch any nop moves that the "write out live range joins" case above -- happens to add - then cleanForward blockId assoc acc instrs + then cleanForward platform blockId assoc acc instrs -- if r1 has the same value as some slots and we copy r1 to r2, -- then r2 is now associated with those slots instead @@ -173,50 +177,51 @@ cleanForward blockId assoc acc (li@(LiveInstr i1 _) : instrs) $ delAssoc (SReg r2) $ assoc - cleanForward blockId assoc' (li : acc) instrs + cleanForward platform blockId assoc' (li : acc) instrs -cleanForward blockId assoc acc (li : instrs) +cleanForward platform blockId assoc acc (li : instrs) -- update association due to the spill | LiveInstr (SPILL reg slot) _ <- li = let assoc' = addAssoc (SReg reg) (SSlot slot) $ delAssoc (SSlot slot) $ assoc - in cleanForward blockId assoc' (li : acc) instrs + in cleanForward platform blockId assoc' (li : acc) instrs -- clean a reload instr | LiveInstr (RELOAD{}) _ <- li - = do (assoc', mli) <- cleanReload blockId assoc li + = do (assoc', mli) <- cleanReload platform blockId assoc li case mli of - Nothing -> cleanForward blockId assoc' acc instrs - Just li' -> cleanForward blockId assoc' (li' : acc) instrs + Nothing -> cleanForward platform blockId assoc' acc instrs + Just li' -> cleanForward platform blockId assoc' (li' : acc) instrs -- remember the association over a jump | LiveInstr instr _ <- li , targets <- jumpDestsOfInstr instr , not $ null targets = do mapM_ (accJumpValid assoc) targets - cleanForward blockId assoc (li : acc) instrs + cleanForward platform blockId assoc (li : acc) instrs -- writing to a reg changes its value. | LiveInstr instr _ <- li , RU _ written <- regUsageOfInstr instr = let assoc' = foldr delAssoc assoc (map SReg $ nub written) - in cleanForward blockId assoc' (li : acc) instrs + in cleanForward platform blockId assoc' (li : acc) instrs -- | Try and rewrite a reload instruction to something more pleasing -- -cleanReload - :: Instruction instr - => BlockId - -> Assoc Store - -> LiveInstr instr - -> CleanM (Assoc Store, Maybe (LiveInstr instr)) +cleanReload + :: Instruction instr + => Platform + -> BlockId + -> Assoc Store + -> LiveInstr instr + -> CleanM (Assoc Store, Maybe (LiveInstr instr)) -cleanReload blockId assoc li@(LiveInstr (RELOAD slot reg) _) +cleanReload platform blockId assoc li@(LiveInstr (RELOAD slot reg) _) -- if the reg we're reloading already has the same value as the slot -- then we can erase the instruction outright @@ -233,7 +238,7 @@ cleanReload blockId assoc li@(LiveInstr (RELOAD slot reg) _) $ delAssoc (SReg reg) $ assoc - return (assoc', Just $ LiveInstr (mkRegRegMoveInstr reg2 reg) Nothing) + return (assoc', Just $ LiveInstr (mkRegRegMoveInstr platform reg2 reg) Nothing) -- gotta keep this instr | otherwise @@ -247,7 +252,7 @@ cleanReload blockId assoc li@(LiveInstr (RELOAD slot reg) _) return (assoc', Just li) -cleanReload _ _ _ +cleanReload _ _ _ _ = panic "RegSpillClean.cleanReload: unhandled instr" @@ -282,8 +287,8 @@ cleanReload _ _ _ -- cleanTopBackward :: Instruction instr - => LiveCmmTop instr - -> CleanM (LiveCmmTop instr) + => LiveCmmTop statics instr + -> CleanM (LiveCmmTop statics instr) cleanTopBackward cmm = case cmm of diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs index 330a410312..3ea150a3df 100644 --- a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs +++ b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs @@ -29,6 +29,7 @@ import UniqFM import UniqSet import Digraph (flattenSCCs) import Outputable +import Platform import State import Data.List (nub, minimumBy) @@ -62,12 +63,12 @@ plusSpillCostRecord (r1, a1, b1, c1) (r2, a2, b2, c2) -- for each vreg, the number of times it was written to, read from, -- and the number of instructions it was live on entry to (lifetime) -- -slurpSpillCostInfo - :: (Outputable instr, Instruction instr) - => LiveCmmTop instr - -> SpillCostInfo +slurpSpillCostInfo :: (PlatformOutputable instr, Instruction instr) + => Platform + -> LiveCmmTop statics instr + -> SpillCostInfo -slurpSpillCostInfo cmm +slurpSpillCostInfo platform cmm = execState (countCmm cmm) zeroSpillCostInfo where countCmm CmmData{} = return () @@ -96,7 +97,7 @@ slurpSpillCostInfo cmm | otherwise = pprPanic "RegSpillCost.slurpSpillCostInfo" - (text "no liveness information on instruction " <> ppr instr) + (text "no liveness information on instruction " <> pprPlatform platform instr) countLIs rsLiveEntry (LiveInstr instr (Just live) : lis) = do diff --git a/compiler/nativeGen/RegAlloc/Graph/Stats.hs b/compiler/nativeGen/RegAlloc/Graph/Stats.hs index 5ff7bff91a..15ec6e7f87 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Stats.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Stats.hs @@ -36,56 +36,56 @@ import State import Data.List -data RegAllocStats instr +data RegAllocStats statics instr -- initial graph = RegAllocStatsStart - { raLiveCmm :: [LiveCmmTop instr] -- ^ initial code, with liveness + { raLiveCmm :: [LiveCmmTop statics instr] -- ^ initial code, with liveness , raGraph :: Color.Graph VirtualReg RegClass RealReg -- ^ the initial, uncolored graph , raSpillCosts :: SpillCostInfo } -- ^ information to help choose which regs to spill -- a spill stage | RegAllocStatsSpill - { raCode :: [LiveCmmTop instr] -- ^ the code we tried to allocate registers for + { raCode :: [LiveCmmTop statics instr] -- ^ the code we tried to allocate registers for , raGraph :: Color.Graph VirtualReg RegClass RealReg -- ^ the partially colored graph , raCoalesced :: UniqFM VirtualReg -- ^ the regs that were coaleced , raSpillStats :: SpillStats -- ^ spiller stats , raSpillCosts :: SpillCostInfo -- ^ number of instrs each reg lives for - , raSpilled :: [LiveCmmTop instr] } -- ^ code with spill instructions added + , raSpilled :: [LiveCmmTop statics instr] } -- ^ code with spill instructions added -- a successful coloring | RegAllocStatsColored - { raCode :: [LiveCmmTop instr] -- ^ the code we tried to allocate registers for + { raCode :: [LiveCmmTop statics instr] -- ^ the code we tried to allocate registers for , raGraph :: Color.Graph VirtualReg RegClass RealReg -- ^ the uncolored graph , raGraphColored :: Color.Graph VirtualReg RegClass RealReg -- ^ the coalesced and colored graph , raCoalesced :: UniqFM VirtualReg -- ^ the regs that were coaleced - , raCodeCoalesced :: [LiveCmmTop instr] -- ^ code with coalescings applied - , raPatched :: [LiveCmmTop instr] -- ^ code with vregs replaced by hregs - , raSpillClean :: [LiveCmmTop instr] -- ^ code with unneeded spill\/reloads cleaned out - , raFinal :: [NatCmmTop instr] -- ^ final code + , raCodeCoalesced :: [LiveCmmTop statics instr] -- ^ code with coalescings applied + , raPatched :: [LiveCmmTop statics instr] -- ^ code with vregs replaced by hregs + , raSpillClean :: [LiveCmmTop statics instr] -- ^ code with unneeded spill\/reloads cleaned out + , raFinal :: [NatCmmTop statics instr] -- ^ final code , raSRMs :: (Int, Int, Int) } -- ^ spill\/reload\/reg-reg moves present in this code -instance Outputable instr => Outputable (RegAllocStats instr) where +instance (Outputable statics, PlatformOutputable instr) => PlatformOutputable (RegAllocStats statics instr) where - ppr (s@RegAllocStatsStart{}) + pprPlatform platform (s@RegAllocStatsStart{}) = text "# Start" $$ text "# Native code with liveness information." - $$ ppr (raLiveCmm s) + $$ pprPlatform platform (raLiveCmm s) $$ text "" $$ text "# Initial register conflict graph." $$ Color.dotGraph - targetRegDotColor - (trivColorable - targetVirtualRegSqueeze - targetRealRegSqueeze) + (targetRegDotColor platform) + (trivColorable platform + (targetVirtualRegSqueeze platform) + (targetRealRegSqueeze platform)) (raGraph s) - ppr (s@RegAllocStatsSpill{}) + pprPlatform platform (s@RegAllocStatsSpill{}) = text "# Spill" $$ text "# Code with liveness information." - $$ (ppr (raCode s)) + $$ pprPlatform platform (raCode s) $$ text "" $$ (if (not $ isNullUFM $ raCoalesced s) @@ -99,22 +99,22 @@ instance Outputable instr => Outputable (RegAllocStats instr) where $$ text "" $$ text "# Code with spills inserted." - $$ (ppr (raSpilled s)) + $$ pprPlatform platform (raSpilled s) - ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) }) + pprPlatform platform (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) }) = text "# Colored" $$ text "# Code with liveness information." - $$ (ppr (raCode s)) + $$ pprPlatform platform (raCode s) $$ text "" $$ text "# Register conflict graph (colored)." $$ Color.dotGraph - targetRegDotColor - (trivColorable - targetVirtualRegSqueeze - targetRealRegSqueeze) + (targetRegDotColor platform) + (trivColorable platform + (targetVirtualRegSqueeze platform) + (targetRealRegSqueeze platform)) (raGraphColored s) $$ text "" @@ -125,19 +125,19 @@ instance Outputable instr => Outputable (RegAllocStats instr) where else empty) $$ text "# Native code after coalescings applied." - $$ ppr (raCodeCoalesced s) + $$ pprPlatform platform (raCodeCoalesced s) $$ text "" $$ text "# Native code after register allocation." - $$ ppr (raPatched s) + $$ pprPlatform platform (raPatched s) $$ text "" $$ text "# Clean out unneeded spill/reloads." - $$ ppr (raSpillClean s) + $$ pprPlatform platform (raSpillClean s) $$ text "" $$ text "# Final code, after rewriting spill/rewrite pseudo instrs." - $$ ppr (raFinal s) + $$ pprPlatform platform (raFinal s) $$ text "" $$ text "# Score:" $$ (text "# spills inserted: " <> int spills) @@ -147,7 +147,7 @@ instance Outputable instr => Outputable (RegAllocStats instr) where -- | Do all the different analysis on this list of RegAllocStats pprStats - :: [RegAllocStats instr] + :: [RegAllocStats statics instr] -> Color.Graph VirtualReg RegClass RealReg -> SDoc @@ -162,7 +162,7 @@ pprStats stats graph -- | Dump a table of how many spill loads \/ stores were inserted for each vreg. pprStatsSpills - :: [RegAllocStats instr] -> SDoc + :: [RegAllocStats statics instr] -> SDoc pprStatsSpills stats = let @@ -180,7 +180,7 @@ pprStatsSpills stats -- | Dump a table of how long vregs tend to live for in the initial code. pprStatsLifetimes - :: [RegAllocStats instr] -> SDoc + :: [RegAllocStats statics instr] -> SDoc pprStatsLifetimes stats = let info = foldl' plusSpillCostInfo zeroSpillCostInfo @@ -208,7 +208,7 @@ binLifetimeCount fm -- | Dump a table of how many conflicts vregs tend to have in the initial code. pprStatsConflict - :: [RegAllocStats instr] -> SDoc + :: [RegAllocStats statics instr] -> SDoc pprStatsConflict stats = let confMap = foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2))) @@ -225,7 +225,7 @@ pprStatsConflict stats -- | For every vreg, dump it's how many conflicts it has and its lifetime -- good for making a scatter plot. pprStatsLifeConflict - :: [RegAllocStats instr] + :: [RegAllocStats statics instr] -> Color.Graph VirtualReg RegClass RealReg -- ^ global register conflict graph -> SDoc @@ -256,7 +256,7 @@ pprStatsLifeConflict stats graph -- Lets us see how well the register allocator has done. countSRMs :: Instruction instr - => LiveCmmTop instr -> (Int, Int, Int) + => LiveCmmTop statics instr -> (Int, Int, Int) countSRMs cmm = execState (mapBlockTopM countSRM_block cmm) (0, 0, 0) diff --git a/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs b/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs index 802f847f11..e62b4a9abb 100644 --- a/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs +++ b/compiler/nativeGen/RegAlloc/Graph/TrivColorable.hs @@ -98,18 +98,15 @@ the most efficient variant tried. Benchmark compiling 10-times SHA1.lhs follows. 100.00% 166.23% 94.18% 100.95% -} --- TODO: We shouldn't be using defaultTargetPlatform here. --- We should be passing DynFlags in instead, and looking at --- its targetPlatform. - trivColorable - :: (RegClass -> VirtualReg -> FastInt) + :: Platform + -> (RegClass -> VirtualReg -> FastInt) -> (RegClass -> RealReg -> FastInt) -> Triv VirtualReg RegClass RealReg -trivColorable virtualRegSqueeze realRegSqueeze RcInteger conflicts exclusions +trivColorable platform virtualRegSqueeze realRegSqueeze RcInteger conflicts exclusions | let !cALLOCATABLE_REGS_INTEGER - = iUnbox (case platformArch defaultTargetPlatform of + = iUnbox (case platformArch platform of ArchX86 -> 3 ArchX86_64 -> 5 ArchPPC -> 16 @@ -127,9 +124,9 @@ trivColorable virtualRegSqueeze realRegSqueeze RcInteger conflicts exclusions = count3 <# cALLOCATABLE_REGS_INTEGER -trivColorable virtualRegSqueeze realRegSqueeze RcFloat conflicts exclusions +trivColorable platform virtualRegSqueeze realRegSqueeze RcFloat conflicts exclusions | let !cALLOCATABLE_REGS_FLOAT - = iUnbox (case platformArch defaultTargetPlatform of + = iUnbox (case platformArch platform of ArchX86 -> 0 ArchX86_64 -> 0 ArchPPC -> 0 @@ -147,9 +144,9 @@ trivColorable virtualRegSqueeze realRegSqueeze RcFloat conflicts exclusions = count3 <# cALLOCATABLE_REGS_FLOAT -trivColorable virtualRegSqueeze realRegSqueeze RcDouble conflicts exclusions +trivColorable platform virtualRegSqueeze realRegSqueeze RcDouble conflicts exclusions | let !cALLOCATABLE_REGS_DOUBLE - = iUnbox (case platformArch defaultTargetPlatform of + = iUnbox (case platformArch platform of ArchX86 -> 6 ArchX86_64 -> 0 ArchPPC -> 26 @@ -167,9 +164,9 @@ trivColorable virtualRegSqueeze realRegSqueeze RcDouble conflicts exclusions = count3 <# cALLOCATABLE_REGS_DOUBLE -trivColorable virtualRegSqueeze realRegSqueeze RcDoubleSSE conflicts exclusions +trivColorable platform virtualRegSqueeze realRegSqueeze RcDoubleSSE conflicts exclusions | let !cALLOCATABLE_REGS_SSE - = iUnbox (case platformArch defaultTargetPlatform of + = iUnbox (case platformArch platform of ArchX86 -> 8 ArchX86_64 -> 10 ArchPPC -> 0 |