[commit: ghc] master: CmmLayoutStack: Correctly annotate Sp adjustments with unwinding information (5279b08)

[git at git.haskell.org]

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

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

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

commit 5279b08ba3f01e4b7e28d12b2751413d789d9fbe
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Tue Feb 7 22:58:48 2017 -0500

    CmmLayoutStack: Correctly annotate Sp adjustments with unwinding information
    
    Test Plan: Validate
    
    Reviewers: austin, simonmar
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D3104


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

5279b08ba3f01e4b7e28d12b2751413d789d9fbe
 compiler/cmm/CmmLayoutStack.hs | 21 ++++++++++++++++-----
 1 file changed, 16 insertions(+), 5 deletions(-)

diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs
index f59daad..9051845 100644
--- a/compiler/cmm/CmmLayoutStack.hs
+++ b/compiler/cmm/CmmLayoutStack.hs
@@ -802,18 +802,29 @@ manifestSp dflags stackmaps stack0 sp0 sp_high
     adj_pre_sp  = mapExpDeep (areaToSp dflags sp0            sp_high area_off)
     adj_post_sp = mapExpDeep (areaToSp dflags (sp0 - sp_off) sp_high area_off)
 
-    -- Add unwind pseudo-instructions at the beginning of each block to
+    -- Add unwind pseudo-instruction at the beginning of each block to
     -- document Sp level for debugging
-    add_unwind_info block
+    add_initial_unwind block
       | debugLevel dflags > 0
-      = CmmUnwind [(Sp, Just sp_unwind)] : block
+      = CmmUnwind [(Sp, Just sp_unwind)] `blockCons` block
       | otherwise
       = block
-    sp_unwind = CmmRegOff (CmmGlobal Sp) (sp0 - wORD_SIZE dflags)
+      where sp_unwind = CmmRegOff spReg (sp0 - wORD_SIZE dflags)
+
+    -- Add unwind pseudo-instruction right before the Sp adjustment
+    -- if there is one.
+    add_adj_unwind block
+      | debugLevel dflags > 0
+      , sp_off /= 0
+      = block `blockSnoc` CmmUnwind [(Sp, Just sp_unwind)]
+      | otherwise
+      = block
+      where sp_unwind = CmmRegOff spReg (sp0 - wORD_SIZE dflags - sp_off)
 
     final_middle = maybeAddSpAdj dflags sp_off
+                 . add_adj_unwind
+                 . add_initial_unwind
                  . blockFromList
-                 . add_unwind_info
                  . map adj_pre_sp
                  . elimStackStores stack0 stackmaps area_off
                  $ middle_pre