[commit: ghc] master: CmmLayoutStack: Add unwind information on stack fixups (733e845)

[git at git.haskell.org]

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

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

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

commit 733e845d0f66541a06415c6b420e51fc99eb9d95
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Tue Feb 7 22:51:50 2017 -0500

    CmmLayoutStack: Add unwind information on stack fixups
    
    Currently stack fixup blocks don't include unwinding information,
    leaving a small window where our unwinding information is incorrect. Fix
    this by adding unwinding information to emitted fixup blocks.
    
    Reviewers: scpmw, simonmar, austin
    
    Reviewed By: simonmar
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D2742


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

733e845d0f66541a06415c6b420e51fc99eb9d95
 compiler/cmm/CmmLayoutStack.hs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs
index 60f8970..fbd1d71 100644
--- a/compiler/cmm/CmmLayoutStack.hs
+++ b/compiler/cmm/CmmLayoutStack.hs
@@ -528,8 +528,16 @@ makeFixupBlock dflags sp0 l stack tscope assigs
   | otherwise = do
     tmp_lbl <- newBlockId
     let sp_off = sp0 - sm_sp stack
+        maybeAddUnwind block
+          | debugLevel dflags > 0
+          = block `blockSnoc` CmmUnwind [(Sp, unwind_val)]
+          | otherwise
+          = block
+          where unwind_val = cmmOffset dflags (CmmReg spReg) (sm_sp stack)
         block = blockJoin (CmmEntry tmp_lbl tscope)
-                          (maybeAddSpAdj dflags sp_off (blockFromList assigs))
+                          (  maybeAddSpAdj dflags sp_off
+                           $ maybeAddUnwind
+                           $ blockFromList assigs )
                           (CmmBranch l)
     return (tmp_lbl, [block])