diff options
| author | Simon Marlow <marlowsd@gmail.com> | 2013-07-24 12:49:58 +0100 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2013-07-24 14:30:35 +0100 |
| commit | c23488590cd65fa584ddd648cdbab2fa13f5656b (patch) | |
| tree | 499ed8a8b2cc3ec261f16df03f0c06b1e29aae49 /compiler/cmm/CmmLayoutStack.hs | |
| parent | be89c675339982cb53a5e32d6d282410c9c50f7c (diff) | |
| download | haskell-c23488590cd65fa584ddd648cdbab2fa13f5656b.tar.gz | |
Fix a bug in stack layout with safe foreign calls (#8083)
We weren't properly tracking the number of stack arguments in the
continuation of a foreign call. It happened to work when the
continuation was not a join point, but when it was a join point we
were using the wrong amount of stack fixup.
Diffstat (limited to 'compiler/cmm/CmmLayoutStack.hs')
| -rw-r--r-- | compiler/cmm/CmmLayoutStack.hs | 15 |
1 files changed, 8 insertions, 7 deletions
diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs index acec31ba5e..2b2dccdaed 100644 --- a/compiler/cmm/CmmLayoutStack.hs +++ b/compiler/cmm/CmmLayoutStack.hs @@ -264,7 +264,7 @@ collectContInfo blocks CmmCall { cml_cont = Just l, .. } -> (Just (l, cml_ret_args), cml_ret_off) CmmForeignCall { .. } - -> (Just (succ, 0), updfr) -- ?? + -> (Just (succ, ret_args), ret_off) _other -> (Nothing, 0) @@ -346,8 +346,8 @@ handleLastNode dflags procpoints liveness cont_info stackmaps return $ lastCall cont_lbl cml_args cml_ret_args cml_ret_off CmmForeignCall{ succ = cont_lbl, .. } -> do - return $ lastCall cont_lbl (wORD_SIZE dflags) (wORD_SIZE dflags) (sm_ret_off stack0) - -- one word each for args and results: the return address + return $ lastCall cont_lbl (wORD_SIZE dflags) ret_args ret_off + -- one word of args: the return address CmmBranch{..} -> handleBranches CmmCondBranch{..} -> handleBranches @@ -932,9 +932,10 @@ lowerSafeForeignCall dflags block caller_load <*> loadThreadState dflags load_tso load_stack - (ret_args, regs, copyout) = copyOutOflow dflags NativeReturn Jump (Young succ) - (map (CmmReg . CmmLocal) res) - updfr [] + (_, regs, copyout) = + copyOutOflow dflags NativeReturn Jump (Young succ) + (map (CmmReg . CmmLocal) res) + ret_off [] -- NB. after resumeThread returns, the top-of-stack probably contains -- the stack frame for succ, but it might not: if the current thread @@ -947,7 +948,7 @@ lowerSafeForeignCall dflags block , cml_args_regs = regs , cml_args = widthInBytes (wordWidth dflags) , cml_ret_args = ret_args - , cml_ret_off = updfr } + , cml_ret_off = ret_off } graph' <- lgraphOfAGraph $ suspend <*> midCall <*> |