Commit 3eb737ee authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

Generalize CmmUnwind and pass unwind information through NCG

As discussed in D1532, Trac Trac #11337, and Trac Trac #11338, the stack
unwinding information produced by GHC is currently quite approximate.
Essentially we assume that register values do not change at all within a
basic block. While this is somewhat true in normal Haskell code, blocks
containing foreign calls often break this assumption. This results in
unreliable call stacks, especially in the code containing foreign calls.
This is worse than it sounds as unreliable unwinding information can at
times result in segmentation faults.

This patch set attempts to improve this situation by tracking unwinding
information with finer granularity. By dispensing with the assumption of
one unwinding table per block, we allow the compiler to accurately
represent the areas surrounding foreign calls.

Towards this end we generalize the representation of unwind information
in the backend in three ways,

 * Multiple CmmUnwind nodes can occur per block

 * CmmUnwind nodes can now carry unwind information for multiple
   registers (while not strictly necessary; this makes emitting
   unwinding information a bit more convenient in the compiler)

 * The NCG backend is given an opportunity to modify the unwinding
   records since it may need to make adjustments due to, for instance,
   native calling convention requirements for foreign calls (see
   #11353).

This sets the stage for resolving #11337 and #11338.

Test Plan: Validate

Reviewers: scpmw, simonmar, austin, erikd

Subscribers: qnikst, thomie

Differential Revision: https://phabricator.haskell.org/D2741
parent 421308ef
......@@ -275,10 +275,11 @@ layout dflags procpoints liveness entry entry_args final_stackmaps final_sp_high
--
let middle_pre = blockToList $ foldl blockSnoc middle1 middle2
final_blocks = manifestSp dflags final_stackmaps stack0 sp0 final_sp_high entry0
middle_pre sp_off last1 fixup_blocks
let final_blocks =
manifestSp dflags final_stackmaps stack0 sp0 final_sp_high
entry0 middle_pre sp_off last1 fixup_blocks
acc_stackmaps' = mapUnion acc_stackmaps out
let acc_stackmaps' = mapUnion acc_stackmaps out
-- If this block jumps to the GC, then we do not take its
-- stack usage into account for the high-water mark.
......@@ -793,19 +794,20 @@ 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 pseudo-instructions at the beginning of each block to
-- document Sp level for debugging
add_unwind_info block
| debugLevel dflags > 0 = CmmUnwind Sp sp_unwind : block
| debugLevel dflags > 0 =
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
final_middle = maybeAddSpAdj dflags sp_off
. blockFromList
. add_unwind_info
. map adj_pre_sp
. elimStackStores stack0 stackmaps area_off
$ middle_pre
final_last = optStackCheck (adj_post_sp last)
final_block = blockJoin first final_middle final_last
......@@ -823,9 +825,9 @@ getAreaOff stackmaps (Young l) =
maybeAddSpAdj :: DynFlags -> ByteOff -> Block CmmNode O O -> Block CmmNode O O
maybeAddSpAdj _ 0 block = block
maybeAddSpAdj dflags sp_off block
= block `blockSnoc` CmmAssign spReg (cmmOffset dflags (CmmReg spReg) sp_off)
maybeAddSpAdj dflags sp_off block = block `blockSnoc` adj
where
adj = CmmAssign spReg (cmmOffset dflags (CmmReg spReg) sp_off)
{-
Sp(L) is the Sp offset on entry to block L relative to the base of the
......
......@@ -61,7 +61,9 @@ data CmmNode e x where
-- 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
--
-- See Note [What is this unwinding business?] in Debug
CmmUnwind :: [(GlobalReg, CmmExpr)] -> CmmNode O O
CmmAssign :: !CmmReg -> !CmmExpr -> CmmNode O O
-- Assign to register
......@@ -459,7 +461,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 (CmmUnwind regs) = CmmUnwind (map (fmap f) regs)
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)
......@@ -490,7 +492,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 (CmmUnwind regs) = CmmUnwind `fmap` mapM (\(r,e) -> f e >>= \e' -> pure (r,e')) regs
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
......@@ -543,7 +545,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 (CmmUnwind xs) z = foldr f z (map snd xs)
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
......
......@@ -635,8 +635,15 @@ stmt :: { CmmParse () }
{ pushStackFrame $3 $5 }
| 'reserve' expr '=' lreg maybe_body
{ reserveStackFrame $2 $4 $5 }
| 'unwind' GLOBALREG '=' expr
{ $4 >>= code . emitUnwind $2 }
| 'unwind' unwind_regs ';'
{ $2 >>= code . emitUnwind }
unwind_regs
:: { CmmParse [(GlobalReg, CmmExpr)] }
: GLOBALREG '=' expr ',' unwind_regs
{ do e <- $3; rest <- $5; return (($1, e) : rest) }
| GLOBALREG '=' expr
{ do e <- $3; return [($1, e)] }
foreignLabel :: { CmmParse CmmExpr }
: NAME { return (CmmLit (CmmLabel (mkForeignLabel $1 Nothing ForeignLabelInThisPackage IsFunction))) }
......
......@@ -12,15 +12,17 @@
module Debug (
DebugBlock(..), dblIsEntry,
UnwindTable, UnwindExpr(..),
cmmDebugGen,
cmmDebugLabels,
cmmDebugLink,
debugToMap
debugToMap,
-- * Unwinding information
UnwindTable, UnwindPoint(..),
UnwindExpr(..), toUnwindExpr
) where
import BlockId ( blockLbl )
import BlockId
import CLabel
import Cmm
import CmmUtils
......@@ -56,7 +58,7 @@ data DebugBlock =
, dblPosition :: !(Maybe Int) -- ^ Output position relative to
-- other blocks. @Nothing@ means
-- the block was optimized out
, dblUnwind :: !UnwindTable -- ^ Unwind information
, dblUnwind :: [UnwindPoint]
, dblBlocks :: ![DebugBlock] -- ^ Nested blocks
}
......@@ -74,14 +76,12 @@ instance Outputable DebugBlock where
(maybe empty ppr (dblSourceTick blk)) <+>
(maybe (text "removed") ((text "pos " <>) . ppr)
(dblPosition blk)) <+>
pprUwMap (dblUnwind blk) $$
(ppr (dblUnwind blk)) <+>
(if null (dblBlocks blk) then empty else ppr (dblBlocks blk))
where pprUw (g, expr) = ppr g <> char '=' <> ppr expr
pprUwMap = braces . hsep . punctuate comma . map pprUw . Map.toList
-- | Intermediate data structure holding debug-relevant context information
-- about a block.
type BlockContext = (CmmBlock, RawCmmDecl, UnwindTable)
type BlockContext = (CmmBlock, RawCmmDecl)
-- | Extract debug data from a group of procedures. We will prefer
-- source notes that come from the given module (presumably the module
......@@ -127,7 +127,7 @@ cmmDebugGen modLoc decls = map (blocksForScope Nothing) topScopes
| otherwise = panic "ticksToCopy impossible"
where ticks = bCtxsTicks $ fromMaybe [] $ Map.lookup s blockCtxs
ticksToCopy _ = []
bCtxsTicks = concatMap (blockTicks . fstOf3)
bCtxsTicks = concatMap (blockTicks . fst)
-- Finding the "best" source tick is somewhat arbitrary -- we
-- select the first source span, while preferring source ticks
......@@ -151,7 +151,9 @@ cmmDebugGen modLoc decls = map (blocksForScope Nothing) topScopes
nested = fromMaybe [] $ Map.lookup scope scopeMap
childs = map (mkBlock False) (tail bctxs) ++
map (blocksForScope stick) nested
mkBlock top (block, prc, unwind)
mkBlock :: Bool -> BlockContext -> DebugBlock
mkBlock top (block, prc)
= DebugBlock { dblProcedure = g_entry graph
, dblLabel = label
, dblCLabel = case info of
......@@ -163,9 +165,9 @@ cmmDebugGen modLoc decls = map (blocksForScope Nothing) topScopes
, dblParent = Nothing
, dblTicks = ticks
, dblPosition = Nothing -- see cmmDebugLink
, dblUnwind = unwind
, dblSourceTick = stick
, dblBlocks = blocks
, dblUnwind = []
}
where (CmmProc infos entryLbl _ graph) = prc
label = entryLabel block
......@@ -189,29 +191,33 @@ cmmDebugGen modLoc decls = map (blocksForScope Nothing) topScopes
--
-- This involves a pre-order traversal, as we want blocks in rough
-- control flow order (so ticks have a chance to be sorted in the
-- right order). We also use this opportunity to have blocks inherit
-- unwind information from their predecessor blocks where it is
-- lacking.
-- right order).
blockContexts :: RawCmmGroup -> Map.Map CmmTickScope [BlockContext]
blockContexts decls = Map.map reverse $ foldr walkProc Map.empty decls
where walkProc CmmData{} m = m
where walkProc :: RawCmmDecl
-> Map.Map CmmTickScope [BlockContext]
-> Map.Map CmmTickScope [BlockContext]
walkProc CmmData{} m = m
walkProc prc@(CmmProc _ _ _ graph) m
| mapNull blocks = m
| otherwise = snd $ walkBlock prc entry Map.empty (emptyLbls, m)
| otherwise = snd $ walkBlock prc entry (emptyLbls, m)
where blocks = toBlockMap graph
entry = [mapFind (g_entry graph) blocks]
emptyLbls = setEmpty :: LabelSet
walkBlock _ [] _ c = c
walkBlock prc (block:blocks) unwind (visited, m)
walkBlock :: RawCmmDecl -> [Block CmmNode C C]
-> (LabelSet, Map.Map CmmTickScope [BlockContext])
-> (LabelSet, Map.Map CmmTickScope [BlockContext])
walkBlock _ [] c = c
walkBlock prc (block:blocks) (visited, m)
| lbl `setMember` visited
= walkBlock prc blocks unwind (visited, m)
= walkBlock prc blocks (visited, m)
| otherwise
= walkBlock prc blocks unwind $
walkBlock prc succs unwind'
= walkBlock prc blocks $
walkBlock prc succs
(lbl `setInsert` visited,
insertMulti scope (block, prc, unwind') m)
insertMulti scope (block, prc) m)
where CmmEntry lbl scope = firstNode block
unwind' = extractUnwind block `Map.union` unwind
(CmmProc _ _ _ graph) = prc
succs = map (flip mapFind (toBlockMap graph))
(successors (lastNode block))
......@@ -234,14 +240,17 @@ cmmDebugLabels isMeta nats = seqList lbls lbls
getBlocks _other = []
allMeta (BasicBlock _ instrs) = all isMeta instrs
-- | Sets position fields in the debug block tree according to native
-- generated code.
cmmDebugLink :: [Label] -> [DebugBlock] -> [DebugBlock]
cmmDebugLink labels blocks = map link blocks
-- | Sets position and unwind table fields in the debug block tree according to
-- native generated code.
cmmDebugLink :: [Label] -> LabelMap [UnwindPoint]
-> [DebugBlock] -> [DebugBlock]
cmmDebugLink labels unwindPts blocks = map link blocks
where blockPos :: LabelMap Int
blockPos = mapFromList $ flip zip [0..] labels
link block = block { dblPosition = mapLookup (dblLabel block) blockPos
, dblBlocks = map link (dblBlocks block)
, dblUnwind = fromMaybe mempty
$ mapLookup (dblLabel block) unwindPts
}
-- | Converts debug blocks into a label map for easier lookups
......@@ -249,14 +258,158 @@ debugToMap :: [DebugBlock] -> LabelMap DebugBlock
debugToMap = mapUnions . map go
where go b = mapInsert (dblLabel b) b $ mapUnions $ map go (dblBlocks b)
{-
Note [What is this unwinding business?]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Unwinding tables are a variety of debugging information used by debugging tools
to reconstruct the execution history of a program at runtime. These tables
consist of sets of "instructions", one set for every instruction in the program,
which describe how to reconstruct the state of the machine at the point where
the current procedure was called. For instance, consider the following annotated
pseudo-code,
a_fun:
add rsp, 8 -- unwind: rsp = rsp - 8
mov rax, 1 -- unwind: rax = unknown
call another_block
sub rsp, 8 -- unwind: rsp = rsp
We see that attached to each instruction there is an "unwind" annotation, which
provides a relationship between each updated register and its value at the
time of entry to a_fun. This is the sort of information that allows gdb to give
you a stack backtrace given the execution state of your program. This
unwinding information is captured in various ways by various debug information
formats; in the case of DWARF (the only format supported by GHC) it is known as
Call Frame Information (CFI) and can be found in the .debug.frames section of
your object files.
Currently we only bother to produce unwinding information for registers which
are necessary to reconstruct flow-of-execution. On x86_64 this includes $rbp
(which is the STG stack pointer) and $rsp (the C stack pointer).
Let's consider how GHC would annotate a C-- program with unwinding information
with a typical C-- procedure as would come from the STG-to-Cmm code generator,
entry()
{ c2fe:
v :: P64 = R2;
if ((Sp + 8) - 32 < SpLim) (likely: False) goto c2ff; else goto c2fg;
c2ff:
R2 = v :: P64;
R1 = test_closure;
call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8;
c2fg:
I64[Sp - 8] = c2dD;
R1 = v :: P64;
Sp = Sp - 8; // Sp updated here
if (R1 & 7 != 0) goto c2dD; else goto c2dE;
c2dE:
call (I64[R1])(R1) returns to c2dD, args: 8, res: 8, upd: 8;
c2dD:
w :: P64 = R1;
Hp = Hp + 48;
if (Hp > HpLim) (likely: False) goto c2fj; else goto c2fi;
...
},
Let's consider how this procedure will be decorated with unwind information
(largely by CmmLayoutStack). Naturally, when we enter the procedure `entry` the
value of Sp is no different from what it was at its call site. Therefore we will
add an `unwind` statement saying this at the beginning of its unwind-annotated
code,
entry()
{ c2fe:
unwind Sp = Just Sp + 0;
v :: P64 = R2;
if ((Sp + 8) - 32 < SpLim) (likely: False) goto c2ff; else goto c2fg;
After c2fe we we may pass to either c2ff or c2fg; let's first consider the
former. In this case there is nothing in particular that we need to do other
than reiterate what we already know about Sp,
c2ff:
unwind Sp = Just Sp + 0;
R2 = v :: P64;
R1 = test_closure;
call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8;
In contrast, c2fg updates Sp midway through its body. To ensure that unwinding
can happen correctly after this point we must include an unwind statement there,
in addition to the usual beginning-of-block statement,
c2fg:
unwind Sp = Just Sp + 0;
I64[Sp - 8] = c2dD;
R1 = v :: P64;
unwind Sp = Just Sp + 8;
Sp = Sp - 8;
if (R1 & 7 != 0) goto c2dD; else goto c2dE;
The remaining blocks are simple,
c2dE:
unwind Sp = Just Sp + 8;
call (I64[R1])(R1) returns to c2dD, args: 8, res: 8, upd: 8;
c2dD:
unwind Sp = Just Sp + 8;
w :: P64 = R1;
Hp = Hp + 48;
if (Hp > HpLim) (likely: False) goto c2fj; else goto c2fi;
...
},
The flow of unwinding information through the compiler is a bit convoluted:
* C-- begins life in StgCmm without any unwind information. This is because we
haven't actually done any register assignment or stack layout yet, so there
is no need for unwind information.
* CmmLayoutStack figures out how to layout each procedure's stack, and produces
appropriate unwinding nodes for each adjustment of the STG Sp register.
* The unwind nodes are carried through the sinking pass. Currently this is
guaranteed not to invalidate unwind information since it won't touch stores
to Sp, but this will need revisiting if CmmSink gets smarter in the future.
* Eventually we make it to the native code generator backend which can then
preserve the unwind nodes in its machine-specific instructions. In so doing
the backend can also modify or add unwinding information; this is necessary,
for instance, in the case of x86-64, where adjustment of $rsp may be
necessary during calls to native foreign code due to the native calling
convention.
* The NCG then retrieves the final unwinding table for each block from the
backend with extractUnwindPoints.
* This unwind information is converted to DebugBlocks by Debug.cmmDebugGen
* These DebugBlcosk are then converted to, e.g., DWARF unwinding tables
(by the Dwarf module) and emitted in the final object.
See also: Note [Unwinding information in the NCG] in AsmCodeGen.
-}
-- | A label associated with an 'UnwindTable'
data UnwindPoint = UnwindPoint !Label !UnwindTable
instance Outputable UnwindPoint where
ppr (UnwindPoint lbl uws) =
braces $ ppr lbl<>colon
<+> hsep (punctuate comma $ map pprUw $ Map.toList uws)
where
pprUw (g, expr) = ppr g <> char '=' <> ppr expr
-- | Maps registers to expressions that yield their "old" values
-- further up the stack. Most interesting for the stack pointer Sp,
-- but might be useful to document saved registers, too.
type UnwindTable = Map.Map GlobalReg UnwindExpr
-- | Expressions, used for unwind information
data UnwindExpr = UwConst Int -- ^ literal value
| UwReg GlobalReg Int -- ^ register plus offset
data UnwindExpr = UwConst !Int -- ^ literal value
| UwReg !GlobalReg !Int -- ^ register plus offset
| UwDeref UnwindExpr -- ^ pointer dereferencing
| UwLabel CLabel
| UwPlus UnwindExpr UnwindExpr
......@@ -278,17 +431,6 @@ instance Outputable UnwindExpr where
= pprPrec 2 e0 <> char '*' <> pprPrec 2 e1
pprPrec _ other = parens (pprPrec 0 other)
extractUnwind :: CmmBlock -> UnwindTable
extractUnwind b = go $ blockToList mid
where (_, mid, _) = blockSplit b
go :: [CmmNode O O] -> UnwindTable
go [] = Map.empty
go (x : xs) = case x of
CmmUnwind g so -> Map.insert g (toUnwindExpr so) $! go xs
CmmTick {} -> go xs
_other -> Map.empty
-- TODO: Unwind statements after actual instructions
-- | Conversion of Cmm expressions to unwind expressions. We check for
-- unsupported operator usages and simplify the expression as far as
-- possible.
......
......@@ -14,6 +14,7 @@ module MkGraph
, mkRawJump
, mkCbranch, mkSwitch
, mkReturn, mkComment, mkCallEntry, mkBranch
, mkUnwind
, copyInOflow, copyOutOflow
, noExtraStack
, toCall, Transfer(..)
......@@ -270,6 +271,8 @@ mkJumpReturnsTo dflags f callConv actuals ret_lbl ret_off updfr_off = do
mkUnsafeCall :: ForeignTarget -> [CmmFormal] -> [CmmActual] -> CmmAGraph
mkUnsafeCall t fs as = mkMiddle $ CmmUnsafeForeignCall t fs as
mkUnwind :: GlobalReg -> CmmExpr -> CmmAGraph
mkUnwind r e = mkMiddle $ CmmUnwind [(r, e)]
--------------------------------------------------------------------------
......
......@@ -197,7 +197,9 @@ pprNode node = pp_node <+> pp_debug
else empty
-- unwind reg = expr;
CmmUnwind r e -> text "unwind " <> ppr r <+> char '=' <+> ppr e
CmmUnwind regs ->
text "unwind "
<> commafy (map (\(r,e) -> ppr r <+> char '=' <+> ppr e) regs) <> semi
-- reg = expr;
CmmAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
......
......@@ -84,10 +84,10 @@ baseRegOffset dflags HpAlloc = oFFSET_StgRegTable_rHpAlloc dflags
baseRegOffset dflags EagerBlackholeInfo = oFFSET_stgEagerBlackholeInfo dflags
baseRegOffset dflags GCEnter1 = oFFSET_stgGCEnter1 dflags
baseRegOffset dflags GCFun = oFFSET_stgGCFun dflags
baseRegOffset _ BaseReg = panic "baseRegOffset:BaseReg"
baseRegOffset _ PicBaseReg = panic "baseRegOffset:PicBaseReg"
baseRegOffset _ MachSp = panic "baseRegOffset:MachSp"
baseRegOffset _ UnwindReturnReg = panic "baseRegOffset:UnwindReturnReg"
baseRegOffset _ BaseReg = panic "CgUtils.baseRegOffset:BaseReg"
baseRegOffset _ PicBaseReg = panic "CgUtils.baseRegOffset:PicBaseReg"
baseRegOffset _ MachSp = panic "CgUtils.baseRegOffset:MachSp"
baseRegOffset _ UnwindReturnReg = panic "CgUtils.baseRegOffset:UnwindReturnReg"
-- -----------------------------------------------------------------------------
......@@ -137,7 +137,11 @@ fixStgRegStmt dflags stmt = fixAssign $ mapExpDeep fixExpr stmt
fixAssign stmt =
case stmt of
CmmAssign (CmmGlobal reg) src ->
CmmAssign (CmmGlobal reg) src
-- MachSp isn't an STG register; it's merely here for tracking unwind
-- information
| reg == MachSp -> stmt
| otherwise ->
let baseAddr = get_GlobalReg_addr dflags reg
in case reg `elem` activeStgRegs (targetPlatform dflags) of
True -> CmmAssign (CmmGlobal reg) src
......@@ -145,6 +149,8 @@ fixStgRegStmt dflags stmt = fixAssign $ mapExpDeep fixExpr stmt
other_stmt -> other_stmt
fixExpr expr = case expr of
-- MachSp isn't an STG; it's merely here for tracking unwind information
CmmReg (CmmGlobal MachSp) -> expr
CmmReg (CmmGlobal reg) ->
-- Replace register leaves with appropriate StixTrees for
-- the given target. MagicIds which map to a reg on this
......
......@@ -735,11 +735,11 @@ emitComment _ = return ()
emitTick :: CmmTickish -> FCode ()
emitTick = emitCgStmt . CgStmt . CmmTick
emitUnwind :: GlobalReg -> CmmExpr -> FCode ()
emitUnwind g e = do
emitUnwind :: [(GlobalReg, CmmExpr)] -> FCode ()
emitUnwind regs = do
dflags <- getDynFlags
when (debugLevel dflags > 0) $
emitCgStmt $ CgStmt $ CmmUnwind g e
when (debugLevel dflags > 0) $ do
emitCgStmt $ CgStmt $ CmmUnwind regs
emitAssign :: CmmReg -> CmmExpr -> FCode ()
emitAssign l r = emitCgStmt (CgStmt (CmmAssign l r))
......
......@@ -298,7 +298,7 @@ baseRegOffset dflags CurrentNursery = oFFSET_StgRegTable_rCurrentNursery dflags
baseRegOffset dflags HpAlloc = oFFSET_StgRegTable_rHpAlloc dflags
baseRegOffset dflags GCEnter1 = oFFSET_stgGCEnter1 dflags
baseRegOffset dflags GCFun = oFFSET_stgGCFun dflags
baseRegOffset _ reg = pprPanic "baseRegOffset:" (ppr reg)
baseRegOffset _ reg = pprPanic "StgCmmUtils.baseRegOffset:" (ppr reg)
-------------------------------------------------------------------------
--
......
......@@ -162,7 +162,13 @@ data NcgImpl statics instr jumpDest = NcgImpl {
ncg_x86fp_kludge :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],
ncgExpandTop :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],
ncgAllocMoreStack :: Int -> NatCmmDecl statics instr -> UniqSM (NatCmmDecl statics instr),
ncgMakeFarBranches :: LabelMap CmmStatics -> [NatBasicBlock instr] -> [NatBasicBlock instr]
ncgMakeFarBranches :: LabelMap CmmStatics
-> [NatBasicBlock instr] -> [NatBasicBlock instr],
extractUnwindPoints :: [instr] -> [UnwindPoint]
-- ^ given the instruction sequence of a block, produce a list of
-- the block's 'UnwindPoint's
-- See Note [What is this unwinding business?] in Debug
-- and Note [Unwinding information in the NCG] in this module.
}
--------------------
......@@ -209,6 +215,7 @@ x86_64NcgImpl dflags
,ncgAllocMoreStack = X86.Instr.allocMoreStack platform
,ncgExpandTop = id
,ncgMakeFarBranches = const id
,extractUnwindPoints = X86.CodeGen.extractUnwindPoints
}
where platform = targetPlatform dflags
......@@ -228,6 +235,7 @@ ppcNcgImpl dflags
,ncgAllocMoreStack = PPC.Instr.allocMoreStack platform
,ncgExpandTop = id
,ncgMakeFarBranches = PPC.Instr.makeFarBranches
,extractUnwindPoints = const []
}
where platform = targetPlatform dflags
......@@ -247,6 +255,7 @@ sparcNcgImpl dflags
,ncgAllocMoreStack = noAllocMoreStack
,ncgExpandTop = map SPARC.CodeGen.Expand.expandTop
,ncgMakeFarBranches = const id
,extractUnwindPoints = const []
}
--
......@@ -279,8 +288,36 @@ data NativeGenAcc statics instr
, ngs_labels :: ![Label]
, ngs_debug :: ![DebugBlock]
, ngs_dwarfFiles :: !DwarfFiles
, ngs_unwinds :: !(LabelMap [UnwindPoint])
-- ^ see Note [Unwinding information in the NCG]
-- and Note [What is this unwinding business?] in Debug.
}
{-
Note [Unwinding information in the NCG]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Unwind information is a type of metadata which allows a debugging tool
to reconstruct the values of machine registers at the time a procedure was
entered. For the most part, the production of unwind information is handled by
the Cmm stage, where it is represented by CmmUnwind nodes.
Unfortunately, the Cmm stage doesn't know everything necessary to produce
accurate unwinding information. For instance, the x86-64 calling convention
requires that the stack pointer be aligned to 16 bytes, which in turn means that
GHC must sometimes add padding to $sp prior to performing a foreign call. When
this happens unwind information must be updated accordingly.
For this reason, we make the NCG backends responsible for producing
unwinding tables (with the extractUnwindPoints function in NcgImpl).
We accumulate the produced unwind tables over CmmGroups in the ngs_unwinds
field of NativeGenAcc. This is a label map which contains an entry for each
procedure, containing a list of unwinding points (e.g. a label and an associated
unwinding table).
See also Note [What is this unwinding business?] in Debug.
-}
nativeCodeGen' :: (Outputable statics, Outputable instr, Instruction instr)
=> DynFlags
-> Module -> ModLocation
......@@ -295,7 +332,7 @@ nativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms
-- Pretty if it weren't for the fact that we do lots of little
-- printDocs here (in order to do codegen in constant space).
bufh <- newBufHandle h
let ngs0 = NGS [] [] [] [] [] [] emptyUFM
let ngs0 = NGS [] [] [] [] [] [] emptyUFM mapEmpty
(ngs, us') <- cmmNativeGenStream dflags this_mod modLoc ncgImpl bufh us
cmms ngs0
finishNativeGen dflags modLoc bufh us' ngs
......@@ -386,11 +423,12 @@ cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs
ofBlockList (panic "split_marker_entry") []
cmms' | splitObjs = split_marker : cmms
| otherwise = cmms
(ngs',us') <- cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap us
cmms' ngs 0
(ngs',us') <- cmmNativeGens dflags this_mod modLoc ncgImpl h
dbgMap us cmms' ngs 0
-- Link native code information into debug blocks
let !ldbgs = cmmDebugLink (ngs_labels ngs') ndbgs
-- See Note [What is this unwinding business?] in Debug.
let !ldbgs = cmmDebugLink (ngs_labels ngs') (ngs_unwinds ngs') ndbgs
dumpIfSet_dyn dflags Opt_D_dump_debug "Debug Infos"
(vcat $ map ppr ldbgs)
......@@ -430,7 +468,8 @@ cmmNativeGens :: forall statics instr jumpDest.
cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap = go
where
go :: UniqSupply -> [RawCmmDecl] -> NativeGenAcc statics instr -> Int
go :: UniqSupply -> [RawCmmDecl]