| ... |
... |
@@ -10,14 +10,15 @@ import Data.Function (($), (&), (.)) |
|
10
|
10
|
import Data.Bool (otherwise)
|
|
11
|
11
|
import Data.Int (Int)
|
|
12
|
12
|
import Data.Word (Word8)
|
|
13
|
|
-import Data.Maybe (maybe)
|
|
|
13
|
+import Data.Maybe (Maybe, maybe)
|
|
14
|
14
|
import Data.List (map, zipWith)
|
|
15
|
15
|
import Data.String (String)
|
|
16
|
16
|
import Data.ByteString (ByteString, null, unpack)
|
|
17
|
17
|
import Numeric (showHex)
|
|
18
|
18
|
import System.IO (IO, FilePath)
|
|
19
|
|
-import GHC.Data.Strict qualified as Strict (maybe)
|
|
|
19
|
+import GHC.Data.Strict qualified as Strict (Maybe, maybe)
|
|
20
|
20
|
import GHC.Data.FlatBag (elemsFlatBag)
|
|
|
21
|
+import GHC.Fingerprint (Fingerprint)
|
|
21
|
22
|
import GHC.Types.SrcLoc (noSrcSpan)
|
|
22
|
23
|
import GHC.Types.Name (Name)
|
|
23
|
24
|
import GHC.Types.SptEntry (SptEntry)
|
| ... |
... |
@@ -57,74 +58,111 @@ pprOnDiskModuleByteCode :: OnDiskModuleByteCode -> SDoc |
|
57
|
58
|
pprOnDiskModuleByteCode OnDiskModuleByteCode {..}
|
|
58
|
59
|
= multiLineEntry (text "module" <+> ppr odgbc_module) $
|
|
59
|
60
|
vcat [
|
|
60
|
|
- singleLineEntry
|
|
61
|
|
- (text "hash:")
|
|
62
|
|
- (ppr odgbc_hash),
|
|
63
|
|
- multiLineEntry
|
|
64
|
|
- (text "compiled bytecode:")
|
|
65
|
|
- (pprCompiledByteCode odgbc_compiled_byte_code),
|
|
66
|
|
- multiLineEntry
|
|
67
|
|
- (text "contents of object files:")
|
|
68
|
|
- (pprObjectFileContents odgbc_foreign)
|
|
|
61
|
+ pprHash odgbc_hash,
|
|
|
62
|
+ pprCompiledByteCode odgbc_compiled_byte_code,
|
|
|
63
|
+ pprObjectFileContents odgbc_foreign
|
|
69
|
64
|
]
|
|
70
|
65
|
|
|
|
66
|
+-- | […]
|
|
|
67
|
+pprHash :: Fingerprint -> SDoc
|
|
|
68
|
+pprHash hash = singleLineEntry (text "hash:") (ppr hash)
|
|
|
69
|
+
|
|
71
|
70
|
-- | […]
|
|
72
|
71
|
pprCompiledByteCode :: CompiledByteCode -> SDoc
|
|
73
|
72
|
pprCompiledByteCode CompiledByteCode {..}
|
|
74
|
|
- = vcat
|
|
75
|
|
- [
|
|
76
|
|
- multiLineEntry
|
|
77
|
|
- (text "bytecode objects")
|
|
78
|
|
- (pprByteCodeObjects (elemsFlatBag bc_bcos)),
|
|
79
|
|
- multiLineEntry
|
|
80
|
|
- (text "data constructor info tables:")
|
|
81
|
|
- (pprDataConstructorInfoTables bc_itbls),
|
|
82
|
|
- multiLineEntry
|
|
83
|
|
- (text "top-level strings:")
|
|
84
|
|
- (pprTopLevelStrings bc_strs),
|
|
85
|
|
- multiLineEntry
|
|
86
|
|
- (text "break points:")
|
|
87
|
|
- (maybe (text "<none>") pprInternalBreakPoints bc_breaks),
|
|
88
|
|
- multiLineEntry
|
|
89
|
|
- (text "static-pointer table entries:")
|
|
90
|
|
- (pprStaticPointerTableEntries bc_spt_entries),
|
|
91
|
|
- multiLineEntry
|
|
92
|
|
- (text "HPC information:")
|
|
93
|
|
- (Strict.maybe (text "<none>") pprHPCInfo bc_hpc_info)
|
|
94
|
|
- ]
|
|
|
73
|
+ = multiLineEntry (text "compiled bytecode:") $
|
|
|
74
|
+ vcat [
|
|
|
75
|
+ pprByteCodeObjects (elemsFlatBag bc_bcos),
|
|
|
76
|
+ pprDataConstructorInfoTables bc_itbls,
|
|
|
77
|
+ pprTopLevelStrings bc_strs,
|
|
|
78
|
+ pprBreakPoints bc_breaks,
|
|
|
79
|
+ pprStaticPointerTableEntries bc_spt_entries,
|
|
|
80
|
+ pprHPCInfo bc_hpc_info
|
|
|
81
|
+ ]
|
|
95
|
82
|
|
|
96
|
83
|
-- | […]
|
|
97
|
84
|
pprByteCodeObjects :: [UnlinkedBCO] -> SDoc
|
|
98
|
|
-pprByteCodeObjects = vcatOrNone . map pprByteCodeObject
|
|
|
85
|
+pprByteCodeObjects = multiLineEntry (text "bytecode objects:") .
|
|
|
86
|
+ vcatOrNone .
|
|
|
87
|
+ map pprByteCodeObject
|
|
99
|
88
|
|
|
100
|
89
|
-- | […]
|
|
101
|
90
|
pprByteCodeObject :: UnlinkedBCO -> SDoc
|
|
102
|
|
-pprByteCodeObject {- UnlinkedBCO {..} -}
|
|
103
|
|
- = pprByteCodeObject
|
|
|
91
|
+pprByteCodeObject UnlinkedBCO {..}
|
|
|
92
|
+ = multiLineEntry (text "ordinary bytecode object:") $
|
|
|
93
|
+ vcat [
|
|
|
94
|
+ {-
|
|
|
95
|
+ unlinkedBCOName :: !Name,
|
|
|
96
|
+ unlinkedBCOArity :: {-# UNPACK #-} !Int,
|
|
|
97
|
+ unlinkedBCOInstrs :: !(BCOByteArray Word16), -- insns
|
|
|
98
|
+ unlinkedBCOBitmap :: !(BCOByteArray Word), -- bitmap
|
|
|
99
|
+ unlinkedBCOLits :: !(FlatBag BCONPtr), -- non-ptrs
|
|
|
100
|
+ unlinkedBCOPtrs :: !(FlatBag BCOPtr) -- ptrs
|
|
|
101
|
+ -}
|
|
|
102
|
+ ]
|
|
|
103
|
+pprByteCodeObject UnlinkedStaticCon {..}
|
|
|
104
|
+ = multiLineEntry (text "static constructor object:") $
|
|
|
105
|
+ vcat [
|
|
|
106
|
+ {-
|
|
|
107
|
+ unlinkedStaticConName :: !Name,
|
|
|
108
|
+ -- ^ The name to which this static constructor is bound, not to be
|
|
|
109
|
+ -- confused with the name of the static constructor itself
|
|
|
110
|
+ -- ('unlinkedStaticConDataConName')
|
|
|
111
|
+ unlinkedStaticConDataConName :: !Name,
|
|
|
112
|
+ unlinkedStaticConLits :: !(FlatBag BCONPtr),
|
|
|
113
|
+ -- ^ non-ptrs full words, where sub-word literals have already been
|
|
|
114
|
+ -- packed into full words as needed
|
|
|
115
|
+ unlinkedStaticConPtrs :: !(FlatBag BCOPtr), -- ptrs
|
|
|
116
|
+ unlinkedStaticConIsUnlifted :: !Bool
|
|
|
117
|
+ -}
|
|
|
118
|
+ ]
|
|
104
|
119
|
|
|
105
|
120
|
-- | […]
|
|
106
|
121
|
pprDataConstructorInfoTables :: [(Name, ConInfoTable)] -> SDoc
|
|
107
|
|
-pprDataConstructorInfoTables = pprDataConstructorInfoTables
|
|
|
122
|
+pprDataConstructorInfoTables
|
|
|
123
|
+ = multiLineEntry (text "data constructor info tables:") .
|
|
|
124
|
+ pprDataConstructorInfoTables
|
|
108
|
125
|
|
|
109
|
126
|
-- | […]
|
|
110
|
127
|
pprTopLevelStrings :: [(Name, ByteString)] -> SDoc
|
|
111
|
|
-pprTopLevelStrings = pprTopLevelStrings
|
|
|
128
|
+pprTopLevelStrings = multiLineEntry (text "top-level strings:") .
|
|
|
129
|
+ pprTopLevelStrings
|
|
|
130
|
+
|
|
|
131
|
+-- | […]
|
|
|
132
|
+pprBreakPoints :: Maybe InternalModBreaks -> SDoc
|
|
|
133
|
+pprBreakPoints = multiLineEntry (text "break points:") .
|
|
|
134
|
+ maybe (text "<none>") pprBreakPointsData
|
|
112
|
135
|
|
|
113
|
136
|
-- | […]
|
|
114
|
|
-pprInternalBreakPoints :: InternalModBreaks -> SDoc
|
|
115
|
|
-pprInternalBreakPoints = pprInternalBreakPoints
|
|
|
137
|
+pprBreakPointsData :: InternalModBreaks -> SDoc
|
|
|
138
|
+pprBreakPointsData = pprBreakPointsData
|
|
|
139
|
+{-FIMXE:
|
|
|
140
|
+ Instead of outputting module perhaps assert that it is identical to the
|
|
|
141
|
+ present one (if this indeed how it should be).
|
|
|
142
|
+-}
|
|
116
|
143
|
|
|
117
|
144
|
-- | […]
|
|
118
|
145
|
pprStaticPointerTableEntries :: [SptEntry] -> SDoc
|
|
119
|
|
-pprStaticPointerTableEntries = pprStaticPointerTableEntries
|
|
|
146
|
+pprStaticPointerTableEntries
|
|
|
147
|
+ = multiLineEntry (text "static-pointer table entries:") .
|
|
|
148
|
+ pprStaticPointerTableEntries
|
|
|
149
|
+
|
|
|
150
|
+-- | […]
|
|
|
151
|
+pprHPCInfo :: Strict.Maybe ByteCodeHpcInfo -> SDoc
|
|
|
152
|
+pprHPCInfo = multiLineEntry (text "HPC information:") .
|
|
|
153
|
+ Strict.maybe (text "<none>") pprHPCInfoData
|
|
120
|
154
|
|
|
121
|
155
|
-- | […]
|
|
122
|
|
-pprHPCInfo :: ByteCodeHpcInfo -> SDoc
|
|
123
|
|
-pprHPCInfo = pprHPCInfo
|
|
|
156
|
+pprHPCInfoData :: ByteCodeHpcInfo -> SDoc
|
|
|
157
|
+pprHPCInfoData = pprHPCInfoData
|
|
124
|
158
|
|
|
125
|
159
|
-- | […]
|
|
126
|
160
|
pprObjectFileContents :: [ByteString] -> SDoc
|
|
127
|
|
-pprObjectFileContents = vcatOrNone . zipWith pprEntry [0 ..] where
|
|
|
161
|
+pprObjectFileContents
|
|
|
162
|
+ = multiLineEntry (text "contents of object files:") .
|
|
|
163
|
+ vcatOrNone .
|
|
|
164
|
+ zipWith pprEntry [0 ..]
|
|
|
165
|
+ where
|
|
128
|
166
|
|
|
129
|
167
|
pprEntry :: Int -> ByteString -> SDoc
|
|
130
|
168
|
pprEntry ix content = multiLineEntry (text "file" <+> ppr ix)
|