[commit: ghc] master: When removing unreachable code, remove unreachable info tables too (3f0d453)
git at git.haskell.org
git at git.haskell.org
Fri Nov 22 10:13:36 UTC 2013
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/3f0d4530a716b6db3c20b63825b56597e08b0d5e/ghc
>---------------------------------------------------------------
commit 3f0d4530a716b6db3c20b63825b56597e08b0d5e
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Fri Nov 22 10:12:55 2013 +0000
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
>---------------------------------------------------------------
3f0d4530a716b6db3c20b63825b56597e08b0d5e
compiler/cmm/CmmContFlowOpt.hs | 31 ++++++++++++++++++++++---------
1 file changed, 22 insertions(+), 9 deletions(-)
diff --git a/compiler/cmm/CmmContFlowOpt.hs b/compiler/cmm/CmmContFlowOpt.hs
index 343aa59..baef09f 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
More information about the ghc-commits
mailing list