[commit: ghc] master: Mimic OldCmm basic block ordering in the LLVM backend. (b39e4de)

[Geoffrey Mainland]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/b39e4de19a0aa3cbc42d72a02f83cec77f48f3a0

>---------------------------------------------------------------

commit b39e4de19a0aa3cbc42d72a02f83cec77f48f3a0
Author: Geoffrey Mainland <gmainlan at microsoft.com>
Date:   Wed Jan 16 16:06:48 2013 +0000

    Mimic OldCmm basic block ordering in the LLVM backend.
    
    In OldCmm, the false case of a conditional was a fallthrough. In Cmm,
    conditionals have both true and false successors. When we convert Cmm to LLVM,
    we now first re-order Cmm blocks so that the false successor of a conditional
    occurs next in the list of basic blocks, i.e., it is a fallthrough, just like it
    (necessarily) did in OldCmm. Surprisingly, this can make a big performance
    difference.

>---------------------------------------------------------------

 compiler/cmm/CmmUtils.hs                |   31 ++++++++++++++++++++++++++++++-
 compiler/llvmGen/LlvmCodeGen/CodeGen.hs |    2 +-
 2 files changed, 31 insertions(+), 2 deletions(-)

diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index 435df58..5530b77 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -52,7 +52,8 @@ module CmmUtils(
         modifyGraph,
 
         ofBlockMap, toBlockMap, insertBlock,
-        ofBlockList, toBlockList, bodyToBlockList, toBlockListEntryFirst,
+        ofBlockList, toBlockList, bodyToBlockList,
+        toBlockListEntryFirst, toBlockListEntryFirstFalseFallthrough,
         foldGraphBlocks, mapGraphNodes, postorderDfs, mapGraphNodes1,
 
         analFwd, analBwd, analRewFwd, analRewBwd,
@@ -448,6 +449,34 @@ toBlockListEntryFirst g
     Just entry_block = mapLookup entry_id m
     others = filter ((/= entry_id) . entryLabel) (mapElems m)
 
+-- | Like 'toBlockListEntryFirst', but we strive to ensure that we order blocks
+-- so that the false case of a conditional jumps to the next block in the output
+-- list of blocks. This matches the way OldCmm blocks were output since in
+-- OldCmm the false case was a fallthrough, whereas in Cmm conditional branches
+-- have both true and false successors. Block ordering can make a big difference
+-- in performance in the LLVM backend. Note that we rely crucially on the order
+-- of successors returned for CmmCondBranch by the NonLocal instance for CmmNode
+-- defind in cmm/CmmNode.hs. -GBM
+toBlockListEntryFirstFalseFallthrough :: CmmGraph -> [CmmBlock]
+toBlockListEntryFirstFalseFallthrough g
+  | mapNull m  = []
+  | otherwise  = dfs setEmpty [entry_block]
+  where
+    m = toBlockMap g
+    entry_id = g_entry g
+    Just entry_block = mapLookup entry_id m
+
+    dfs :: LabelSet -> [CmmBlock] -> [CmmBlock]
+    dfs _ [] = []
+    dfs visited (block:bs)
+      | id `setMember` visited = dfs visited bs
+      | otherwise              = block : dfs (setInsert id visited) bs'
+      where id = entryLabel block
+            bs' = foldr add_id bs (successors block)
+            add_id id bs = case mapLookup id m of
+                              Just b  -> b : bs
+                              Nothing -> bs
+
 ofBlockList :: BlockId -> [CmmBlock] -> CmmGraph
 ofBlockList entry blocks = CmmGraph { g_entry = entry
                                     , g_graph = GMany NothingO body NothingO }
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index 609be3d..9159817 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -40,7 +40,7 @@ type LlvmStatements = OrdList LlvmStatement
 --
 genLlvmProc :: LlvmEnv -> RawCmmDecl -> UniqSM (LlvmEnv, [LlvmCmmDecl])
 genLlvmProc env (CmmProc infos lbl live graph) = do
-    let blocks = toBlockListEntryFirst graph
+    let blocks = toBlockListEntryFirstFalseFallthrough graph
     (env', lmblocks, lmdata) <- basicBlocksCodeGen env live blocks ([], [])
     let info = mapLookup (g_entry graph) infos
         proc = CmmProc info lbl live (ListGraph lmblocks)