[commit: ghc] master: loadThreadState should set HpAlloc=0 (9f68cce)

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/9f68cceca364600e2ed8d8b4c9e2684eb83549fc

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

commit 9f68cceca364600e2ed8d8b4c9e2684eb83549fc
Author: Simon Marlow <[email protected]>
Date:   Mon Nov 5 14:49:05 2012 +0000

    loadThreadState should set HpAlloc=0

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

 compiler/codeGen/StgCmmForeign.hs |    8 +++++++-
 1 files changed, 7 insertions(+), 1 deletions(-)

diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs
index 7612cd1..aef1e4f 100644
--- a/compiler/codeGen/StgCmmForeign.hs
+++ b/compiler/codeGen/StgCmmForeign.hs
@@ -306,6 +306,11 @@ loadThreadState dflags tso stack = do
         -- SpLim = stack->stack + RESERVED_STACK_WORDS;
         mkAssign spLim (cmmOffsetW dflags (cmmOffset dflags (CmmReg (CmmLocal stack)) (stack_STACK dflags))
                                     (rESERVED_STACK_WORDS dflags)),
+        -- HpAlloc = 0;
+        --   HpAlloc is assumed to be set to non-zero only by a failed
+        --   a heap check, see HeapStackCheck.cmm:GC_GENERIC
+        mkAssign hpAlloc (zeroExpr dflags),
+
         openNursery dflags,
         -- and load the current cost centre stack from the TSO when profiling:
         if gopt Opt_SccProfilingOn dflags then
@@ -367,13 +372,14 @@ stgHp             = CmmReg hp
 stgCurrentTSO     = CmmReg currentTSO
 stgCurrentNursery = CmmReg currentNursery
 
-sp, spLim, hp, hpLim, currentTSO, currentNursery :: CmmReg
+sp, spLim, hp, hpLim, currentTSO, currentNursery, hpAlloc :: CmmReg
 sp                = CmmGlobal Sp
 spLim             = CmmGlobal SpLim
 hp                = CmmGlobal Hp
 hpLim             = CmmGlobal HpLim
 currentTSO        = CmmGlobal CurrentTSO
 currentNursery    = CmmGlobal CurrentNursery
+hpAlloc           = CmmGlobal HpAlloc
 
 -- -----------------------------------------------------------------------------
 -- For certain types passed to foreign calls, we adjust the actual