[commit: ghc] master: When removing unreachable code, remove unreachable info tables too (3f0d453)

[git at git.haskell.org]

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