[commit: ghc] master: Dwarf: Add support for labels in unwind expressions (7186a01)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/7186a01ab4278102ec4e21d3cf67795d51973365/ghc

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

commit 7186a01ab4278102ec4e21d3cf67795d51973365
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Sun Mar 20 17:47:57 2016 +0100

    Dwarf: Add support for labels in unwind expressions
    
    Test Plan: Look at DWARF output.
    
    Reviewers: scpmw, austin
    
    Reviewed By: austin
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D1734


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

7186a01ab4278102ec4e21d3cf67795d51973365
 compiler/cmm/Debug.hs                 | 3 +++
 compiler/nativeGen/Dwarf/Constants.hs | 3 ++-
 compiler/nativeGen/Dwarf/Types.hs     | 1 +
 3 files changed, 6 insertions(+), 1 deletion(-)

diff --git a/compiler/cmm/Debug.hs b/compiler/cmm/Debug.hs
index fa4d645..7b93835 100644
--- a/compiler/cmm/Debug.hs
+++ b/compiler/cmm/Debug.hs
@@ -258,6 +258,7 @@ type UnwindTable = Map.Map GlobalReg UnwindExpr
 data UnwindExpr = UwConst Int                   -- ^ literal value
                 | UwReg GlobalReg Int           -- ^ register plus offset
                 | UwDeref UnwindExpr            -- ^ pointer dereferencing
+                | UwLabel CLabel
                 | UwPlus UnwindExpr UnwindExpr
                 | UwMinus UnwindExpr UnwindExpr
                 | UwTimes UnwindExpr UnwindExpr
@@ -268,6 +269,7 @@ instance Outputable UnwindExpr where
   pprPrec _ (UwReg g 0)     = ppr g
   pprPrec p (UwReg g x)     = pprPrec p (UwPlus (UwReg g 0) (UwConst x))
   pprPrec _ (UwDeref e)     = char '*' <> pprPrec 3 e
+  pprPrec _ (UwLabel l)     = pprPrec 3 l
   pprPrec p (UwPlus e0 e1)  | p <= 0
                             = pprPrec 0 e0 <> char '+' <> pprPrec 0 e1
   pprPrec p (UwMinus e0 e1) | p <= 0
@@ -292,6 +294,7 @@ extractUnwind b = go $ blockToList mid
 -- possible.
 toUnwindExpr :: CmmExpr -> UnwindExpr
 toUnwindExpr (CmmLit (CmmInt i _))       = UwConst (fromIntegral i)
+toUnwindExpr (CmmLit (CmmLabel l))       = UwLabel l
 toUnwindExpr (CmmRegOff (CmmGlobal g) i) = UwReg g i
 toUnwindExpr (CmmReg (CmmGlobal g))      = UwReg g 0
 toUnwindExpr (CmmLoad e _)               = UwDeref (toUnwindExpr e)
diff --git a/compiler/nativeGen/Dwarf/Constants.hs b/compiler/nativeGen/Dwarf/Constants.hs
index 40e4e7d..880c7d7 100644
--- a/compiler/nativeGen/Dwarf/Constants.hs
+++ b/compiler/nativeGen/Dwarf/Constants.hs
@@ -126,9 +126,10 @@ dW_CFA_val_expression     = 0x16
 dW_CFA_offset             = 0x80
 
 -- * Operations
-dW_OP_deref, dW_OP_consts,
+dW_OP_addr, dW_OP_deref, dW_OP_consts,
   dW_OP_minus, dW_OP_mul, dW_OP_plus,
   dW_OP_lit0, dW_OP_breg0, dW_OP_call_frame_cfa :: Word8
+dW_OP_addr           = 0x03
 dW_OP_deref          = 0x06
 dW_OP_consts         = 0x11
 dW_OP_minus          = 0x1c
diff --git a/compiler/nativeGen/Dwarf/Types.hs b/compiler/nativeGen/Dwarf/Types.hs
index e0214e5..0db2419 100644
--- a/compiler/nativeGen/Dwarf/Types.hs
+++ b/compiler/nativeGen/Dwarf/Types.hs
@@ -446,6 +446,7 @@ pprUnwindExpr spIsCFA expr
         pprE (UwReg g i)      = pprByte (dW_OP_breg0+dwarfGlobalRegNo plat g) $$
                                pprLEBInt i
         pprE (UwDeref u)      = pprE u $$ pprByte dW_OP_deref
+        pprE (UwLabel l)      = pprByte dW_OP_addr $$ pprWord (ppr l)
         pprE (UwPlus u1 u2)   = pprE u1 $$ pprE u2 $$ pprByte dW_OP_plus
         pprE (UwMinus u1 u2)  = pprE u1 $$ pprE u2 $$ pprByte dW_OP_minus
         pprE (UwTimes u1 u2)  = pprE u1 $$ pprE u2 $$ pprByte dW_OP_mul