diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2013-11-22 10:12:55 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2013-11-22 10:13:24 +0000 |
| commit | 3f0d4530a716b6db3c20b63825b56597e08b0d5e (patch) | |
| tree | 8a7741033eaf934f3566be34b3e0f8ee6558a454 /compiler/cmm/CmmContFlowOpt.hs | |
| parent | aebc7e1bfa7f026e6842500032d7cb6a386494b5 (diff) | |
| download | haskell-3f0d4530a716b6db3c20b63825b56597e08b0d5e.tar.gz | |
When removing unreachable code, remove unreachable info tables too
This bug only shows up when you are using proc-point splitting.
What was happening was:
* We generate a proc-point for the stack check
* And an info table
* We eliminate the stack check because it's redundant
* And the dangling info table caused a panic in
CmmBuildInfoTables.bundle
Diffstat (limited to 'compiler/cmm/CmmContFlowOpt.hs')
| -rw-r--r-- | compiler/cmm/CmmContFlowOpt.hs | 31 |
1 files changed, 22 insertions, 9 deletions
diff --git a/compiler/cmm/CmmContFlowOpt.hs b/compiler/cmm/CmmContFlowOpt.hs index 343aa59eca..baef09fc00 100644 --- a/compiler/cmm/CmmContFlowOpt.hs +++ b/compiler/cmm/CmmContFlowOpt.hs @@ -4,7 +4,6 @@ module CmmContFlowOpt ( cmmCfgOpts , cmmCfgOptsProc , removeUnreachableBlocksProc - , removeUnreachableBlocks , replaceLabels ) where @@ -394,11 +393,25 @@ predMap blocks = foldr add_preds mapEmpty blocks -- Removing unreachable blocks removeUnreachableBlocksProc :: CmmDecl -> CmmDecl -removeUnreachableBlocksProc (CmmProc info lbl live g) - = CmmProc info lbl live (removeUnreachableBlocks g) - -removeUnreachableBlocks :: CmmGraph -> CmmGraph -removeUnreachableBlocks g - | length blocks < mapSize (toBlockMap g) = ofBlockList (g_entry g) blocks - | otherwise = g - where blocks = postorderDfs g +removeUnreachableBlocksProc proc@(CmmProc info lbl live g) + | length used_blocks < mapSize (toBlockMap g) + = CmmProc info' lbl live g' + | otherwise + = proc + where + g' = ofBlockList (g_entry g) used_blocks + info' = info { info_tbls = keep_used (info_tbls info) } + -- Remove any info_tbls for unreachable + + keep_used :: BlockEnv CmmInfoTable -> BlockEnv CmmInfoTable + keep_used bs = mapFoldWithKey keep emptyBlockMap bs + + keep :: Label -> CmmInfoTable -> BlockEnv CmmInfoTable -> BlockEnv CmmInfoTable + keep l i env | l `setMember` used_lbls = mapInsert l i env + | otherwise = env + + used_blocks :: [CmmBlock] + used_blocks = postorderDfs g + + used_lbls :: LabelSet + used_lbls = foldr (setInsert . entryLabel) setEmpty used_blocks |