diff options
Diffstat (limited to 'compiler/nativeGen/RegAlloc/Linear')
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs | 13 | ||||
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Linear/Main.hs | 16 | ||||
| -rw-r--r-- | compiler/nativeGen/RegAlloc/Linear/Stats.hs | 2 |
3 files changed, 15 insertions, 16 deletions
diff --git a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs index a9367f9f01..903082fc26 100644 --- a/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs +++ b/compiler/nativeGen/RegAlloc/Linear/JoinToTargets.hs @@ -23,7 +23,7 @@ import Instruction import Reg import BlockId -import Cmm hiding (RegSet) +import OldCmm hiding (RegSet) import Digraph import Outputable import Unique @@ -86,7 +86,7 @@ joinToTargets' block_live new_blocks block_id instr (dest:dests) -- adjust the current assignment to remove any vregs that are not live -- on entry to the destination block. - let Just live_set = lookupBlockEnv block_live dest + let Just live_set = mapLookup dest block_live let still_live uniq _ = uniq `elemUniqSet_Directly` live_set let adjusted_assig = filterUFM_Directly still_live assig @@ -96,7 +96,7 @@ joinToTargets' block_live new_blocks block_id instr (dest:dests) , not (elemUniqSet_Directly reg live_set) , r <- regsOfLoc loc ] - case lookupBlockEnv block_assig dest of + case mapLookup dest block_assig of Nothing -> joinToTargets_first block_live new_blocks block_id instr dest dests @@ -118,8 +118,7 @@ joinToTargets_first block_live new_blocks block_id instr dest dests let freeregs' = foldr releaseReg freeregs to_free -- remember the current assignment on entry to this block. - setBlockAssigR (extendBlockEnv block_assig dest - (freeregs', src_assig)) + setBlockAssigR (mapInsert dest (freeregs', src_assig) block_assig) joinToTargets' block_live new_blocks block_id instr dests @@ -173,7 +172,7 @@ joinToTargets_again -- A the end of the current block we will jump to the fixup one, -- then that will jump to our original destination. fixup_block_id <- getUniqueR - let block = BasicBlock (BlockId fixup_block_id) + let block = BasicBlock (mkBlockId fixup_block_id) $ fixUpInstrs ++ mkJumpInstr dest {- pprTrace @@ -190,7 +189,7 @@ joinToTargets_again -- fixup block instead. _ -> let instr' = patchJumpInstr instr (\bid -> if bid == dest - then BlockId fixup_block_id + then mkBlockId fixup_block_id else dest) in joinToTargets' block_live (block : new_blocks) block_id instr' dests diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs index de771523b9..5fab944e09 100644 --- a/compiler/nativeGen/RegAlloc/Linear/Main.hs +++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs @@ -102,7 +102,7 @@ import Instruction import Reg import BlockId -import Cmm hiding (RegSet) +import OldCmm hiding (RegSet) import Digraph import Unique @@ -132,11 +132,11 @@ regAlloc (CmmData sec d) ( CmmData sec d , Nothing ) -regAlloc (CmmProc (LiveInfo info _ _ _) lbl params []) - = return ( CmmProc info lbl params (ListGraph []) +regAlloc (CmmProc (LiveInfo info _ _ _) lbl []) + = return ( CmmProc info lbl (ListGraph []) , Nothing ) -regAlloc (CmmProc static lbl params sccs) +regAlloc (CmmProc static lbl sccs) | LiveInfo info (Just first_id) (Just block_live) _ <- static = do -- do register allocation on each component. @@ -148,11 +148,11 @@ regAlloc (CmmProc static lbl params sccs) let ((first':_), rest') = partition ((== first_id) . blockId) final_blocks - return ( CmmProc info lbl params (ListGraph (first' : rest')) + return ( CmmProc info lbl (ListGraph (first' : rest')) , Just stats) -- bogus. to make non-exhaustive match warning go away. -regAlloc (CmmProc _ _ _ _) +regAlloc (CmmProc _ _ _) = panic "RegAllocLinear.regAlloc: no match" @@ -228,7 +228,7 @@ process first_id block_live (b@(BasicBlock id _) : blocks) = do block_assig <- getBlockAssigR - if isJust (lookupBlockEnv block_assig id) + if isJust (mapLookup id block_assig) || id == first_id then do b' <- processBlock block_live b @@ -259,7 +259,7 @@ processBlock block_live (BasicBlock id instrs) initBlock :: BlockId -> RegM () initBlock id = do block_assig <- getBlockAssigR - case lookupBlockEnv block_assig id of + case mapLookup id block_assig of -- no prior info about this block: assume everything is -- free and the assignment is empty. Nothing diff --git a/compiler/nativeGen/RegAlloc/Linear/Stats.hs b/compiler/nativeGen/RegAlloc/Linear/Stats.hs index 137168e942..c80f77f893 100644 --- a/compiler/nativeGen/RegAlloc/Linear/Stats.hs +++ b/compiler/nativeGen/RegAlloc/Linear/Stats.hs @@ -10,7 +10,7 @@ import RegAlloc.Linear.Base import RegAlloc.Liveness import Instruction -import Cmm (GenBasicBlock(..)) +import OldCmm (GenBasicBlock(..)) import UniqFM import Outputable |