diff options
author | Ben.Lippmeier@anu.edu.au <unknown> | 2009-09-17 09:03:35 +0000 |
---|---|---|
committer | Ben.Lippmeier@anu.edu.au <unknown> | 2009-09-17 09:03:35 +0000 |
commit | 028c032b60567b8cd501e9d7248e4aa86088a19b (patch) | |
tree | beab9f04257cb5fcb5c28aac1b3921546ff28100 /compiler | |
parent | 85981a6fc4bb94af433b0b3655c26c5ec4dda1bd (diff) | |
download | haskell-028c032b60567b8cd501e9d7248e4aa86088a19b.tar.gz |
NCG: Add sanity checking to linear allocator
If there are are unreachable basic blocks in the native code then the
linear allocator might loop. Detect this case and panic instead.
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/nativeGen/RegAlloc/Linear/Main.hs | 24 |
1 files changed, 17 insertions, 7 deletions
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs index 229fd32f57..0014eec2d4 100644 --- a/compiler/nativeGen/RegAlloc/Linear/Main.hs +++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs @@ -190,7 +190,7 @@ linearRA_SCCs first_id block_live blocksAcc (AcyclicSCC block : sccs) linearRA_SCCs first_id block_live blocksAcc (CyclicSCC blocks : sccs) = do - blockss' <- process first_id block_live blocks [] (return []) + blockss' <- process first_id block_live blocks [] (return []) False linearRA_SCCs first_id block_live (reverse (concat blockss') ++ blocksAcc) sccs @@ -207,13 +207,21 @@ linearRA_SCCs first_id block_live blocksAcc (CyclicSCC blocks : sccs) more sanity checking to guard against this eventuality. -} -process _ _ [] [] accum +process _ _ [] [] accum _ = return $ reverse accum -process first_id block_live [] next_round accum - = process first_id block_live next_round [] accum +process first_id block_live [] next_round accum madeProgress + | not madeProgress + = pprPanic "RegAlloc.Linear.Main.process: no progress made, bailing out" + ( text "stalled blocks:" + $$ vcat (map ppr next_round)) + + | otherwise + = process first_id block_live + next_round [] accum False -process first_id block_live (b@(BasicBlock id _) : blocks) next_round accum +process first_id block_live (b@(BasicBlock id _) : blocks) + next_round accum madeProgress = do block_assig <- getBlockAssigR @@ -221,9 +229,11 @@ process first_id block_live (b@(BasicBlock id _) : blocks) next_round accum || id == first_id then do b' <- processBlock block_live b - process first_id block_live blocks next_round (b' : accum) + process first_id block_live blocks + next_round (b' : accum) True - else process first_id block_live blocks (b : next_round) accum + else process first_id block_live blocks + (b : next_round) accum madeProgress -- | Do register allocation on this basic block |