Commit 711a51ad authored by Peter Wortmann's avatar Peter Wortmann Committed by Austin Seipp

Add unwind information to Cmm

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)
parent 5fecd767
......@@ -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
......
......@@ -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
......
......@@ -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 ),
......
......@@ -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
......
......@@ -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
......
......@@ -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))) }
......
......@@ -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"
......
......@@ -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))
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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;
......
......@@ -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
......
......@@ -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[] ="
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment