Add unwind information to Cmm
authorPeter Wortmann <scpmw@leeds.ac.uk>
Mon, 13 Oct 2014 23:14:14 +0000 (01:14 +0200)
committerAustin Seipp <austin@well-typed.com>
Tue, 16 Dec 2014 21:02:36 +0000 (15:02 -0600)
Unwind information allows the debugger to discover more information
about a program state, by allowing it to "reconstruct" other states of
the program. In practice, this means that we explain to the debugger
how to unravel stack frames, which comes down mostly to explaining how
to find their Sp and Ip register values.

* We declare yet another new constructor for CmmNode - and this time
  there's actually little choice, as unwind information can and will
  change mid-block. We don't actually make use of these capabilities,
  and back-end support would be tricky (generate new labels?), but it
  feels like the right way to do it.

* Even though we only use it for Sp so far, we allow CmmUnwind to specify
  unwind information for any register. This is pretty cheap and could
  come in useful in future.

* We allow full CmmExpr expressions for specifying unwind values. The
  advantage here is that we don't have to make up new syntax, and can e.g.
  use the WDS macro directly. On the other hand, the back-end will now
  have to simplify the expression until it can sensibly be converted
  into DWARF byte code - a process which might fail, yielding NCG panics.
  On the other hand, when you're writing Cmm by hand you really ought to
  know what you're doing.

(From Phabricator D169)

15 files changed:
compiler/cmm/CmmCommonBlockElim.hs
compiler/cmm/CmmLayoutStack.hs
compiler/cmm/CmmLex.x
compiler/cmm/CmmLint.hs
compiler/cmm/CmmNode.hs
compiler/cmm/CmmParse.y
compiler/cmm/PprCmm.hs
compiler/codeGen/StgCmmMonad.hs
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
compiler/nativeGen/PPC/CodeGen.hs
compiler/nativeGen/SPARC/CodeGen.hs
compiler/nativeGen/X86/CodeGen.hs
rts/Exception.cmm
rts/StgMiscClosures.cmm
utils/genapply/GenApply.hs

index e009ce5..95910d1 100644 (file)
@@ -92,6 +92,7 @@ hash_block block =
 
         hash_node :: CmmNode O x -> Word32
         hash_node n | dont_care n = 0 -- don't care
+        hash_node (CmmUnwind _ e) = hash_e e
         hash_node (CmmAssign r e) = hash_reg r + hash_e e
         hash_node (CmmStore e e') = hash_e e + hash_e e'
         hash_node (CmmUnsafeForeignCall t _ as) = hash_tgt t + hash_list hash_e as
index 7df0af6..8439240 100644 (file)
@@ -794,8 +794,15 @@ 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 to document Sp level for debugging
+    add_unwind_info block
+      | gopt Opt_Debug dflags = CmmUnwind Sp sp_unwind : block
+      | otherwise             = block
+    sp_unwind = CmmRegOff (CmmGlobal Sp) (sp0 - wORD_SIZE dflags)
+
     final_middle = maybeAddSpAdj dflags sp_off $
                    blockFromList $
+                   add_unwind_info $
                    map adj_pre_sp $
                    elimStackStores stack0 stackmaps area_off $
                    middle_pre
index f56db7b..d5a8067 100644 (file)
@@ -160,6 +160,7 @@ data CmmToken
   | CmmT_case
   | CmmT_default
   | CmmT_push
+  | CmmT_unwind
   | CmmT_bits8
   | CmmT_bits16
   | CmmT_bits32
@@ -243,6 +244,7 @@ reservedWordsFM = listToUFM $
         ( "case",               CmmT_case ),
         ( "default",            CmmT_default ),
         ( "push",               CmmT_push ),
+        ( "unwind",             CmmT_unwind ),
         ( "bits8",              CmmT_bits8 ),
         ( "bits16",             CmmT_bits16 ),
         ( "bits32",             CmmT_bits32 ),
index 4ab726e..e593815 100644 (file)
@@ -141,6 +141,7 @@ lintCmmMiddle :: CmmNode O O -> CmmLint ()
 lintCmmMiddle node = case node of
   CmmComment _ -> return ()
   CmmTick _    -> return ()
+  CmmUnwind{}  -> return ()
 
   CmmAssign reg expr -> do
             dflags <- getDynFlags
index 2376b42..b405360 100644 (file)
@@ -52,6 +52,13 @@ data CmmNode e x where
     -- See Note [CmmTick scoping details]
   CmmTick :: !CmmTickish -> CmmNode O O
 
+    -- Unwind pseudo-instruction, encoding stack unwinding
+    -- instructions for a debugger. This describes how to reconstruct
+    -- the "old" value of a register if we want to navigate the stack
+    -- up one frame. Having unwind information for @Sp@ will allow the
+    -- debugger to "walk" the stack.
+  CmmUnwind :: !GlobalReg -> !CmmExpr -> CmmNode O O
+
   CmmAssign :: !CmmReg -> !CmmExpr -> CmmNode O O
     -- Assign to register
 
@@ -449,6 +456,7 @@ mapExp :: (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
 mapExp _ f@(CmmEntry{})                          = f
 mapExp _ m@(CmmComment _)                        = m
 mapExp _ m@(CmmTick _)                           = m
+mapExp f   (CmmUnwind r e)                       = CmmUnwind r (f e)
 mapExp f   (CmmAssign r e)                       = CmmAssign r (f e)
 mapExp f   (CmmStore addr e)                     = CmmStore (f addr) (f e)
 mapExp f   (CmmUnsafeForeignCall tgt fs as)      = CmmUnsafeForeignCall (mapForeignTarget f tgt) fs (map f as)
@@ -479,6 +487,7 @@ mapExpM :: (CmmExpr -> Maybe CmmExpr) -> CmmNode e x -> Maybe (CmmNode e x)
 mapExpM _ (CmmEntry{})              = Nothing
 mapExpM _ (CmmComment _)            = Nothing
 mapExpM _ (CmmTick _)               = Nothing
+mapExpM f (CmmUnwind r e)           = CmmUnwind r `fmap` f e
 mapExpM f (CmmAssign r e)           = CmmAssign r `fmap` f e
 mapExpM f (CmmStore addr e)         = (\[addr', e'] -> CmmStore addr' e') `fmap` mapListM f [addr, e]
 mapExpM _ (CmmBranch _)             = Nothing
@@ -531,6 +540,7 @@ foldExp :: (CmmExpr -> z -> z) -> CmmNode e x -> z -> z
 foldExp _ (CmmEntry {}) z                         = z
 foldExp _ (CmmComment {}) z                       = z
 foldExp _ (CmmTick {}) z                          = z
+foldExp f (CmmUnwind _ e) z                       = f e z
 foldExp f (CmmAssign _ e) z                       = f e z
 foldExp f (CmmStore addr e) z                     = f addr $ f e z
 foldExp f (CmmUnsafeForeignCall t _ as) z         = foldr f (foldExpForeignTarget f t z) as
index c911606..6b51e51 100644 (file)
@@ -325,6 +325,7 @@ import Data.Maybe
         'case'          { L _ (CmmT_case) }
         'default'       { L _ (CmmT_default) }
         'push'          { L _ (CmmT_push) }
+        'unwind'        { L _ (CmmT_unwind) }
         'bits8'         { L _ (CmmT_bits8) }
         'bits16'        { L _ (CmmT_bits16) }
         'bits32'        { L _ (CmmT_bits32) }
@@ -634,6 +635,8 @@ stmt    :: { CmmParse () }
                 { pushStackFrame $3 $5 }
         | 'reserve' expr '=' lreg maybe_body
                 { reserveStackFrame $2 $4 $5 }
+        | 'unwind' GLOBALREG '=' expr
+                { $4 >>= code . emitUnwind $2 }
 
 foreignLabel     :: { CmmParse CmmExpr }
         : NAME                          { return (CmmLit (CmmLabel (mkForeignLabel $1 Nothing ForeignLabelInThisPackage IsFunction))) }
index 2398212..9d9f308 100644 (file)
@@ -195,6 +195,9 @@ pprNode node = pp_node <+> pp_debug
                    then ptext (sLit "//tick") <+> ppr t
                    else empty
 
+      -- unwind reg = expr;
+      CmmUnwind r e -> ptext (sLit "unwind ") <> ppr r <+> char '=' <+> ppr e
+
       -- reg = expr;
       CmmAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
 
@@ -278,6 +281,7 @@ pprNode node = pp_node <+> pp_debug
              CmmEntry {}             -> empty -- Looks terrible with text "  // CmmEntry"
              CmmComment {}           -> empty -- Looks also terrible with text "  // CmmComment"
              CmmTick {}              -> empty
+             CmmUnwind {}            -> text "  // CmmUnwind"
              CmmAssign {}            -> text "  // CmmAssign"
              CmmStore {}             -> text "  // CmmStore"
              CmmUnsafeForeignCall {} -> text "  // CmmUnsafeForeignCall"
index cf78d51..fff8e28 100644 (file)
@@ -20,7 +20,7 @@ module StgCmmMonad (
         emit, emitDecl, emitProc,
         emitProcWithConvention, emitProcWithStackFrame,
         emitOutOfLine, emitAssign, emitStore, emitComment,
-        emitTick,
+        emitTick, emitUnwind,
 
         getCmm, aGraphToGraph,
         getCodeR, getCode, getCodeScoped, getHeapUsage,
@@ -726,6 +726,12 @@ emitComment _ = return ()
 emitTick :: CmmTickish -> FCode ()
 emitTick = emitCgStmt . CgStmt . CmmTick
 
+emitUnwind :: GlobalReg -> CmmExpr -> FCode ()
+emitUnwind g e = do
+  dflags <- getDynFlags
+  when (gopt Opt_Debug dflags) $
+     emitCgStmt $ CgStmt $ CmmUnwind g e
+
 emitAssign :: CmmReg  -> CmmExpr -> FCode ()
 emitAssign l r = emitCgStmt (CgStmt (CmmAssign l r))
 
index 5a2f90a..c7be2c3 100644 (file)
@@ -104,6 +104,7 @@ stmtToInstrs stmt = case stmt of
 
     CmmComment _         -> return (nilOL, []) -- nuke comments
     CmmTick    _         -> return (nilOL, [])
+    CmmUnwind  {}        -> return (nilOL, [])
 
     CmmAssign reg src    -> genAssign reg src
     CmmStore addr src    -> genStore addr src
index c04814d..63a7c18 100644 (file)
@@ -127,6 +127,7 @@ stmtToInstrs stmt = do
   case stmt of
     CmmComment s   -> return (unitOL (COMMENT s))
     CmmTick {}     -> return nilOL
+    CmmUnwind {}   -> return nilOL
 
     CmmAssign reg src
       | isFloatType ty -> assignReg_FltCode size reg src
index 14855ed..bba849d 100644 (file)
@@ -127,6 +127,7 @@ stmtToInstrs stmt = do
   case stmt of
     CmmComment s   -> return (unitOL (COMMENT s))
     CmmTick {}     -> return nilOL
+    CmmUnwind {}   -> return nilOL
 
     CmmAssign reg src
       | isFloatType ty  -> assignReg_FltCode size reg src
index 7c0ba2d..86d4b17 100644 (file)
@@ -146,6 +146,7 @@ stmtToInstrs stmt = do
   case stmt of
     CmmComment s   -> return (unitOL (COMMENT s))
     CmmTick {}     -> return nilOL
+    CmmUnwind {}   -> return nilOL
 
     CmmAssign reg src
       | isFloatType ty         -> assignReg_FltCode size reg src
index e03d53e..5007ef3 100644 (file)
@@ -58,6 +58,7 @@ import ghczmprim_GHCziTypes_True_closure;
 INFO_TABLE_RET(stg_unmaskAsyncExceptionszh_ret, RET_SMALL, W_ info_ptr)
     /* explicit stack */
 {
+    unwind Sp = Sp + WDS(1);
     CInt r;
 
     P_ ret;
index f57fc04..dd25706 100644 (file)
@@ -47,6 +47,7 @@ INFO_TABLE_RET (stg_stack_underflow_frame, UNDERFLOW_FRAME,
 
 INFO_TABLE_RET (stg_restore_cccs, RET_SMALL, W_ info_ptr, W_ cccs)
 {
+    unwind Sp = Sp + WDS(2);
 #if defined(PROFILING)
     CCCS = Sp(1);
 #endif
index 7b84a27..7ff1b87 100644 (file)
@@ -605,6 +605,7 @@ genApply regstatus args =
       nest 4 (vcat [
        text "W_ info;",
        text "W_ arity;",
+       text "unwind Sp = Sp + WDS(" <> int (1+all_args_size) <> text ");",
 
 --    if fast == 1:
 --        print "static void *lbls[] ="