[commit: ghc] master: AsmCodeGen.NcgImpl.ncgMakeFarBranches should take account of info tables (#709) (3cedbfb)

[Simon Marlow]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/3cedbfb49996da2f029b4a84ca39f4d21f309813

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

commit 3cedbfb49996da2f029b4a84ca39f4d21f309813
Author: PHO <pho at cielonegro.org>
Date:   Thu Dec 20 08:13:37 2012 +0900

    AsmCodeGen.NcgImpl.ncgMakeFarBranches should take account of info tables (#709)
    
    We have to reduce the maximum number of instructions to jump over depending on the number of info tables in a proc.

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

 compiler/nativeGen/AsmCodeGen.lhs |    8 ++++----
 compiler/nativeGen/PPC/Instr.hs   |   16 +++++++++-------
 2 files changed, 13 insertions(+), 11 deletions(-)

diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 9ab1c4a..71f0264 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -147,7 +147,7 @@ data NcgImpl statics instr jumpDest = NcgImpl {
     ncg_x86fp_kludge          :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],
     ncgExpandTop              :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],
     ncgAllocMoreStack         :: Int -> NatCmmDecl statics instr -> UniqSM (NatCmmDecl statics instr),
-    ncgMakeFarBranches        :: [NatBasicBlock instr] -> [NatBasicBlock instr]
+    ncgMakeFarBranches        :: BlockEnv CmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr]
     }
 
 --------------------
@@ -190,7 +190,7 @@ x86_64NcgImpl dflags
        ,ncg_x86fp_kludge          = id
        ,ncgAllocMoreStack         = X86.Instr.allocMoreStack platform
        ,ncgExpandTop              = id
-       ,ncgMakeFarBranches        = id
+       ,ncgMakeFarBranches        = const id
    }
     where platform = targetPlatform dflags
 
@@ -228,7 +228,7 @@ sparcNcgImpl dflags
        ,ncg_x86fp_kludge          = id
        ,ncgAllocMoreStack         = noAllocMoreStack
        ,ncgExpandTop              = map SPARC.CodeGen.Expand.expandTop
-       ,ncgMakeFarBranches        = id
+       ,ncgMakeFarBranches        = const id
    }
 
 --
@@ -661,7 +661,7 @@ sequenceTop
 
 sequenceTop _       top@(CmmData _ _) = top
 sequenceTop ncgImpl (CmmProc info lbl live (ListGraph blocks)) =
-  CmmProc info lbl live (ListGraph $ ncgMakeFarBranches ncgImpl $ sequenceBlocks info blocks)
+  CmmProc info lbl live (ListGraph $ ncgMakeFarBranches ncgImpl info $ sequenceBlocks info blocks)
 
 -- The algorithm is very simple (and stupid): we make a graph out of
 -- the blocks where there is an edge from one block to another iff the
diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs
index 212d10d..937a427 100644
--- a/compiler/nativeGen/PPC/Instr.hs
+++ b/compiler/nativeGen/PPC/Instr.hs
@@ -32,6 +32,7 @@ import CodeGen.Platform
 import BlockId
 import DynFlags
 import Cmm
+import CmmInfo
 import FastString
 import CLabel
 import Outputable
@@ -515,9 +516,10 @@ ppc_takeRegRegMoveInstr _  = Nothing
 -- big, we have to work around this limitation.
 
 makeFarBranches
-        :: [NatBasicBlock Instr]
+        :: BlockEnv CmmStatics
         -> [NatBasicBlock Instr]
-makeFarBranches blocks
+        -> [NatBasicBlock Instr]
+makeFarBranches info_env blocks
     | last blockAddresses < nearLimit = blocks
     | otherwise = zipWith handleBlock blockAddresses blocks
     where
@@ -536,10 +538,10 @@ makeFarBranches blocks
             where Just targetAddr = lookupUFM blockAddressMap tgt
         makeFar _ other            = other
 
-        nearLimit = 7000 -- 8192 instructions are allowed; let's keep some
-                         -- distance, as we have a few pseudo-insns that are
-                         -- pretty-printed as multiple instructions,
-                         -- and it's just not worth the effort to calculate
-                         -- things exactly
+        -- 8192 instructions are allowed; let's keep some distance, as
+        -- we have a few pseudo-insns that are pretty-printed as
+        -- multiple instructions, and it's just not worth the effort
+        -- to calculate things exactly
+        nearLimit = 7000 - mapSize info_env * maxRetInfoTableSizeW
 
         blockAddressMap = listToUFM $ zip (map blockId blocks) blockAddresses