[commit: ghc] master: Fix loopification with profiling and enable it by default (#8275) (adb9964)

git at git.haskell.org git at git.haskell.org
Sun Dec 1 10:07:17 UTC 2013


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/adb9964e2f97338501411282c0bb6a9f47a56b1b/ghc

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

commit adb9964e2f97338501411282c0bb6a9f47a56b1b
Author: Patrick Palka <patrick at parcs.ath.cx>
Date:   Fri Nov 29 13:40:42 2013 -0500

    Fix loopification with profiling and enable it by default (#8275)


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

adb9964e2f97338501411282c0bb6a9f47a56b1b
 compiler/codeGen/StgCmmBind.hs |    6 ++----
 compiler/main/DynFlags.hs      |    1 +
 2 files changed, 3 insertions(+), 4 deletions(-)

diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index 4762c5a..16477c8 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -31,7 +31,6 @@ import StgCmmForeign    (emitPrimCall)
 import MkGraph
 import CoreSyn          ( AltCon(..) )
 import SMRep
-import BlockId
 import Cmm
 import CmmInfo
 import CmmUtils
@@ -481,8 +480,7 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
                 -- Emit new label that might potentially be a header
                 -- of a self-recursive tail call. See Note
                 -- [Self-recursive tail calls] in StgCmmExpr
-                ; u <- newUnique
-                ; let loop_header_id = mkBlockId u
+                ; loop_header_id <- newLabelC
                 ; emitLabel loop_header_id
                 -- Extend reader monad with information that
                 -- self-recursive tail calls can be optimized into local
@@ -495,7 +493,7 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details
                   tickyEnterFun cl_info
                 ; enterCostCentreFun cc
                     (CmmMachOp (mo_wordSub dflags)
-                         [ CmmReg nodeReg
+                         [ CmmReg (CmmLocal node) -- not nodeReg, see #8275
                          , mkIntExpr dflags (funTag dflags cl_info) ])
                 ; fv_bindings <- mapM bind_fv fv_details
                 -- Load free vars out of closure *after*
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 7c07a36..05a72d6 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -2957,6 +2957,7 @@ optLevelFlags
     , ([0,1,2], Opt_LlvmTBAA)
     , ([1,2],   Opt_CmmSink)
     , ([1,2],   Opt_CmmElimCommonBlocks)
+    , ([1,2],   Opt_Loopification)
 
     , ([0,1,2],     Opt_DmdTxDictSel)
 



More information about the ghc-commits mailing list