| ... |
... |
@@ -6,20 +6,25 @@ |
|
6
|
6
|
module GHC.ByteCode.Show (showByteCode) where
|
|
7
|
7
|
|
|
8
|
8
|
import Prelude ((+), (-), Integral, div)
|
|
|
9
|
+import Control.Applicative ((<$>), (<*>))
|
|
9
|
10
|
import Control.Arrow ((>>>))
|
|
10
|
11
|
import Control.Exception (assert)
|
|
11
|
12
|
import Data.Eq ((==))
|
|
12
|
13
|
import Data.Bits (FiniteBits, finiteBitSize)
|
|
13
|
|
-import Data.Function (($), (.))
|
|
14
|
|
-import Data.Tuple (uncurry)
|
|
15
|
|
-import Data.Bool (Bool, otherwise, not)
|
|
|
14
|
+import Data.Function (($), id, (.))
|
|
|
15
|
+import Data.Tuple (fst, snd, uncurry)
|
|
|
16
|
+import Data.Bool (Bool, otherwise, not, (&&))
|
|
16
|
17
|
import Data.Int (Int)
|
|
17
|
18
|
import Data.Word (Word, Word16)
|
|
18
|
19
|
import Data.Maybe (Maybe, maybe)
|
|
|
20
|
+import Data.Either (Either, either)
|
|
19
|
21
|
import Data.List (length, (++), map, zipWith, take, drop, replicate)
|
|
20
|
22
|
import Data.String (String)
|
|
21
|
23
|
import Data.ByteString (ByteString, unpack)
|
|
22
|
|
-import Data.Array.IArray (IArray, elems)
|
|
|
24
|
+import Data.ByteString.Short (ShortByteString)
|
|
|
25
|
+import Data.IntMap (IntMap)
|
|
|
26
|
+import Data.IntMap qualified as IntMap (toList)
|
|
|
27
|
+import Data.Array.IArray (IArray, bounds, indices, elems)
|
|
23
|
28
|
import Data.Array.Unboxed (UArray)
|
|
24
|
29
|
import Numeric (showHex)
|
|
25
|
30
|
import Text.Show (show)
|
| ... |
... |
@@ -30,9 +35,13 @@ import GHC.Data.FlatBag (FlatBag, elemsFlatBag) |
|
30
|
35
|
import GHC.Fingerprint (Fingerprint)
|
|
31
|
36
|
import GHC.Types.SrcLoc (noSrcSpan)
|
|
32
|
37
|
import GHC.Types.Name (Name)
|
|
|
38
|
+import GHC.Types.Name.Occurrence (OccName)
|
|
|
39
|
+import GHC.Types.Tickish (BreakTickIndex, BreakpointId (..))
|
|
33
|
40
|
import GHC.Types.SptEntry (SptEntry)
|
|
34
|
41
|
import GHC.Types.Error (MessageClass (MCDump))
|
|
35
|
42
|
import GHC.Utils.Logger (Logger, logMsg)
|
|
|
43
|
+import GHC.Utils.Binary (BinSrcSpan (..))
|
|
|
44
|
+import GHC.Utils.Encoding.UTF8 (utf8DecodeShortByteString)
|
|
36
|
45
|
import GHC.Utils.Outputable
|
|
37
|
46
|
(
|
|
38
|
47
|
defaultDumpStyle,
|
| ... |
... |
@@ -47,6 +56,8 @@ import GHC.Utils.Outputable |
|
47
|
56
|
ppr
|
|
48
|
57
|
)
|
|
49
|
58
|
import GHC.Unit.Types (Module)
|
|
|
59
|
+import GHC.Iface.Type (IfaceType, IfaceTvBndr, IfaceIdBndr)
|
|
|
60
|
+import GHC.HsToCore.Breakpoints (ModBreaks (..))
|
|
50
|
61
|
import GHC.ByteCode.Types
|
|
51
|
62
|
(
|
|
52
|
63
|
FFIInfo (..),
|
| ... |
... |
@@ -56,7 +67,13 @@ import GHC.ByteCode.Types |
|
56
|
67
|
ByteCodeHpcInfo,
|
|
57
|
68
|
CompiledByteCode (..)
|
|
58
|
69
|
)
|
|
59
|
|
-import GHC.ByteCode.Breakpoints (InternalBreakpointId (..), InternalModBreaks)
|
|
|
70
|
+import GHC.ByteCode.Breakpoints
|
|
|
71
|
+ (
|
|
|
72
|
+ InternalBreakpointId (..),
|
|
|
73
|
+ InternalBreakLoc (..),
|
|
|
74
|
+ CgBreakInfo (..),
|
|
|
75
|
+ InternalModBreaks (..)
|
|
|
76
|
+ )
|
|
60
|
77
|
import GHC.ByteCode.Binary (OnDiskModuleByteCode (..))
|
|
61
|
78
|
import GHC.ByteCode.Serialize (readOnDiskModuleByteCode)
|
|
62
|
79
|
import GHC.Driver.Env.Types (HscEnv)
|
| ... |
... |
@@ -95,7 +112,7 @@ pprCompiledByteCode currentModule CompiledByteCode {..} |
|
95
|
112
|
pprByteCodeObjects currentModule $ bc_bcos,
|
|
96
|
113
|
pprDataConstructorInfoTables $ bc_itbls,
|
|
97
|
114
|
pprTopLevelStrings $ bc_strs,
|
|
98
|
|
- pprBreakpoints $ bc_breaks,
|
|
|
115
|
+ pprBreakpoints currentModule $ bc_breaks,
|
|
99
|
116
|
pprStaticPointerTableEntries $ bc_spt_entries,
|
|
100
|
117
|
pprHPCInfo $ bc_hpc_info
|
|
101
|
118
|
]
|
| ... |
... |
@@ -178,7 +195,8 @@ pprLiteral currentModule literal = case literal of |
|
178
|
195
|
BCONPtrFFIInfo ffiInfo
|
|
179
|
196
|
-> text "foreign function" <+> pprFFIInfo ffiInfo
|
|
180
|
197
|
BCONPtrCostCentre breakpointID
|
|
181
|
|
- -> text "cost center" <+> pprBreakpointID currentModule breakpointID
|
|
|
198
|
+ -> text "cost center" <+>
|
|
|
199
|
+ pprInternalBreakpointID currentModule breakpointID
|
|
182
|
200
|
|
|
183
|
201
|
-- | […]
|
|
184
|
202
|
pprFFIInfo :: FFIInfo -> SDoc
|
| ... |
... |
@@ -194,8 +212,8 @@ pprFFIType ffiType = assert (take 3 ident == "FFI") $ text (drop 3 ident) where |
|
194
|
212
|
ident = show ffiType
|
|
195
|
213
|
|
|
196
|
214
|
-- | […]
|
|
197
|
|
-pprBreakpointID :: Module -> InternalBreakpointId -> SDoc
|
|
198
|
|
-pprBreakpointID currentModule InternalBreakpointId {..}
|
|
|
215
|
+pprInternalBreakpointID :: Module -> InternalBreakpointId -> SDoc
|
|
|
216
|
+pprInternalBreakpointID currentModule InternalBreakpointId {..}
|
|
199
|
217
|
| ibi_info_mod == currentModule = indexDoc
|
|
200
|
218
|
| otherwise = indexDoc <+>
|
|
201
|
219
|
text "in" <+>
|
| ... |
... |
@@ -228,19 +246,19 @@ pprPointer currentModule pointer = case pointer of |
|
228
|
246
|
pprDataConstructorInfoTables :: [(Name, ConInfoTable)] -> SDoc
|
|
229
|
247
|
pprDataConstructorInfoTables = entry (text "data constructor info tables:") .
|
|
230
|
248
|
vcatOrNone .
|
|
231
|
|
- map (uncurry pprDataConstructorInfoTableOf)
|
|
|
249
|
+ map (uncurry pprDataConstructorInfoTable)
|
|
232
|
250
|
|
|
233
|
251
|
-- | […]
|
|
234
|
|
-pprDataConstructorInfoTableOf :: Name -> ConInfoTable -> SDoc
|
|
235
|
|
-pprDataConstructorInfoTableOf dataConstrName ConInfoTable {..}
|
|
|
252
|
+pprDataConstructorInfoTable :: Name -> ConInfoTable -> SDoc
|
|
|
253
|
+pprDataConstructorInfoTable dataConstrName ConInfoTable {..}
|
|
236
|
254
|
= entry (text "info table of" <+> ppr dataConstrName <> text ":") $
|
|
237
|
255
|
vcat [
|
|
238
|
|
- pprTablePositioning $ conItblTablesNextToCode,
|
|
239
|
|
- pprLiteralCount $ conItblNPtrs,
|
|
240
|
|
- pprPointerCount $ conItblPtrs,
|
|
241
|
|
- pprConstructorTag $ conItblConTag,
|
|
242
|
|
- pprPointerTag $ conItblPtrTag,
|
|
243
|
|
- pprDescription $ conItblDescr
|
|
|
256
|
+ pprTablePositioning $ conItblTablesNextToCode,
|
|
|
257
|
+ pprPointerWordCount $ conItblPtrs,
|
|
|
258
|
+ pprNonPointerWordCount $ conItblNPtrs,
|
|
|
259
|
+ pprConstructorTag $ conItblConTag,
|
|
|
260
|
+ pprPointerTag $ conItblPtrTag,
|
|
|
261
|
+ pprDescription $ conItblDescr
|
|
244
|
262
|
]
|
|
245
|
263
|
{-FIXME:
|
|
246
|
264
|
Check based on any answers to my message on 4 June 2026, 13:17 EEST whether
|
| ... |
... |
@@ -252,12 +270,12 @@ pprTablePositioning :: Bool -> SDoc |
|
252
|
270
|
pprTablePositioning = entry (text "tables next to code:") . noOrYes
|
|
253
|
271
|
|
|
254
|
272
|
-- | […]
|
|
255
|
|
-pprLiteralCount :: Int -> SDoc
|
|
256
|
|
-pprLiteralCount = entry (text "number of literals:") . ppr
|
|
|
273
|
+pprPointerWordCount :: Int -> SDoc
|
|
|
274
|
+pprPointerWordCount = entry (text "number of words for pointers:") . ppr
|
|
257
|
275
|
|
|
258
|
276
|
-- | […]
|
|
259
|
|
-pprPointerCount :: Int -> SDoc
|
|
260
|
|
-pprPointerCount = entry (text "number of pointers:") . ppr
|
|
|
277
|
+pprNonPointerWordCount :: Int -> SDoc
|
|
|
278
|
+pprNonPointerWordCount = entry (text "number of words for non-pointers:") . ppr
|
|
261
|
279
|
|
|
262
|
280
|
-- | […]
|
|
263
|
281
|
pprConstructorTag :: Int -> SDoc
|
| ... |
... |
@@ -274,17 +292,172 @@ pprDescription = entry (text "description:") . pprByteString |
|
274
|
292
|
-- | […]
|
|
275
|
293
|
pprTopLevelStrings :: [(Name, ByteString)] -> SDoc
|
|
276
|
294
|
pprTopLevelStrings = entry (text "top-level strings:") .
|
|
277
|
|
- pprTopLevelStrings
|
|
|
295
|
+ vcatOrNone .
|
|
|
296
|
+ map (uncurry pprTopLevelString)
|
|
|
297
|
+
|
|
|
298
|
+-- | […]
|
|
|
299
|
+pprTopLevelString :: Name -> ByteString -> SDoc
|
|
|
300
|
+pprTopLevelString stringName encodedString
|
|
|
301
|
+ = entry (text "string" <+> ppr stringName <> text ":") $
|
|
|
302
|
+ pprByteString encodedString
|
|
|
303
|
+
|
|
|
304
|
+-- | […]
|
|
|
305
|
+pprBreakpoints :: Module -> Maybe InternalModBreaks -> SDoc
|
|
|
306
|
+pprBreakpoints currentModule
|
|
|
307
|
+ = entry (text "breakpoints:") .
|
|
|
308
|
+ maybe (text "<none>") (pprBreakpointsData currentModule)
|
|
|
309
|
+
|
|
|
310
|
+-- | […]
|
|
|
311
|
+pprBreakpointsData :: Module -> InternalModBreaks -> SDoc
|
|
|
312
|
+pprBreakpointsData currentModule InternalModBreaks {..}
|
|
|
313
|
+ = vcat [
|
|
|
314
|
+ pprBreakpointsInSource currentModule $ imodBreaks_modBreaks,
|
|
|
315
|
+ pprBreakpointsInByteCode currentModule $ imodBreaks_breakInfo
|
|
|
316
|
+ ]
|
|
|
317
|
+
|
|
|
318
|
+-- | […]
|
|
|
319
|
+pprBreakpointsInSource :: Module -> ModBreaks -> SDoc
|
|
|
320
|
+pprBreakpointsInSource currentModule ModBreaks {..}
|
|
|
321
|
+ = entry (text "breakpoints in source:") $
|
|
|
322
|
+ assert (modBreaks_module == currentModule) $
|
|
|
323
|
+ assert boundsAreIdentical $
|
|
|
324
|
+ vcatOrNone $
|
|
|
325
|
+ pprBreakpointInSource <$> indices modBreaks_locs_ <*>
|
|
|
326
|
+ elems modBreaks_locs_ <*>
|
|
|
327
|
+ elems modBreaks_decls <*>
|
|
|
328
|
+ elems modBreaks_vars <*>
|
|
|
329
|
+ elems modBreaks_ccs
|
|
|
330
|
+ where
|
|
|
331
|
+
|
|
|
332
|
+ boundsAreIdentical :: Bool
|
|
|
333
|
+ boundsAreIdentical = bounds modBreaks_locs_ == bounds modBreaks_decls &&
|
|
|
334
|
+ bounds modBreaks_locs_ == bounds modBreaks_vars &&
|
|
|
335
|
+ bounds modBreaks_locs_ == bounds modBreaks_ccs
|
|
278
|
336
|
|
|
279
|
337
|
-- | […]
|
|
280
|
|
-pprBreakpoints :: Maybe InternalModBreaks -> SDoc
|
|
281
|
|
-pprBreakpoints = entry (text "breakpoints:") .
|
|
282
|
|
- maybe (text "<none>") pprBreakpointsData
|
|
|
338
|
+pprBreakpointInSource :: BreakTickIndex
|
|
|
339
|
+ -> BinSrcSpan
|
|
|
340
|
+ -> [String]
|
|
|
341
|
+ -> [OccName]
|
|
|
342
|
+ -> (ShortByteString, ShortByteString)
|
|
|
343
|
+ -> SDoc
|
|
|
344
|
+pprBreakpointInSource ix srcSpan declarationPath freeVars costCenterInfo
|
|
|
345
|
+ = entry (text "breakpoint" <+> ppr ix <> text ":") $
|
|
|
346
|
+ vcat [
|
|
|
347
|
+ pprSrcSpan $ srcSpan,
|
|
|
348
|
+ pprDeclarationPath $ declarationPath,
|
|
|
349
|
+ pprFreeVariables $ freeVars,
|
|
|
350
|
+ pprCostCenterPath $ costCenterPath,
|
|
|
351
|
+ pprCostCenterLocation $ costCenterLocation
|
|
|
352
|
+ ]
|
|
|
353
|
+ where
|
|
|
354
|
+
|
|
|
355
|
+ costCenterPath :: String
|
|
|
356
|
+ costCenterPath = utf8DecodeShortByteString (fst costCenterInfo)
|
|
|
357
|
+
|
|
|
358
|
+ costCenterLocation :: String
|
|
|
359
|
+ costCenterLocation = utf8DecodeShortByteString (snd costCenterInfo)
|
|
|
360
|
+
|
|
|
361
|
+ -- The structure of the cost center information is apparent from the
|
|
|
362
|
+ -- implementation of 'GHC.HsToCore.Breakpoints.mkModBreaks'.
|
|
283
|
363
|
|
|
284
|
364
|
-- | […]
|
|
285
|
|
-pprBreakpointsData :: InternalModBreaks -> SDoc
|
|
286
|
|
-pprBreakpointsData = pprBreakpointsData
|
|
287
|
|
---FIXME: Either render the module also, or document why this is not necessary.
|
|
|
365
|
+pprSrcSpan :: BinSrcSpan -> SDoc
|
|
|
366
|
+pprSrcSpan = entry (text "source span:") . ppr . unBinSrcSpan
|
|
|
367
|
+
|
|
|
368
|
+-- | […]
|
|
|
369
|
+pprDeclarationPath :: [String] -> SDoc
|
|
|
370
|
+pprDeclarationPath = entry (text "declaration path:") . vcat . map text
|
|
|
371
|
+
|
|
|
372
|
+-- | […]
|
|
|
373
|
+pprFreeVariables :: [OccName] -> SDoc
|
|
|
374
|
+pprFreeVariables = entry (text "free variables:") . hsep . map ppr
|
|
|
375
|
+
|
|
|
376
|
+-- | […]
|
|
|
377
|
+pprCostCenterPath :: String -> SDoc
|
|
|
378
|
+pprCostCenterPath = entry (text "cost center path:") . text
|
|
|
379
|
+
|
|
|
380
|
+-- | […]
|
|
|
381
|
+pprCostCenterLocation :: String -> SDoc
|
|
|
382
|
+pprCostCenterLocation = entry (text "cost center location:") . text
|
|
|
383
|
+
|
|
|
384
|
+-- | […]
|
|
|
385
|
+pprBreakpointsInByteCode :: Module -> IntMap CgBreakInfo -> SDoc
|
|
|
386
|
+pprBreakpointsInByteCode currentModule
|
|
|
387
|
+ = entry (text "breakpoints in bytecode:") .
|
|
|
388
|
+ vcatOrNone .
|
|
|
389
|
+ map (uncurry (pprBreakpointInByteCode currentModule)) .
|
|
|
390
|
+ IntMap.toList
|
|
|
391
|
+
|
|
|
392
|
+-- | […]
|
|
|
393
|
+pprBreakpointInByteCode :: Module -> Int -> CgBreakInfo -> SDoc
|
|
|
394
|
+pprBreakpointInByteCode currentModule ix CgBreakInfo {..}
|
|
|
395
|
+ = entry (text "breakpoint" <+> ppr ix <> text ":") $
|
|
|
396
|
+ vcat [
|
|
|
397
|
+ pprType $ cgb_resty,
|
|
|
398
|
+ pprTypeVariables $ cgb_tyvars,
|
|
|
399
|
+ pprVariables $ cgb_vars,
|
|
|
400
|
+ pprOrigin currentModule $ cgb_tick_id
|
|
|
401
|
+ ]
|
|
|
402
|
+ -- That the 'cgb_resty' field holds the type of the breakpoint is apparent
|
|
|
403
|
+ -- from the fact that this field is set by
|
|
|
404
|
+ -- 'GHC.StgToByteCode.dehydrateCgBreakInfo' using one of its arguments and
|
|
|
405
|
+ -- 'dehydrateCgBreakInfo' is always invoked with this argument set to the
|
|
|
406
|
+ -- extension field of 'Breakpoint', which in turn holds the type of the
|
|
|
407
|
+ -- breakpoint, according to Note [Tickish passes] and the comment on the
|
|
|
408
|
+ -- instance declaration of @XBreakpoint 'TickishPassStg@.
|
|
|
409
|
+
|
|
|
410
|
+pprType :: IfaceType -> SDoc
|
|
|
411
|
+pprType = entry (text "type:") . ppr
|
|
|
412
|
+
|
|
|
413
|
+-- | […]
|
|
|
414
|
+pprTypeVariables :: [IfaceTvBndr] -> SDoc
|
|
|
415
|
+pprTypeVariables = entry (text "type variables:") .
|
|
|
416
|
+ vcat .
|
|
|
417
|
+ map pprTypeVariableBinder
|
|
|
418
|
+
|
|
|
419
|
+-- | […]
|
|
|
420
|
+pprTypeVariableBinder :: IfaceTvBndr -> SDoc
|
|
|
421
|
+pprTypeVariableBinder (name, kind) = ppr name <+> text "::" <+> ppr kind
|
|
|
422
|
+
|
|
|
423
|
+-- | […]
|
|
|
424
|
+pprVariables :: [Maybe (IfaceIdBndr, Word)] -> SDoc
|
|
|
425
|
+pprVariables = entry (text "variables:") .
|
|
|
426
|
+ vcat .
|
|
|
427
|
+ map pprVariable
|
|
|
428
|
+
|
|
|
429
|
+-- | […]
|
|
|
430
|
+pprVariable :: Maybe (IfaceIdBndr, Word) -> SDoc
|
|
|
431
|
+pprVariable = maybe (text "<unknown>") (uncurry pprKnown) where
|
|
|
432
|
+
|
|
|
433
|
+ pprKnown :: IfaceIdBndr -> Word -> SDoc
|
|
|
434
|
+ pprKnown binder offset = pprVariableBinder binder <+>
|
|
|
435
|
+ text "@" <+>
|
|
|
436
|
+ pprFixedSizeNatural offset
|
|
|
437
|
+ -- That the second argument is an offset is apparent from the use of the
|
|
|
438
|
+ -- identifier @offset@ in the implementation of
|
|
|
439
|
+ -- 'GHC.StgToByteCode.dehydrateCgBreakInfo'.
|
|
|
440
|
+
|
|
|
441
|
+-- | […]
|
|
|
442
|
+pprVariableBinder :: IfaceIdBndr -> SDoc
|
|
|
443
|
+pprVariableBinder (multiplicity, name, type_)
|
|
|
444
|
+ = text "%" <> ppr multiplicity <+>
|
|
|
445
|
+ ppr name <+> text "::" <+> ppr type_
|
|
|
446
|
+
|
|
|
447
|
+pprOrigin :: Module -> Either InternalBreakLoc BreakpointId -> SDoc
|
|
|
448
|
+pprOrigin currentModule = entry (text "origin:") .
|
|
|
449
|
+ pprBreakpointID currentModule .
|
|
|
450
|
+ either internalBreakLoc id
|
|
|
451
|
+
|
|
|
452
|
+-- | […] [analogous to 'pprInternalBreakpointID' but the meanging of the index is different]
|
|
|
453
|
+pprBreakpointID :: Module -> BreakpointId -> SDoc
|
|
|
454
|
+pprBreakpointID currentModule BreakpointId {..}
|
|
|
455
|
+ | bi_tick_mod == currentModule = indexDoc
|
|
|
456
|
+ | otherwise = indexDoc <+> text "in" <+> ppr bi_tick_mod
|
|
|
457
|
+ where
|
|
|
458
|
+
|
|
|
459
|
+ indexDoc :: SDoc
|
|
|
460
|
+ indexDoc = ppr bi_tick_index
|
|
288
|
461
|
|
|
289
|
462
|
-- | […]
|
|
290
|
463
|
pprStaticPointerTableEntries :: [SptEntry] -> SDoc
|
| ... |
... |
@@ -304,11 +477,12 @@ pprHPCInfoData = pprHPCInfoData |
|
304
|
477
|
pprObjectFileContents :: [ByteString] -> SDoc
|
|
305
|
478
|
pprObjectFileContents = entry (text "contents of object files:") .
|
|
306
|
479
|
vcatOrNone .
|
|
307
|
|
- zipWith pprContentOfObjectFile [0 ..]
|
|
|
480
|
+ zipWith pprObjectFileContent [0 ..]
|
|
308
|
481
|
|
|
309
|
|
-pprContentOfObjectFile :: Int -> ByteString -> SDoc
|
|
310
|
|
-pprContentOfObjectFile ix = entry (text "file" <+> ppr ix <> text ":") .
|
|
311
|
|
- pprByteString
|
|
|
482
|
+-- | […]
|
|
|
483
|
+pprObjectFileContent :: Int -> ByteString -> SDoc
|
|
|
484
|
+pprObjectFileContent ix = entry (text "file" <+> ppr ix <> text ":") .
|
|
|
485
|
+ pprByteString
|
|
312
|
486
|
|
|
313
|
487
|
-- | […]
|
|
314
|
488
|
pprByteString :: ByteString -> SDoc
|