diff options
Diffstat (limited to 'compiler/nativeGen/RegAlloc/Graph')
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Graph/Coalesce.hs | 7 | ||||
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Graph/Main.hs | 4 | ||||
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Graph/Spill.hs | 22 | ||||
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Graph/SpillClean.hs | 29 | ||||
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Graph/SpillCost.hs | 10 | ||||
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Graph/Stats.hs | 12 |
6 files changed, 32 insertions, 52 deletions
diff --git a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs index a5d95a3adf..e0fad17f83 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs @@ -73,8 +73,8 @@ slurpJoinMovs live slurpCmm rs (CmmProc _ _ _ sccs) = foldl' slurpBlock rs (flattenSCCs sccs) slurpBlock rs (BasicBlock _ instrs) = foldl' slurpLI rs instrs - slurpLI rs (Instr _ Nothing) = rs - slurpLI rs (Instr instr (Just live)) + slurpLI rs (LiveInstr _ Nothing) = rs + slurpLI rs (LiveInstr instr (Just live)) | Just (r1, r2) <- takeRegRegMoveInstr instr , elementOfUniqSet r1 $ liveDieRead live , elementOfUniqSet r2 $ liveBorn live @@ -86,8 +86,5 @@ slurpJoinMovs live | otherwise = rs - - slurpLI rs SPILL{} = rs - slurpLI rs RELOAD{} = rs diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs index 40c3c00e5f..093c21159f 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Main.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs @@ -211,8 +211,8 @@ regAlloc_spin <- regSpill code_coalesced slotsFree rsSpill -- recalculate liveness - let code_nat = map stripLive code_spilled - code_relive <- mapM regLiveness code_nat +-- let code_nat = map stripLive code_spilled + code_relive <- mapM regLiveness code_spilled -- record what happened in this stage for debugging let stat = diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs index f9a2586f5a..10bd669054 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs @@ -80,19 +80,11 @@ regSpill_instr => UniqFM Int -> LiveInstr instr -> SpillM [LiveInstr instr] --- | The thing we're spilling shouldn't already have spill or reloads in it -regSpill_instr _ SPILL{} - = panic "regSpill_instr: unexpected SPILL" - -regSpill_instr _ RELOAD{} - = panic "regSpill_instr: unexpected RELOAD" - - -regSpill_instr _ li@(Instr _ Nothing) +regSpill_instr _ li@(LiveInstr _ Nothing) = do return [li] regSpill_instr regSlotMap - (Instr instr (Just _)) + (LiveInstr instr (Just _)) = do -- work out which regs are read and written in this instr let RU rlRead rlWritten = regUsageOfInstr instr @@ -123,7 +115,7 @@ regSpill_instr regSlotMap -- final code let instrs' = prefixes - ++ [Instr instr3 Nothing] + ++ [LiveInstr instr3 Nothing] ++ postfixes return @@ -147,7 +139,7 @@ spillRead regSlotMap instr reg { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) } return ( instr' - , ( [RELOAD slot nReg] + , ( [LiveInstr (RELOAD slot nReg) Nothing] , []) ) | otherwise = panic "RegSpill.spillRead: no slot defined for spilled reg" @@ -162,7 +154,7 @@ spillWrite regSlotMap instr reg return ( instr' , ( [] - , [SPILL nReg slot])) + , [LiveInstr (SPILL nReg slot) Nothing])) | otherwise = panic "RegSpill.spillWrite: no slot defined for spilled reg" @@ -175,8 +167,8 @@ spillModify regSlotMap instr reg { stateSpillSL = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) } return ( instr' - , ( [RELOAD slot nReg] - , [SPILL nReg slot])) + , ( [LiveInstr (RELOAD slot nReg) Nothing] + , [LiveInstr (SPILL nReg slot) Nothing])) | otherwise = panic "RegSpill.spillModify: no slot defined for spilled reg" diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs index 15fbb59e34..11e3cef10f 100644 --- a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs +++ b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs @@ -158,16 +158,16 @@ cleanForward _ _ acc [] -- cleanForward blockId assoc acc (li1 : li2 : instrs) - | SPILL reg1 slot1 <- li1 - , RELOAD slot2 reg2 <- li2 + | 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 : Instr (mkRegRegMoveInstr reg1 reg2) Nothing : instrs) + (li1 : LiveInstr (mkRegRegMoveInstr reg1 reg2) Nothing : instrs) -cleanForward blockId assoc acc (li@(Instr i1 _) : instrs) +cleanForward 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 @@ -187,35 +187,32 @@ cleanForward blockId assoc acc (li@(Instr i1 _) : instrs) cleanForward blockId assoc acc (li : instrs) -- update association due to the spill - | SPILL reg slot <- li + | LiveInstr (SPILL reg slot) _ <- li = let assoc' = addAssoc (SReg reg) (SSlot slot) $ delAssoc (SSlot slot) $ assoc in cleanForward blockId assoc' (li : acc) instrs -- clean a reload instr - | RELOAD{} <- li + | LiveInstr (RELOAD{}) _ <- li = do (assoc', mli) <- cleanReload blockId assoc li case mli of Nothing -> cleanForward blockId assoc' acc instrs Just li' -> cleanForward blockId assoc' (li' : acc) instrs -- remember the association over a jump - | Instr instr _ <- li + | LiveInstr instr _ <- li , targets <- jumpDestsOfInstr instr , not $ null targets = do mapM_ (accJumpValid assoc) targets cleanForward blockId assoc (li : acc) instrs -- writing to a reg changes its value. - | Instr instr _ <- li + | LiveInstr instr _ <- li , RU _ written <- regUsageOfInstr instr = let assoc' = foldr delAssoc assoc (map SReg $ nub written) in cleanForward blockId assoc' (li : acc) instrs --- bogus, to stop pattern match warning -cleanForward _ _ _ _ - = panic "RegAlloc.Graph.SpillClean.cleanForward: no match" -- | Try and rewrite a reload instruction to something more pleasing @@ -227,7 +224,7 @@ cleanReload -> LiveInstr instr -> CleanM (Assoc Store, Maybe (LiveInstr instr)) -cleanReload blockId assoc li@(RELOAD slot reg) +cleanReload 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 @@ -244,7 +241,7 @@ cleanReload blockId assoc li@(RELOAD slot reg) $ delAssoc (SReg reg) $ assoc - return (assoc', Just $ Instr (mkRegRegMoveInstr reg2 reg) Nothing) + return (assoc', Just $ LiveInstr (mkRegRegMoveInstr reg2 reg) Nothing) -- gotta keep this instr | otherwise @@ -306,12 +303,12 @@ cleanBackward' _ _ acc [] cleanBackward' reloadedBy noReloads acc (li : instrs) -- if nothing ever reloads from this slot then we don't need the spill - | SPILL _ slot <- li + | LiveInstr (SPILL _ slot) _ <- li , Nothing <- lookupUFM reloadedBy (SSlot slot) = do modify $ \s -> s { sCleanedSpillsAcc = sCleanedSpillsAcc s + 1 } cleanBackward noReloads acc instrs - | SPILL _ slot <- li + | LiveInstr (SPILL _ slot) _ <- li = if elementOfUniqSet slot noReloads -- we can erase this spill because the slot won't be read until after the next one @@ -325,7 +322,7 @@ cleanBackward' reloadedBy noReloads acc (li : instrs) cleanBackward noReloads' (li : acc) instrs -- if we reload from a slot then it's no longer unused - | RELOAD slot _ <- li + | LiveInstr (RELOAD slot _) _ <- li , noReloads' <- delOneFromUniqSet noReloads slot = cleanBackward noReloads' (li : acc) instrs diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs index 5932d3100d..97995871af 100644 --- a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs +++ b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs @@ -93,13 +93,7 @@ slurpSpillCostInfo cmm = return () -- skip over comment and delta pseudo instrs - countLIs rsLive (SPILL{} : lis) - = countLIs rsLive lis - - countLIs rsLive (RELOAD{} : lis) - = countLIs rsLive lis - - countLIs rsLive (Instr instr Nothing : lis) + countLIs rsLive (LiveInstr instr Nothing : lis) | isMetaInstr instr = countLIs rsLive lis @@ -107,7 +101,7 @@ slurpSpillCostInfo cmm = pprPanic "RegSpillCost.slurpSpillCostInfo" (text "no liveness information on instruction " <> ppr instr) - countLIs rsLiveEntry (Instr instr (Just live) : lis) + countLIs rsLiveEntry (LiveInstr instr (Just live) : lis) = do -- increment the lifetime counts for regs live on entry to this instr mapM_ incLifetime $ uniqSetToList rsLiveEntry diff --git a/compiler/nativeGen/RegAlloc/Graph/Stats.hs b/compiler/nativeGen/RegAlloc/Graph/Stats.hs index 339bd4102a..cdce1b6242 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Stats.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Stats.hs @@ -258,15 +258,15 @@ countSRM_block (BasicBlock i instrs) return $ BasicBlock i instrs' countSRM_instr li - | SPILL _ _ <- li - = do modify $ \(s, r, m) -> (s + 1, r, m) + | LiveInstr SPILL{} _ <- li + = do modify $ \(s, r, m) -> (s + 1, r, m) return li - | RELOAD _ _ <- li - = do modify $ \(s, r, m) -> (s, r + 1, m) + | LiveInstr RELOAD{} _ <- li + = do modify $ \(s, r, m) -> (s, r + 1, m) return li - - | Instr instr _ <- li + + | LiveInstr instr _ <- li , Just _ <- takeRegRegMoveInstr instr = do modify $ \(s, r, m) -> (s, r, m + 1) return li |