never executed always true always false
1 {-# LANGUAGE CPP #-}
2 {-# LANGUAGE GADTs #-}
3 {-# LANGUAGE MultiWayIf #-}
4 {-# LANGUAGE MultiParamTypeClasses #-}
5 {-# LANGUAGE FlexibleInstances #-}
6 {-# LANGUAGE FlexibleContexts #-}
7 {-# LANGUAGE UndecidableInstances #-}
8 {-# LANGUAGE LambdaCase #-}
9
10
11 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
12
13 -----------------------------------------------------------------------------
14 --
15 -- Debugging data
16 --
17 -- Association of debug data on the Cmm level, with methods to encode it in
18 -- event log format for later inclusion in profiling event logs.
19 --
20 -----------------------------------------------------------------------------
21
22 module GHC.Cmm.DebugBlock (
23
24 DebugBlock(..),
25 cmmDebugGen,
26 cmmDebugLabels,
27 cmmDebugLink,
28 debugToMap,
29
30 -- * Unwinding information
31 UnwindTable, UnwindPoint(..),
32 UnwindExpr(..), toUnwindExpr
33 ) where
34
35 import GHC.Prelude
36
37 import GHC.Platform
38 import GHC.Cmm.BlockId
39 import GHC.Cmm.CLabel
40 import GHC.Cmm
41 import GHC.Cmm.Utils
42 import GHC.Data.FastString ( nilFS, mkFastString )
43 import GHC.Unit.Module
44 import GHC.Utils.Outputable
45 import GHC.Utils.Panic
46 import GHC.Cmm.Ppr.Expr ( pprExpr )
47 import GHC.Types.SrcLoc
48 import GHC.Types.Tickish
49 import GHC.Utils.Misc ( seqList )
50
51 import GHC.Cmm.Dataflow.Block
52 import GHC.Cmm.Dataflow.Collections
53 import GHC.Cmm.Dataflow.Graph
54 import GHC.Cmm.Dataflow.Label
55
56 import Data.Maybe
57 import Data.List ( minimumBy, nubBy )
58 import Data.Ord ( comparing )
59 import qualified Data.Map as Map
60 import Data.Either ( partitionEithers )
61
62 -- | Debug information about a block of code. Ticks scope over nested
63 -- blocks.
64 data DebugBlock =
65 DebugBlock
66 { dblProcedure :: !Label -- ^ Entry label of containing proc
67 , dblLabel :: !Label -- ^ Hoopl label
68 , dblCLabel :: !CLabel -- ^ Output label
69 , dblHasInfoTbl :: !Bool -- ^ Has an info table?
70 , dblParent :: !(Maybe DebugBlock)
71 -- ^ The parent of this proc. See Note [Splitting DebugBlocks]
72 , dblTicks :: ![CmmTickish] -- ^ Ticks defined in this block
73 , dblSourceTick :: !(Maybe CmmTickish) -- ^ Best source tick covering block
74 , dblPosition :: !(Maybe Int) -- ^ Output position relative to
75 -- other blocks. @Nothing@ means
76 -- the block was optimized out
77 , dblUnwind :: [UnwindPoint]
78 , dblBlocks :: ![DebugBlock] -- ^ Nested blocks
79 }
80
81 instance OutputableP env CLabel => OutputableP env DebugBlock where
82 pdoc env blk =
83 (if | dblProcedure blk == dblLabel blk
84 -> text "proc"
85 | dblHasInfoTbl blk
86 -> text "pp-blk"
87 | otherwise
88 -> text "blk") <+>
89 ppr (dblLabel blk) <+> parens (pdoc env (dblCLabel blk)) <+>
90 (maybe empty ppr (dblSourceTick blk)) <+>
91 (maybe (text "removed") ((text "pos " <>) . ppr)
92 (dblPosition blk)) <+>
93 (pdoc env (dblUnwind blk)) $+$
94 (if null (dblBlocks blk) then empty else nest 4 (pdoc env (dblBlocks blk)))
95
96 -- | Intermediate data structure holding debug-relevant context information
97 -- about a block.
98 type BlockContext = (CmmBlock, RawCmmDecl)
99
100 -- | Extract debug data from a group of procedures. We will prefer
101 -- source notes that come from the given module (presumably the module
102 -- that we are currently compiling).
103 cmmDebugGen :: ModLocation -> RawCmmGroup -> [DebugBlock]
104 cmmDebugGen modLoc decls = map (blocksForScope Nothing) topScopes
105 where
106 blockCtxs :: Map.Map CmmTickScope [BlockContext]
107 blockCtxs = blockContexts decls
108
109 -- Analyse tick scope structure: Each one is either a top-level
110 -- tick scope, or the child of another.
111 (topScopes, childScopes)
112 = partitionEithers $ map (\a -> findP a a) $ Map.keys blockCtxs
113 findP tsc GlobalScope = Left tsc -- top scope
114 findP tsc scp | scp' `Map.member` blockCtxs = Right (scp', tsc)
115 | otherwise = findP tsc scp'
116 where -- Note that we only following the left parent of
117 -- combined scopes. This loses us ticks, which we will
118 -- recover by copying ticks below.
119 scp' | SubScope _ scp' <- scp = scp'
120 | CombinedScope scp' _ <- scp = scp'
121 #if __GLASGOW_HASKELL__ < 901
122 | otherwise = panic "findP impossible"
123 #endif
124
125 scopeMap = foldr (uncurry insertMulti) Map.empty childScopes
126
127 -- This allows us to recover ticks that we lost by flattening
128 -- the graph. Basically, if the parent is A but the child is
129 -- CBA, we know that there is no BA, because it would have taken
130 -- priority - but there might be a B scope, with ticks that
131 -- would not be associated with our child anymore. Note however
132 -- that there might be other childs (DB), which we have to
133 -- filter out.
134 --
135 -- We expect this to be called rarely, which is why we are not
136 -- trying too hard to be efficient here. In many cases we won't
137 -- have to construct blockCtxsU in the first place.
138 ticksToCopy :: CmmTickScope -> [CmmTickish]
139 ticksToCopy (CombinedScope scp s) = go s
140 where go s | scp `isTickSubScope` s = [] -- done
141 | SubScope _ s' <- s = ticks ++ go s'
142 | CombinedScope s1 s2 <- s = ticks ++ go s1 ++ go s2
143 | otherwise = panic "ticksToCopy impossible"
144 where ticks = bCtxsTicks $ fromMaybe [] $ Map.lookup s blockCtxs
145 ticksToCopy _ = []
146 bCtxsTicks = concatMap (blockTicks . fst)
147
148 -- Finding the "best" source tick is somewhat arbitrary -- we
149 -- select the first source span, while preferring source ticks
150 -- from the same source file. Furthermore, dumps take priority
151 -- (if we generated one, we probably want debug information to
152 -- refer to it).
153 bestSrcTick = minimumBy (comparing rangeRating)
154 rangeRating (SourceNote span _)
155 | srcSpanFile span == thisFile = 1
156 | otherwise = 2 :: Int
157 rangeRating note = pprPanic "rangeRating" (ppr note)
158 thisFile = maybe nilFS mkFastString $ ml_hs_file modLoc
159
160 -- Returns block tree for this scope as well as all nested
161 -- scopes. Note that if there are multiple blocks in the (exact)
162 -- same scope we elect one as the "branch" node and add the rest
163 -- as children.
164 blocksForScope :: Maybe CmmTickish -> CmmTickScope -> DebugBlock
165 blocksForScope cstick scope = mkBlock True (head bctxs)
166 where bctxs = fromJust $ Map.lookup scope blockCtxs
167 nested = fromMaybe [] $ Map.lookup scope scopeMap
168 childs = map (mkBlock False) (tail bctxs) ++
169 map (blocksForScope stick) nested
170
171 mkBlock :: Bool -> BlockContext -> DebugBlock
172 mkBlock top (block, prc)
173 = DebugBlock { dblProcedure = g_entry graph
174 , dblLabel = label
175 , dblCLabel = case info of
176 Just (CmmStaticsRaw infoLbl _) -> infoLbl
177 Nothing
178 | g_entry graph == label -> entryLbl
179 | otherwise -> blockLbl label
180 , dblHasInfoTbl = isJust info
181 , dblParent = Nothing
182 , dblTicks = ticks
183 , dblPosition = Nothing -- see cmmDebugLink
184 , dblSourceTick = stick
185 , dblBlocks = blocks
186 , dblUnwind = []
187 }
188 where (CmmProc infos entryLbl _ graph) = prc
189 label = entryLabel block
190 info = mapLookup label infos
191 blocks | top = seqList childs childs
192 | otherwise = []
193
194 -- A source tick scopes over all nested blocks. However
195 -- their source ticks might take priority.
196 isSourceTick SourceNote {} = True
197 isSourceTick _ = False
198 -- Collect ticks from all blocks inside the tick scope.
199 -- We attempt to filter out duplicates while we're at it.
200 ticks = nubBy (flip tickishContains) $
201 bCtxsTicks bctxs ++ ticksToCopy scope
202 stick = case filter isSourceTick ticks of
203 [] -> cstick
204 sticks -> Just $! bestSrcTick (sticks ++ maybeToList cstick)
205
206 -- | Build a map of blocks sorted by their tick scopes
207 --
208 -- This involves a pre-order traversal, as we want blocks in rough
209 -- control flow order (so ticks have a chance to be sorted in the
210 -- right order).
211 blockContexts :: RawCmmGroup -> Map.Map CmmTickScope [BlockContext]
212 blockContexts decls = Map.map reverse $ foldr walkProc Map.empty decls
213 where walkProc :: RawCmmDecl
214 -> Map.Map CmmTickScope [BlockContext]
215 -> Map.Map CmmTickScope [BlockContext]
216 walkProc CmmData{} m = m
217 walkProc prc@(CmmProc _ _ _ graph) m
218 | mapNull blocks = m
219 | otherwise = snd $ walkBlock prc entry (emptyLbls, m)
220 where blocks = toBlockMap graph
221 entry = [mapFind (g_entry graph) blocks]
222 emptyLbls = setEmpty :: LabelSet
223
224 walkBlock :: RawCmmDecl -> [Block CmmNode C C]
225 -> (LabelSet, Map.Map CmmTickScope [BlockContext])
226 -> (LabelSet, Map.Map CmmTickScope [BlockContext])
227 walkBlock _ [] c = c
228 walkBlock prc (block:blocks) (visited, m)
229 | lbl `setMember` visited
230 = walkBlock prc blocks (visited, m)
231 | otherwise
232 = walkBlock prc blocks $
233 walkBlock prc succs
234 (lbl `setInsert` visited,
235 insertMulti scope (block, prc) m)
236 where CmmEntry lbl scope = firstNode block
237 (CmmProc _ _ _ graph) = prc
238 succs = map (flip mapFind (toBlockMap graph))
239 (successors (lastNode block))
240 mapFind = mapFindWithDefault (error "contextTree: block not found!")
241
242 insertMulti :: Ord k => k -> a -> Map.Map k [a] -> Map.Map k [a]
243 insertMulti k v = Map.insertWith (const (v:)) k [v]
244
245 cmmDebugLabels :: (i -> Bool) -> GenCmmGroup d g (ListGraph i) -> [Label]
246 cmmDebugLabels isMeta nats = seqList lbls lbls
247 where -- Find order in which procedures will be generated by the
248 -- back-end (that actually matters for DWARF generation).
249 --
250 -- Note that we might encounter blocks that are missing or only
251 -- consist of meta instructions -- we will declare them missing,
252 -- which will skip debug data generation without messing up the
253 -- block hierarchy.
254 lbls = map blockId $ filter (not . allMeta) $ concatMap getBlocks nats
255 getBlocks (CmmProc _ _ _ (ListGraph bs)) = bs
256 getBlocks _other = []
257 allMeta (BasicBlock _ instrs) = all isMeta instrs
258
259 -- | Sets position and unwind table fields in the debug block tree according to
260 -- native generated code.
261 cmmDebugLink :: [Label] -> LabelMap [UnwindPoint]
262 -> [DebugBlock] -> [DebugBlock]
263 cmmDebugLink labels unwindPts blocks = map link blocks
264 where blockPos :: LabelMap Int
265 blockPos = mapFromList $ flip zip [0..] labels
266 link block = block { dblPosition = mapLookup (dblLabel block) blockPos
267 , dblBlocks = map link (dblBlocks block)
268 , dblUnwind = fromMaybe mempty
269 $ mapLookup (dblLabel block) unwindPts
270 }
271
272 -- | Converts debug blocks into a label map for easier lookups
273 debugToMap :: [DebugBlock] -> LabelMap DebugBlock
274 debugToMap = mapUnions . map go
275 where go b = mapInsert (dblLabel b) b $ mapUnions $ map go (dblBlocks b)
276
277 {-
278 Note [What is this unwinding business?]
279 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
280
281 Unwinding tables are a variety of debugging information used by debugging tools
282 to reconstruct the execution history of a program at runtime. These tables
283 consist of sets of "instructions", one set for every instruction in the program,
284 which describe how to reconstruct the state of the machine at the point where
285 the current procedure was called. For instance, consider the following annotated
286 pseudo-code,
287
288 a_fun:
289 add rsp, 8 -- unwind: rsp = rsp - 8
290 mov rax, 1 -- unwind: rax = unknown
291 call another_block
292 sub rsp, 8 -- unwind: rsp = rsp
293
294 We see that attached to each instruction there is an "unwind" annotation, which
295 provides a relationship between each updated register and its value at the
296 time of entry to a_fun. This is the sort of information that allows gdb to give
297 you a stack backtrace given the execution state of your program. This
298 unwinding information is captured in various ways by various debug information
299 formats; in the case of DWARF (the only format supported by GHC) it is known as
300 Call Frame Information (CFI) and can be found in the .debug.frames section of
301 your object files.
302
303 Currently we only bother to produce unwinding information for registers which
304 are necessary to reconstruct flow-of-execution. On x86_64 this includes $rbp
305 (which is the STG stack pointer) and $rsp (the C stack pointer).
306
307 Let's consider how GHC would annotate a C-- program with unwinding information
308 with a typical C-- procedure as would come from the STG-to-Cmm code generator,
309
310 entry()
311 { c2fe:
312 v :: P64 = R2;
313 if ((Sp + 8) - 32 < SpLim) (likely: False) goto c2ff; else goto c2fg;
314 c2ff:
315 R2 = v :: P64;
316 R1 = test_closure;
317 call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8;
318 c2fg:
319 I64[Sp - 8] = c2dD;
320 R1 = v :: P64;
321 Sp = Sp - 8; // Sp updated here
322 if (R1 & 7 != 0) goto c2dD; else goto c2dE;
323 c2dE:
324 call (I64[R1])(R1) returns to c2dD, args: 8, res: 8, upd: 8;
325 c2dD:
326 w :: P64 = R1;
327 Hp = Hp + 48;
328 if (Hp > HpLim) (likely: False) goto c2fj; else goto c2fi;
329 ...
330 },
331
332 Let's consider how this procedure will be decorated with unwind information
333 (largely by GHC.Cmm.LayoutStack). Naturally, when we enter the procedure `entry` the
334 value of Sp is no different from what it was at its call site. Therefore we will
335 add an `unwind` statement saying this at the beginning of its unwind-annotated
336 code,
337
338 entry()
339 { c2fe:
340 unwind Sp = Just Sp + 0;
341 v :: P64 = R2;
342 if ((Sp + 8) - 32 < SpLim) (likely: False) goto c2ff; else goto c2fg;
343
344 After c2fe we may pass to either c2ff or c2fg; let's first consider the
345 former. In this case there is nothing in particular that we need to do other
346 than reiterate what we already know about Sp,
347
348 c2ff:
349 unwind Sp = Just Sp + 0;
350 R2 = v :: P64;
351 R1 = test_closure;
352 call (stg_gc_fun)(R2, R1) args: 8, res: 0, upd: 8;
353
354 In contrast, c2fg updates Sp midway through its body. To ensure that unwinding
355 can happen correctly after this point we must include an unwind statement there,
356 in addition to the usual beginning-of-block statement,
357
358 c2fg:
359 unwind Sp = Just Sp + 0;
360 I64[Sp - 8] = c2dD;
361 R1 = v :: P64;
362 Sp = Sp - 8;
363 unwind Sp = Just Sp + 8;
364 if (R1 & 7 != 0) goto c2dD; else goto c2dE;
365
366 The remaining blocks are simple,
367
368 c2dE:
369 unwind Sp = Just Sp + 8;
370 call (I64[R1])(R1) returns to c2dD, args: 8, res: 8, upd: 8;
371 c2dD:
372 unwind Sp = Just Sp + 8;
373 w :: P64 = R1;
374 Hp = Hp + 48;
375 if (Hp > HpLim) (likely: False) goto c2fj; else goto c2fi;
376 ...
377 },
378
379
380 The flow of unwinding information through the compiler is a bit convoluted:
381
382 * C-- begins life in StgToCmm without any unwind information. This is because we
383 haven't actually done any register assignment or stack layout yet, so there
384 is no need for unwind information.
385
386 * GHC.Cmm.LayoutStack figures out how to layout each procedure's stack, and produces
387 appropriate unwinding nodes for each adjustment of the STG Sp register.
388
389 * The unwind nodes are carried through the sinking pass. Currently this is
390 guaranteed not to invalidate unwind information since it won't touch stores
391 to Sp, but this will need revisiting if CmmSink gets smarter in the future.
392
393 * Eventually we make it to the native code generator backend which can then
394 preserve the unwind nodes in its machine-specific instructions. In so doing
395 the backend can also modify or add unwinding information; this is necessary,
396 for instance, in the case of x86-64, where adjustment of $rsp may be
397 necessary during calls to native foreign code due to the native calling
398 convention.
399
400 * The NCG then retrieves the final unwinding table for each block from the
401 backend with extractUnwindPoints.
402
403 * This unwind information is converted to DebugBlocks by Debug.cmmDebugGen
404
405 * These DebugBlocks are then converted to, e.g., DWARF unwinding tables
406 (by the Dwarf module) and emitted in the final object.
407
408 See also:
409 Note [Unwinding information in the NCG] in "GHC.CmmToAsm",
410 Note [Unwind pseudo-instruction in Cmm],
411 Note [Debugging DWARF unwinding info].
412
413
414 Note [Debugging DWARF unwinding info]
415 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
416
417 For debugging generated unwinding info I've found it most useful to dump the
418 disassembled binary with objdump -D and dump the debug info with
419 readelf --debug-dump=frames-interp.
420
421 You should get something like this:
422
423 0000000000000010 <stg_catch_frame_info>:
424 10: 48 83 c5 18 add $0x18,%rbp
425 14: ff 65 00 jmpq *0x0(%rbp)
426
427 and:
428
429 Contents of the .debug_frame section:
430
431 00000000 0000000000000014 ffffffff CIE "" cf=1 df=-8 ra=16
432 LOC CFA rbp rsp ra
433 0000000000000000 rbp+0 v+0 s c+0
434
435 00000018 0000000000000024 00000000 FDE cie=00000000 pc=000000000000000f..0000000000000017
436 LOC CFA rbp rsp ra
437 000000000000000f rbp+0 v+0 s c+0
438 000000000000000f rbp+24 v+0 s c+0
439
440 To read it http://www.dwarfstd.org/doc/dwarf-2.0.0.pdf has a nice example in
441 Appendix 5 (page 101 of the pdf) and more details in the relevant section.
442
443 The key thing to keep in mind is that the value at LOC is the value from
444 *before* the instruction at LOC executes. In other words it answers the
445 question: if my $rip is at LOC, how do I get the relevant values given the
446 values obtained through unwinding so far.
447
448 If the readelf --debug-dump=frames-interp output looks wrong, it may also be
449 useful to look at readelf --debug-dump=frames, which is closer to the
450 information that GHC generated.
451
452 It's also useful to dump the relevant Cmm with -ddump-cmm -ddump-opt-cmm
453 -ddump-cmm-proc -ddump-cmm-verbose. Note [Unwind pseudo-instruction in Cmm]
454 explains how to interpret it.
455
456 Inside gdb there are a couple useful commands for inspecting frames.
457 For example:
458
459 gdb> info frame <num>
460
461 It shows the values of registers obtained through unwinding.
462
463 Another useful thing to try when debugging the DWARF unwinding is to enable
464 extra debugging output in GDB:
465
466 gdb> set debug frame 1
467
468 This makes GDB produce a trace of its internal workings. Having gone this far,
469 it's just a tiny step to run GDB in GDB. Make sure you install debugging
470 symbols for gdb if you obtain it through a package manager.
471
472 Keep in mind that the current release of GDB has an instruction pointer handling
473 heuristic that works well for C-like languages, but doesn't always work for
474 Haskell. See Note [Info Offset] in "GHC.CmmToAsm.Dwarf.Types" for more details.
475
476 Note [Unwind pseudo-instruction in Cmm]
477 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
478
479 One of the possible CmmNodes is a CmmUnwind pseudo-instruction. It doesn't
480 generate any assembly, but controls what DWARF unwinding information gets
481 generated.
482
483 It's important to understand what ranges of code the unwind pseudo-instruction
484 refers to.
485 For a sequence of CmmNodes like:
486
487 A // starts at addr X and ends at addr Y-1
488 unwind Sp = Just Sp + 16;
489 B // starts at addr Y and ends at addr Z
490
491 the unwind statement reflects the state after A has executed, but before B
492 has executed. If you consult the Note [Debugging DWARF unwinding info], the
493 LOC this information will end up in is Y.
494 -}
495
496 -- | A label associated with an 'UnwindTable'
497 data UnwindPoint = UnwindPoint !CLabel !UnwindTable
498
499 instance OutputableP env CLabel => OutputableP env UnwindPoint where
500 pdoc env (UnwindPoint lbl uws) =
501 braces $ pdoc env lbl <> colon
502 <+> hsep (punctuate comma $ map pprUw $ Map.toList uws)
503 where
504 pprUw (g, expr) = ppr g <> char '=' <> pdoc env expr
505
506 -- | Maps registers to expressions that yield their "old" values
507 -- further up the stack. Most interesting for the stack pointer @Sp@,
508 -- but might be useful to document saved registers, too. Note that a
509 -- register's value will be 'Nothing' when the register's previous
510 -- value cannot be reconstructed.
511 type UnwindTable = Map.Map GlobalReg (Maybe UnwindExpr)
512
513 -- | Expressions, used for unwind information
514 data UnwindExpr = UwConst !Int -- ^ literal value
515 | UwReg !GlobalReg !Int -- ^ register plus offset
516 | UwDeref UnwindExpr -- ^ pointer dereferencing
517 | UwLabel CLabel
518 | UwPlus UnwindExpr UnwindExpr
519 | UwMinus UnwindExpr UnwindExpr
520 | UwTimes UnwindExpr UnwindExpr
521 deriving (Eq)
522
523 instance OutputableP env CLabel => OutputableP env UnwindExpr where
524 pdoc = pprUnwindExpr 0
525
526 pprUnwindExpr :: OutputableP env CLabel => Rational -> env -> UnwindExpr -> SDoc
527 pprUnwindExpr p env = \case
528 UwConst i -> ppr i
529 UwReg g 0 -> ppr g
530 UwReg g x -> pprUnwindExpr p env (UwPlus (UwReg g 0) (UwConst x))
531 UwDeref e -> char '*' <> pprUnwindExpr 3 env e
532 UwLabel l -> pdoc env l
533 UwPlus e0 e1
534 | p <= 0 -> pprUnwindExpr 0 env e0 <> char '+' <> pprUnwindExpr 0 env e1
535 UwMinus e0 e1
536 | p <= 0 -> pprUnwindExpr 1 env e0 <> char '-' <> pprUnwindExpr 1 env e1
537 UwTimes e0 e1
538 | p <= 1 -> pprUnwindExpr 2 env e0 <> char '*' <> pprUnwindExpr 2 env e1
539 other -> parens (pprUnwindExpr 0 env other)
540
541 -- | Conversion of Cmm expressions to unwind expressions. We check for
542 -- unsupported operator usages and simplify the expression as far as
543 -- possible.
544 toUnwindExpr :: Platform -> CmmExpr -> UnwindExpr
545 toUnwindExpr _ (CmmLit (CmmInt i _)) = UwConst (fromIntegral i)
546 toUnwindExpr _ (CmmLit (CmmLabel l)) = UwLabel l
547 toUnwindExpr _ (CmmRegOff (CmmGlobal g) i) = UwReg g i
548 toUnwindExpr _ (CmmReg (CmmGlobal g)) = UwReg g 0
549 toUnwindExpr platform (CmmLoad e _) = UwDeref (toUnwindExpr platform e)
550 toUnwindExpr platform e@(CmmMachOp op [e1, e2]) =
551 case (op, toUnwindExpr platform e1, toUnwindExpr platform e2) of
552 (MO_Add{}, UwReg r x, UwConst y) -> UwReg r (x + y)
553 (MO_Sub{}, UwReg r x, UwConst y) -> UwReg r (x - y)
554 (MO_Add{}, UwConst x, UwReg r y) -> UwReg r (x + y)
555 (MO_Add{}, UwConst x, UwConst y) -> UwConst (x + y)
556 (MO_Sub{}, UwConst x, UwConst y) -> UwConst (x - y)
557 (MO_Mul{}, UwConst x, UwConst y) -> UwConst (x * y)
558 (MO_Add{}, u1, u2 ) -> UwPlus u1 u2
559 (MO_Sub{}, u1, u2 ) -> UwMinus u1 u2
560 (MO_Mul{}, u1, u2 ) -> UwTimes u1 u2
561 _otherwise -> pprPanic "Unsupported operator in unwind expression!"
562 (pprExpr platform e)
563 toUnwindExpr platform e
564 = pprPanic "Unsupported unwind expression!" (pdoc platform e)