[commit: ghc] master: Continue by jumping to the top-of-stack after a safe foreign call (f67a8b8)

[Simon Marlow]

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

On branch  : master

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

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

commit f67a8b859b4b5a94d06572e24c1947af0d3f5649
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Fri Aug 3 11:24:27 2012 +0100

    Continue by jumping to the top-of-stack after a safe foreign call

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

 compiler/cmm/CmmLayoutStack.hs |   12 +++++++-----
 1 files changed, 7 insertions(+), 5 deletions(-)

diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs
index d2fffab..02c90e6 100644
--- a/compiler/cmm/CmmLayoutStack.hs
+++ b/compiler/cmm/CmmLayoutStack.hs
@@ -897,7 +897,7 @@ live across the call.  Our job now is to expand the call so we get
  | BaseReg = resumeThread(token)
  | LOAD_THREAD_STATE()
  | R1 = r  -- copyOut
- | jump L1
+ | jump Sp[0]
  '-----------------------
  L1:
    r = R1 -- copyIn, inserted by mkSafeCall
@@ -928,15 +928,17 @@ lowerSafeForeignCall dflags block
                   mkAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base)) <*>
                   caller_load <*>
                   loadThreadState dflags load_tso load_stack
-        -- Note: The successor must be a procpoint, and we have already split,
-        --       so we use a jump, not a branch.
-        succLbl = CmmLit (CmmLabel (infoTblLbl succ))
 
         (ret_args, regs, copyout) = copyOutOflow NativeReturn Jump (Young succ)
                                            (map (CmmReg . CmmLocal) res)
                                            updfr (0, [])
 
-        jump = CmmCall { cml_target    = succLbl
+        -- NB. after resumeThread returns, the top-of-stack probably contains
+        -- the stack frame for succ, but it might not: if the current thread
+        -- received an exception during the call, then the stack might be
+        -- different.  Hence we continue by jumping to the top stack frame,
+        -- not by jumping to succ.
+        jump = CmmCall { cml_target    = CmmLoad (CmmReg spReg) bWord
                        , cml_cont      = Just succ
                        , cml_args_regs = regs
                        , cml_args      = widthInBytes wordWidth