Update Trac ticket URLs to point to GitLab
[ghc.git] / compiler / nativeGen / PprBase.hs
1 {-# LANGUAGE MagicHash #-}
2
3 -----------------------------------------------------------------------------
4 --
5 -- Pretty-printing assembly language
6 --
7 -- (c) The University of Glasgow 1993-2005
8 --
9 -----------------------------------------------------------------------------
10
11 module PprBase (
12 castFloatToWord8Array,
13 castDoubleToWord8Array,
14 floatToBytes,
15 doubleToBytes,
16 pprASCII,
17 pprBytes,
18 pprSectionHeader
19 )
20
21 where
22
23 import GhcPrelude
24
25 import AsmUtils
26 import CLabel
27 import Cmm
28 import DynFlags
29 import FastString
30 import Outputable
31 import Platform
32 import FileCleanup
33
34 import qualified Data.Array.Unsafe as U ( castSTUArray )
35 import Data.Array.ST
36
37 import Control.Monad.ST
38
39 import Data.Word
40 import Data.Bits
41 import Data.ByteString (ByteString)
42 import qualified Data.ByteString as BS
43 import GHC.Exts
44 import GHC.Word
45 import System.IO.Unsafe
46
47
48
49 -- -----------------------------------------------------------------------------
50 -- Converting floating-point literals to integrals for printing
51
52 castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)
53 castFloatToWord8Array = U.castSTUArray
54
55 castDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8)
56 castDoubleToWord8Array = U.castSTUArray
57
58 -- floatToBytes and doubleToBytes convert to the host's byte
59 -- order. Providing that we're not cross-compiling for a
60 -- target with the opposite endianness, this should work ok
61 -- on all targets.
62
63 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
64 -- could they be merged?
65
66 floatToBytes :: Float -> [Int]
67 floatToBytes f
68 = runST (do
69 arr <- newArray_ ((0::Int),3)
70 writeArray arr 0 f
71 arr <- castFloatToWord8Array arr
72 i0 <- readArray arr 0
73 i1 <- readArray arr 1
74 i2 <- readArray arr 2
75 i3 <- readArray arr 3
76 return (map fromIntegral [i0,i1,i2,i3])
77 )
78
79 doubleToBytes :: Double -> [Int]
80 doubleToBytes d
81 = runST (do
82 arr <- newArray_ ((0::Int),7)
83 writeArray arr 0 d
84 arr <- castDoubleToWord8Array arr
85 i0 <- readArray arr 0
86 i1 <- readArray arr 1
87 i2 <- readArray arr 2
88 i3 <- readArray arr 3
89 i4 <- readArray arr 4
90 i5 <- readArray arr 5
91 i6 <- readArray arr 6
92 i7 <- readArray arr 7
93 return (map fromIntegral [i0,i1,i2,i3,i4,i5,i6,i7])
94 )
95
96 -- ---------------------------------------------------------------------------
97 -- Printing ASCII strings.
98 --
99 -- Print as a string and escape non-printable characters.
100 -- This is similar to charToC in Utils.
101
102 pprASCII :: ByteString -> SDoc
103 pprASCII str
104 -- Transform this given literal bytestring to escaped string and construct
105 -- the literal SDoc directly.
106 -- See #14741
107 -- and Note [Pretty print ASCII when AsmCodeGen]
108 = text $ BS.foldr (\w s -> do1 w ++ s) "" str
109 where
110 do1 :: Word8 -> String
111 do1 w | 0x09 == w = "\\t"
112 | 0x0A == w = "\\n"
113 | 0x22 == w = "\\\""
114 | 0x5C == w = "\\\\"
115 -- ASCII printable characters range
116 | w >= 0x20 && w <= 0x7E = [chr' w]
117 | otherwise = '\\' : octal w
118
119 -- we know that the Chars we create are in the ASCII range
120 -- so we bypass the check in "chr"
121 chr' :: Word8 -> Char
122 chr' (W8# w#) = C# (chr# (word2Int# w#))
123
124 octal :: Word8 -> String
125 octal w = [ chr' (ord0 + (w `unsafeShiftR` 6) .&. 0x07)
126 , chr' (ord0 + (w `unsafeShiftR` 3) .&. 0x07)
127 , chr' (ord0 + w .&. 0x07)
128 ]
129 ord0 = 0x30 -- = ord '0'
130
131 -- | Pretty print binary data.
132 --
133 -- Use either the ".string" directive or a ".incbin" directive.
134 -- See Note [Embedding large binary blobs]
135 --
136 -- A NULL byte is added after the binary data.
137 --
138 pprBytes :: ByteString -> SDoc
139 pprBytes bs = sdocWithDynFlags $ \dflags ->
140 if binBlobThreshold dflags == 0
141 || fromIntegral (BS.length bs) <= binBlobThreshold dflags
142 then text "\t.string " <> doubleQuotes (pprASCII bs)
143 else unsafePerformIO $ do
144 bFile <- newTempName dflags TFL_CurrentModule ".dat"
145 BS.writeFile bFile bs
146 return $ text "\t.incbin "
147 <> pprFilePathString bFile -- proper escape (see #16389)
148 <> text "\n\t.byte 0"
149
150 {-
151 Note [Embedding large binary blobs]
152 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
153
154 To embed a blob of binary data (e.g. an UTF-8 encoded string) into the generated
155 code object, we have several options:
156
157 1. Generate a ".byte" directive for each byte. This is what was done in the past
158 (see Note [Pretty print ASCII when AsmCodeGen]).
159
160 2. Generate a single ".string"/".asciz" directive for the whole sequence of
161 bytes. Bytes in the ASCII printable range are rendered as characters and
162 other values are escaped (e.g., "\t", "\077", etc.).
163
164 3. Create a temporary file into which we dump the binary data and generate a
165 single ".incbin" directive. The assembler will include the binary file for
166 us in the generated output object.
167
168 Now the code generator uses either (2) or (3), depending on the binary blob
169 size. Using (3) for small blobs adds too much overhead (see benchmark results
170 in #16190), so we only do it when the size is above a threshold (500K at the
171 time of writing).
172
173 The threshold is configurable via the `-fbinary-blob-threshold` flag.
174
175 -}
176
177
178 {-
179 Note [Pretty print ASCII when AsmCodeGen]
180 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
181 Previously, when generating assembly code, we created SDoc with
182 `(ptext . sLit)` for every bytes in literal bytestring, then
183 combine them using `hcat`.
184
185 When handling literal bytestrings with millions of bytes,
186 millions of SDoc would be created and to combine, leading to
187 high memory usage.
188
189 Now we escape the given bytestring to string directly and construct
190 SDoc only once. This improvement could dramatically decrease the
191 memory allocation from 4.7GB to 1.3GB when embedding a 3MB literal
192 string in source code. See #14741 for profiling results.
193 -}
194
195 -- ----------------------------------------------------------------------------
196 -- Printing section headers.
197 --
198 -- If -split-section was specified, include the suffix label, otherwise just
199 -- print the section type. For Darwin, where subsections-for-symbols are
200 -- used instead, only print section type.
201 --
202 -- For string literals, additional flags are specified to enable merging of
203 -- identical strings in the linker. With -split-sections each string also gets
204 -- a unique section to allow strings from unused code to be GC'd.
205
206 pprSectionHeader :: Platform -> Section -> SDoc
207 pprSectionHeader platform (Section t suffix) =
208 case platformOS platform of
209 OSAIX -> pprXcoffSectionHeader t
210 OSDarwin -> pprDarwinSectionHeader t
211 OSMinGW32 -> pprGNUSectionHeader (char '$') t suffix
212 _ -> pprGNUSectionHeader (char '.') t suffix
213
214 pprGNUSectionHeader :: SDoc -> SectionType -> CLabel -> SDoc
215 pprGNUSectionHeader sep t suffix = sdocWithDynFlags $ \dflags ->
216 let splitSections = gopt Opt_SplitSections dflags
217 subsection | splitSections = sep <> ppr suffix
218 | otherwise = empty
219 in text ".section " <> ptext (header dflags) <> subsection <>
220 flags dflags
221 where
222 header dflags = case t of
223 Text -> sLit ".text"
224 Data -> sLit ".data"
225 ReadOnlyData | OSMinGW32 <- platformOS (targetPlatform dflags)
226 -> sLit ".rdata"
227 | otherwise -> sLit ".rodata"
228 RelocatableReadOnlyData | OSMinGW32 <- platformOS (targetPlatform dflags)
229 -- Concept does not exist on Windows,
230 -- So map these to R/O data.
231 -> sLit ".rdata$rel.ro"
232 | otherwise -> sLit ".data.rel.ro"
233 UninitialisedData -> sLit ".bss"
234 ReadOnlyData16 | OSMinGW32 <- platformOS (targetPlatform dflags)
235 -> sLit ".rdata$cst16"
236 | otherwise -> sLit ".rodata.cst16"
237 CString
238 | OSMinGW32 <- platformOS (targetPlatform dflags)
239 -> sLit ".rdata"
240 | otherwise -> sLit ".rodata.str"
241 OtherSection _ ->
242 panic "PprBase.pprGNUSectionHeader: unknown section type"
243 flags dflags = case t of
244 CString
245 | OSMinGW32 <- platformOS (targetPlatform dflags)
246 -> empty
247 | otherwise -> text ",\"aMS\"," <> sectionType "progbits" <> text ",1"
248 _ -> empty
249
250 -- XCOFF doesn't support relocating label-differences, so we place all
251 -- RO sections into .text[PR] sections
252 pprXcoffSectionHeader :: SectionType -> SDoc
253 pprXcoffSectionHeader t = text $ case t of
254 Text -> ".csect .text[PR]"
255 Data -> ".csect .data[RW]"
256 ReadOnlyData -> ".csect .text[PR] # ReadOnlyData"
257 RelocatableReadOnlyData -> ".csect .text[PR] # RelocatableReadOnlyData"
258 ReadOnlyData16 -> ".csect .text[PR] # ReadOnlyData16"
259 CString -> ".csect .text[PR] # CString"
260 UninitialisedData -> ".csect .data[BS]"
261 OtherSection _ ->
262 panic "PprBase.pprXcoffSectionHeader: unknown section type"
263
264 pprDarwinSectionHeader :: SectionType -> SDoc
265 pprDarwinSectionHeader t =
266 ptext $ case t of
267 Text -> sLit ".text"
268 Data -> sLit ".data"
269 ReadOnlyData -> sLit ".const"
270 RelocatableReadOnlyData -> sLit ".const_data"
271 UninitialisedData -> sLit ".data"
272 ReadOnlyData16 -> sLit ".const"
273 CString -> sLit ".section\t__TEXT,__cstring,cstring_literals"
274 OtherSection _ ->
275 panic "PprBase.pprDarwinSectionHeader: unknown section type"