[commit: ghc] wip/libdw-unwind: Dwarf: Assume first block in a proc has an info table (d7be529)

[git at git.haskell.org]

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

On branch  : wip/libdw-unwind
Link       : http://ghc.haskell.org/trac/ghc/changeset/d7be5290db82e2cdff172aab33af8fab2d01d92d/ghc

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

commit d7be5290db82e2cdff172aab33af8fab2d01d92d
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Thu Nov 26 17:33:10 2015 +0100

    Dwarf: Assume first block in a proc has an info table
    
    If a procedure has an info table we should also assume that its first
    block does lest it will not get the necessary offset to ensure that
    C-debugging tools find valid debug information.
    
    This was manifested as backtrace acquisition entering an infinite loop
    while attempting to unwind `stg_forceIO`, which had invalid call frame
    information on account this bug.
    
    Test Plan: Validate
    
    Reviewers: scpmw, austin
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D1532


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

d7be5290db82e2cdff172aab33af8fab2d01d92d
 compiler/nativeGen/Dwarf.hs | 18 ++++++++++++++++--
 1 file changed, 16 insertions(+), 2 deletions(-)

diff --git a/compiler/nativeGen/Dwarf.hs b/compiler/nativeGen/Dwarf.hs
index 54422ec..7a7acfc 100644
--- a/compiler/nativeGen/Dwarf.hs
+++ b/compiler/nativeGen/Dwarf.hs
@@ -18,6 +18,7 @@ import UniqSupply
 import Dwarf.Constants
 import Dwarf.Types
 
+import Control.Arrow    ( first )
 import Control.Monad    ( mfilter )
 import Data.Maybe
 import Data.List        ( sortBy )
@@ -216,10 +217,15 @@ procToFrame :: UnwindTable -> DebugBlock -> DwarfFrameProc
 procToFrame initUws blk
   = DwarfFrameProc { dwFdeProc    = dblCLabel blk
                    , dwFdeHasInfo = dblHasInfoTbl blk
-                   , dwFdeBlocks  = map (uncurry blockToFrame) blockUws
+                   , dwFdeBlocks  = map (uncurry blockToFrame)
+                                        (first setHasInfo blockUw0 : blockUws)
                    }
   where blockUws :: [(DebugBlock, UnwindTable)]
-        blockUws = map snd $ sortBy (comparing fst) $ flatten initUws blk
+        blockUw0:blockUws = map snd $ sortBy (comparing fst)
+                                    $ flatten initUws blk
+
+        flatten :: UnwindTable -> DebugBlock
+                -> [(Int, (DebugBlock, UnwindTable))]
         flatten uws0 b at DebugBlock{ dblPosition=pos, dblUnwind=uws,
                                    dblBlocks=blocks }
           | Just p <- pos  = (p, (b, uws')):nested
@@ -227,6 +233,14 @@ procToFrame initUws blk
           where uws'   = uws `Map.union` uws0
                 nested = concatMap (flatten uws') blocks
 
+        -- | If the current procedure has an info table, then we also say that
+        -- its first block has one to ensure that it gets the necessary -1
+        -- offset applied to its start address.
+        -- See Note [Info Offset] in Dwarf.Types.
+        setHasInfo :: DebugBlock -> DebugBlock
+        setHasInfo child =
+            child { dblHasInfoTbl = dblHasInfoTbl child || dblHasInfoTbl blk }
+
 blockToFrame :: DebugBlock -> UnwindTable -> DwarfFrameBlock
 blockToFrame blk uws
   = DwarfFrameBlock { dwFdeBlock      = mkAsmTempLabel $ dblLabel blk