never executed always true always false
1 {-# OPTIONS_GHC -fno-warn-orphans #-}
2 {-# LANGUAGE CPP #-}
3
4 module GHC.CmmToAsm.AArch64.Ppr (pprNatCmmDecl, pprInstr) where
5
6 import GHC.Prelude hiding (EQ)
7
8 import Data.Word
9 import qualified Data.Array.Unsafe as U ( castSTUArray )
10 import Data.Array.ST
11 import Control.Monad.ST
12
13 import GHC.CmmToAsm.AArch64.Instr
14 import GHC.CmmToAsm.AArch64.Regs
15 import GHC.CmmToAsm.AArch64.Cond
16 import GHC.CmmToAsm.Ppr
17 import GHC.CmmToAsm.Format
18 import GHC.Platform.Reg
19 import GHC.CmmToAsm.Config
20 import GHC.CmmToAsm.Types
21 import GHC.CmmToAsm.Utils
22
23 import GHC.Cmm hiding (topInfoTable)
24 import GHC.Cmm.Dataflow.Collections
25 import GHC.Cmm.Dataflow.Label
26 import GHC.Types.Basic (Alignment, mkAlignment, alignmentBytes)
27
28 import GHC.Cmm.BlockId
29 import GHC.Cmm.CLabel
30 import GHC.Cmm.Ppr.Expr () -- For Outputable instances
31
32 import GHC.Types.Unique ( pprUniqueAlways, getUnique )
33 import GHC.Platform
34 import GHC.Utils.Outputable
35
36 import GHC.Utils.Panic
37
38 pprProcAlignment :: NCGConfig -> SDoc
39 pprProcAlignment config = maybe empty (pprAlign platform . mkAlignment) (ncgProcAlignment config)
40 where
41 platform = ncgPlatform config
42
43 pprNatCmmDecl :: NCGConfig -> NatCmmDecl RawCmmStatics Instr -> SDoc
44 pprNatCmmDecl config (CmmData section dats) =
45 pprSectionAlign config section $$ pprDatas config dats
46
47 pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
48 let platform = ncgPlatform config in
49 pprProcAlignment config $$
50 case topInfoTable proc of
51 Nothing ->
52 -- special case for code without info table:
53 pprSectionAlign config (Section Text lbl) $$
54 -- do not
55 -- pprProcAlignment config $$
56 pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed
57 vcat (map (pprBasicBlock config top_info) blocks) $$
58 (if ncgDwarfEnabled config
59 then ppr (mkAsmTempEndLabel lbl) <> char ':' else empty) $$
60 pprSizeDecl platform lbl
61
62 Just (CmmStaticsRaw info_lbl _) ->
63 pprSectionAlign config (Section Text info_lbl) $$
64 -- pprProcAlignment config $$
65 (if platformHasSubsectionsViaSymbols platform
66 then ppr (mkDeadStripPreventer info_lbl) <> char ':'
67 else empty) $$
68 vcat (map (pprBasicBlock config top_info) blocks) $$
69 -- above: Even the first block gets a label, because with branch-chain
70 -- elimination, it might be the target of a goto.
71 (if platformHasSubsectionsViaSymbols platform
72 then -- See Note [Subsections Via Symbols]
73 text "\t.long "
74 <+> ppr info_lbl
75 <+> char '-'
76 <+> ppr (mkDeadStripPreventer info_lbl)
77 else empty) $$
78 pprSizeDecl platform info_lbl
79
80 pprLabel :: Platform -> CLabel -> SDoc
81 pprLabel platform lbl =
82 pprGloblDecl platform lbl
83 $$ pprTypeDecl platform lbl
84 $$ (pdoc platform lbl <> char ':')
85
86 pprAlign :: Platform -> Alignment -> SDoc
87 pprAlign _platform alignment
88 = text "\t.balign " <> int (alignmentBytes alignment)
89
90 -- | Print appropriate alignment for the given section type.
91 pprAlignForSection :: Platform -> SectionType -> SDoc
92 pprAlignForSection _platform _seg
93 -- .balign is stable, whereas .align is platform dependent.
94 = text "\t.balign 8" -- always 8
95
96 instance Outputable Instr where
97 ppr = pprInstr genericPlatform
98
99 -- | Print section header and appropriate alignment for that section.
100 --
101 -- This one will emit the header:
102 --
103 -- .section .text
104 -- .balign 8
105 --
106 pprSectionAlign :: NCGConfig -> Section -> SDoc
107 pprSectionAlign _config (Section (OtherSection _) _) =
108 panic "AArch64.Ppr.pprSectionAlign: unknown section"
109 pprSectionAlign config sec@(Section seg _) =
110 pprSectionHeader config sec
111 $$ pprAlignForSection (ncgPlatform config) seg
112
113 -- | Output the ELF .size directive.
114 pprSizeDecl :: Platform -> CLabel -> SDoc
115 pprSizeDecl platform lbl
116 = if osElfTarget (platformOS platform)
117 then text "\t.size" <+> pdoc platform lbl <> text ", .-" <> pdoc platform lbl
118 else empty
119
120 pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr
121 -> SDoc
122 pprBasicBlock config info_env (BasicBlock blockid instrs)
123 = maybe_infotable $
124 pprLabel platform asmLbl $$
125 vcat (map (pprInstr platform) (id {-detectTrivialDeadlock-} optInstrs)) $$
126 (if ncgDwarfEnabled config
127 then ppr (mkAsmTempEndLabel asmLbl) <> char ':'
128 else empty
129 )
130 where
131 -- Filter out identity moves. E.g. mov x18, x18 will be dropped.
132 optInstrs = filter f instrs
133 where f (MOV o1 o2) | o1 == o2 = False
134 f _ = True
135
136 asmLbl = blockLbl blockid
137 platform = ncgPlatform config
138 maybe_infotable c = case mapLookup blockid info_env of
139 Nothing -> c
140 Just (CmmStaticsRaw info_lbl info) ->
141 -- pprAlignForSection platform Text $$
142 infoTableLoc $$
143 vcat (map (pprData config) info) $$
144 pprLabel platform info_lbl $$
145 c $$
146 (if ncgDwarfEnabled config
147 then ppr (mkAsmTempEndLabel info_lbl) <> char ':'
148 else empty)
149 -- Make sure the info table has the right .loc for the block
150 -- coming right after it. See [Note: Info Offset]
151 infoTableLoc = case instrs of
152 (l@LOCATION{} : _) -> pprInstr platform l
153 _other -> empty
154
155 pprDatas :: NCGConfig -> RawCmmStatics -> SDoc
156 -- See Note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
157 pprDatas config (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
158 | lbl == mkIndStaticInfoLabel
159 , let labelInd (CmmLabelOff l _) = Just l
160 labelInd (CmmLabel l) = Just l
161 labelInd _ = Nothing
162 , Just ind' <- labelInd ind
163 , alias `mayRedirectTo` ind'
164 = pprGloblDecl (ncgPlatform config) alias
165 $$ text ".equiv" <+> pdoc (ncgPlatform config) alias <> comma <> pdoc (ncgPlatform config) (CmmLabel ind')
166
167 pprDatas config (CmmStaticsRaw lbl dats)
168 = vcat (pprLabel platform lbl : map (pprData config) dats)
169 where
170 platform = ncgPlatform config
171
172 pprData :: NCGConfig -> CmmStatic -> SDoc
173 pprData _config (CmmString str) = pprString str
174 pprData _config (CmmFileEmbed path) = pprFileEmbed path
175
176 pprData config (CmmUninitialised bytes)
177 = let platform = ncgPlatform config
178 in if platformOS platform == OSDarwin
179 then text ".space " <> int bytes
180 else text ".skip " <> int bytes
181
182 pprData config (CmmStaticLit lit) = pprDataItem config lit
183
184 pprGloblDecl :: Platform -> CLabel -> SDoc
185 pprGloblDecl platform lbl
186 | not (externallyVisibleCLabel lbl) = empty
187 | otherwise = text "\t.globl " <> pdoc platform lbl
188
189 -- Note [Always use objects for info tables]
190 -- See discussion in X86.Ppr
191 -- for why this is necessary. Essentially we need to ensure that we never
192 -- pass function symbols when we migth want to lookup the info table. If we
193 -- did, we could end up with procedure linking tables (PLT)s, and thus the
194 -- lookup wouldn't point to the function, but into the jump table.
195 --
196 -- Fun fact: The LLVMMangler exists to patch this issue su on the LLVM side as
197 -- well.
198 pprLabelType' :: Platform -> CLabel -> SDoc
199 pprLabelType' platform lbl =
200 if isCFunctionLabel lbl || functionOkInfoTable then
201 text "@function"
202 else
203 text "@object"
204 where
205 functionOkInfoTable = platformTablesNextToCode platform &&
206 isInfoTableLabel lbl && not (isConInfoTableLabel lbl)
207
208 -- this is called pprTypeAndSizeDecl in PPC.Ppr
209 pprTypeDecl :: Platform -> CLabel -> SDoc
210 pprTypeDecl platform lbl
211 = if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl
212 then text ".type " <> pdoc platform lbl <> text ", " <> pprLabelType' platform lbl
213 else empty
214
215 pprDataItem :: NCGConfig -> CmmLit -> SDoc
216 pprDataItem config lit
217 = vcat (ppr_item (cmmTypeFormat $ cmmLitType platform lit) lit)
218 where
219 platform = ncgPlatform config
220
221 imm = litToImm lit
222
223 ppr_item II8 _ = [text "\t.byte\t" <> pprImm platform imm]
224 ppr_item II16 _ = [text "\t.short\t" <> pprImm platform imm]
225 ppr_item II32 _ = [text "\t.long\t" <> pprImm platform imm]
226 ppr_item II64 _ = [text "\t.quad\t" <> pprImm platform imm]
227
228 ppr_item FF32 (CmmFloat r _)
229 = let bs = floatToBytes (fromRational r)
230 in map (\b -> text "\t.byte\t" <> pprImm platform (ImmInt b)) bs
231
232 ppr_item FF64 (CmmFloat r _)
233 = let bs = doubleToBytes (fromRational r)
234 in map (\b -> text "\t.byte\t" <> pprImm platform (ImmInt b)) bs
235
236 ppr_item _ _ = pprPanic "pprDataItem:ppr_item" (text $ show lit)
237
238 floatToBytes :: Float -> [Int]
239 floatToBytes f
240 = runST (do
241 arr <- newArray_ ((0::Int),3)
242 writeArray arr 0 f
243 arr <- castFloatToWord8Array arr
244 i0 <- readArray arr 0
245 i1 <- readArray arr 1
246 i2 <- readArray arr 2
247 i3 <- readArray arr 3
248 return (map fromIntegral [i0,i1,i2,i3])
249 )
250
251 castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)
252 castFloatToWord8Array = U.castSTUArray
253
254 pprImm :: Platform -> Imm -> SDoc
255 pprImm _ (ImmInt i) = int i
256 pprImm _ (ImmInteger i) = integer i
257 pprImm p (ImmCLbl l) = pdoc p l
258 pprImm p (ImmIndex l i) = pdoc p l <> char '+' <> int i
259 pprImm _ (ImmLit s) = s
260
261 -- TODO: See pprIm below for why this is a bad idea!
262 pprImm _ (ImmFloat f)
263 | f == 0 = text "wzr"
264 | otherwise = float (fromRational f)
265 pprImm _ (ImmDouble d)
266 | d == 0 = text "xzr"
267 | otherwise = double (fromRational d)
268
269 pprImm p (ImmConstantSum a b) = pprImm p a <> char '+' <> pprImm p b
270 pprImm p (ImmConstantDiff a b) = pprImm p a <> char '-'
271 <> lparen <> pprImm p b <> rparen
272
273
274 -- aarch64 GNU as uses // for comments.
275 asmComment :: SDoc -> SDoc
276 asmComment c = whenPprDebug $ text "#" <+> c
277
278 asmDoubleslashComment :: SDoc -> SDoc
279 asmDoubleslashComment c = whenPprDebug $ text "//" <+> c
280
281 asmMultilineComment :: SDoc -> SDoc
282 asmMultilineComment c = whenPprDebug $ text "/*" $+$ c $+$ text "*/"
283
284 pprIm :: Platform -> Imm -> SDoc
285 pprIm platform im = case im of
286 ImmInt i -> char '#' <> int i
287 ImmInteger i -> char '#' <> integer i
288
289 -- TODO: This will only work for
290 -- The floating point value must be expressable as ±n ÷ 16 × 2^r,
291 -- where n and r are integers such that 16 ≤ n ≤ 31 and -3 ≤ r ≤ 4.
292 -- and 0 needs to be encoded as wzr/xzr.
293 --
294 -- Except for 0, we might want to either split it up into enough
295 -- ADD operations into an Integer register and then just bit copy it into
296 -- the double register? See the toBytes + fromRational above for data items.
297 -- This is something the x86 backend does.
298 --
299 -- We could also just turn them into statics :-/ Which is what the
300 -- PowerPC backend odes.
301 ImmFloat f | f == 0 -> text "wzr"
302 ImmFloat f -> char '#' <> float (fromRational f)
303 ImmDouble d | d == 0 -> text "xzr"
304 ImmDouble d -> char '#' <> double (fromRational d)
305 -- =<lbl> pseudo instruction!
306 ImmCLbl l -> char '=' <> pdoc platform l
307 ImmIndex l o -> text "[=" <> pdoc platform l <> comma <+> char '#' <> int o <> char ']'
308 _ -> panic "AArch64.pprIm"
309
310 pprExt :: ExtMode -> SDoc
311 pprExt EUXTB = text "uxtb"
312 pprExt EUXTH = text "uxth"
313 pprExt EUXTW = text "uxtw"
314 pprExt EUXTX = text "uxtx"
315 pprExt ESXTB = text "sxtb"
316 pprExt ESXTH = text "sxth"
317 pprExt ESXTW = text "sxtw"
318 pprExt ESXTX = text "sxtx"
319
320 pprShift :: ShiftMode -> SDoc
321 pprShift SLSL = text "lsl"
322 pprShift SLSR = text "lsr"
323 pprShift SASR = text "asr"
324 pprShift SROR = text "ror"
325
326 pprOp :: Platform -> Operand -> SDoc
327 pprOp plat op = case op of
328 OpReg w r -> pprReg w r
329 OpRegExt w r x 0 -> pprReg w r <> comma <+> pprExt x
330 OpRegExt w r x i -> pprReg w r <> comma <+> pprExt x <> comma <+> char '#' <> int i
331 OpRegShift w r s i -> pprReg w r <> comma <+> pprShift s <> comma <+> char '#' <> int i
332 OpImm im -> pprIm plat im
333 OpImmShift im s i -> pprIm plat im <> comma <+> pprShift s <+> char '#' <> int i
334 -- TODO: Address compuation always use registers as 64bit -- is this correct?
335 OpAddr (AddrRegReg r1 r2) -> char '[' <+> pprReg W64 r1 <> comma <+> pprReg W64 r2 <+> char ']'
336 OpAddr (AddrRegImm r1 im) -> char '[' <+> pprReg W64 r1 <> comma <+> pprImm plat im <+> char ']'
337 OpAddr (AddrReg r1) -> char '[' <+> pprReg W64 r1 <+> char ']'
338
339 pprReg :: Width -> Reg -> SDoc
340 pprReg w r = case r of
341 RegReal (RealRegSingle i) -> ppr_reg_no w i
342 RegReal (RealRegPair{}) -> panic "AArch64.pprReg: no reg pairs on this arch!"
343 -- virtual regs should not show up, but this is helpful for debugging.
344 RegVirtual (VirtualRegI u) -> text "%vI_" <> pprUniqueAlways u
345 RegVirtual (VirtualRegF u) -> text "%vF_" <> pprUniqueAlways u
346 RegVirtual (VirtualRegD u) -> text "%vD_" <> pprUniqueAlways u
347 _ -> pprPanic "AArch64.pprReg" (text $ show r)
348
349 where
350 ppr_reg_no :: Width -> Int -> SDoc
351 ppr_reg_no w 31
352 | w == W64 = text "sp"
353 | w == W32 = text "wsp"
354
355 ppr_reg_no w i
356 | i < 0, w == W32 = text "wzr"
357 | i < 0, w == W64 = text "xzr"
358 | i < 0 = pprPanic "Invalid Zero Reg" (ppr w <+> int i)
359 -- General Purpose Registers
360 | i <= 31, w == W8 = text "w" <> int i -- there are no byte or half
361 | i <= 31, w == W16 = text "w" <> int i -- words... word will do.
362 | i <= 31, w == W32 = text "w" <> int i
363 | i <= 31, w == W64 = text "x" <> int i
364 | i <= 31 = pprPanic "Invalid Reg" (ppr w <+> int i)
365 -- Floating Point Registers
366 | i <= 63, w == W8 = text "b" <> int (i-32)
367 | i <= 63, w == W16 = text "h" <> int (i-32)
368 | i <= 63, w == W32 = text "s" <> int (i-32)
369 | i <= 63, w == W64 = text "d" <> int (i-32)
370 -- no support for 'q'uad in GHC's NCG yet.
371 | otherwise = text "very naughty powerpc register"
372
373 isFloatOp :: Operand -> Bool
374 isFloatOp (OpReg _ (RegReal (RealRegSingle i))) | i > 31 = True
375 isFloatOp (OpReg _ (RegVirtual (VirtualRegF _))) = True
376 isFloatOp (OpReg _ (RegVirtual (VirtualRegD _))) = True
377 isFloatOp _ = False
378
379 pprInstr :: Platform -> Instr -> SDoc
380 pprInstr platform instr = case instr of
381 -- Meta Instructions ---------------------------------------------------------
382 COMMENT s -> asmComment s
383 MULTILINE_COMMENT s -> asmMultilineComment s
384 ANN d i -> pprInstr platform i <+> asmDoubleslashComment d
385 LOCATION file line col _name
386 -> text "\t.loc" <+> ppr file <+> ppr line <+> ppr col
387 DELTA d -> asmComment $ text ("\tdelta = " ++ show d)
388 NEWBLOCK _ -> panic "PprInstr: NEWBLOCK"
389 LDATA _ _ -> panic "pprInstr: LDATA"
390
391 -- Pseudo Instructions -------------------------------------------------------
392
393 PUSH_STACK_FRAME -> text "\tstp x29, x30, [sp, #-16]!"
394 $$ text "\tmov x29, sp"
395
396 POP_STACK_FRAME -> text "\tldp x29, x30, [sp], #16"
397 -- ===========================================================================
398 -- AArch64 Instruction Set
399 -- 1. Arithmetic Instructions ------------------------------------------------
400 ADD o1 o2 o3
401 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> text "\tfadd" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
402 | otherwise -> text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
403 CMN o1 o2 -> text "\tcmn" <+> pprOp platform o1 <> comma <+> pprOp platform o2
404 CMP o1 o2
405 | isFloatOp o1 && isFloatOp o2 -> text "\tfcmp" <+> pprOp platform o1 <> comma <+> pprOp platform o2
406 | otherwise -> text "\tcmp" <+> pprOp platform o1 <> comma <+> pprOp platform o2
407 MSUB o1 o2 o3 o4 -> text "\tmsub" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
408 MUL o1 o2 o3
409 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> text "\tfmul" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
410 | otherwise -> text "\tmul" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
411 NEG o1 o2
412 | isFloatOp o1 && isFloatOp o2 -> text "\tfneg" <+> pprOp platform o1 <> comma <+> pprOp platform o2
413 | otherwise -> text "\tneg" <+> pprOp platform o1 <> comma <+> pprOp platform o2
414 SDIV o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3
415 -> text "\tfdiv" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
416 SDIV o1 o2 o3 -> text "\tsdiv" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
417
418 SUB o1 o2 o3
419 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> text "\tfsub" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
420 | otherwise -> text "\tsub" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
421 UDIV o1 o2 o3 -> text "\tudiv" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
422
423 -- 2. Bit Manipulation Instructions ------------------------------------------
424 SBFM o1 o2 o3 o4 -> text "\tsbfm" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
425 UBFM o1 o2 o3 o4 -> text "\tubfm" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
426 -- signed and unsigned bitfield extract
427 SBFX o1 o2 o3 o4 -> text "\tsbfx" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
428 UBFX o1 o2 o3 o4 -> text "\tubfx" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
429 SXTB o1 o2 -> text "\tsxtb" <+> pprOp platform o1 <> comma <+> pprOp platform o2
430 UXTB o1 o2 -> text "\tuxtb" <+> pprOp platform o1 <> comma <+> pprOp platform o2
431 SXTH o1 o2 -> text "\tsxth" <+> pprOp platform o1 <> comma <+> pprOp platform o2
432 UXTH o1 o2 -> text "\tuxth" <+> pprOp platform o1 <> comma <+> pprOp platform o2
433
434 -- 3. Logical and Move Instructions ------------------------------------------
435 AND o1 o2 o3 -> text "\tand" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
436 ANDS o1 o2 o3 -> text "\tands" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
437 ASR o1 o2 o3 -> text "\tasr" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
438 BIC o1 o2 o3 -> text "\tbic" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
439 BICS o1 o2 o3 -> text "\tbics" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
440 EON o1 o2 o3 -> text "\teon" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
441 EOR o1 o2 o3 -> text "\teor" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
442 LSL o1 o2 o3 -> text "\tlsl" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
443 LSR o1 o2 o3 -> text "\tlsr" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
444 MOV o1 o2
445 | isFloatOp o1 || isFloatOp o2 -> text "\tfmov" <+> pprOp platform o1 <> comma <+> pprOp platform o2
446 | otherwise -> text "\tmov" <+> pprOp platform o1 <> comma <+> pprOp platform o2
447 MOVK o1 o2 -> text "\tmovk" <+> pprOp platform o1 <> comma <+> pprOp platform o2
448 MVN o1 o2 -> text "\tmvn" <+> pprOp platform o1 <> comma <+> pprOp platform o2
449 ORN o1 o2 o3 -> text "\torn" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
450 ORR o1 o2 o3 -> text "\torr" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
451 ROR o1 o2 o3 -> text "\tror" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
452 TST o1 o2 -> text "\ttst" <+> pprOp platform o1 <> comma <+> pprOp platform o2
453
454 -- 4. Branch Instructions ----------------------------------------------------
455 J t -> pprInstr platform (B t)
456 B (TBlock bid) -> text "\tb" <+> pdoc platform (mkLocalBlockLabel (getUnique bid))
457 B (TLabel lbl) -> text "\tb" <+> pdoc platform lbl
458 B (TReg r) -> text "\tbr" <+> pprReg W64 r
459
460 BL (TBlock bid) _ _ -> text "\tbl" <+> pdoc platform (mkLocalBlockLabel (getUnique bid))
461 BL (TLabel lbl) _ _ -> text "\tbl" <+> pdoc platform lbl
462 BL (TReg r) _ _ -> text "\tblr" <+> pprReg W64 r
463
464 BCOND c (TBlock bid) -> text "\t" <> pprBcond c <+> pdoc platform (mkLocalBlockLabel (getUnique bid))
465 BCOND c (TLabel lbl) -> text "\t" <> pprBcond c <+> pdoc platform lbl
466 BCOND _ (TReg _) -> panic "AArch64.ppr: No conditional branching to registers!"
467
468 -- 5. Atomic Instructions ----------------------------------------------------
469 -- 6. Conditional Instructions -----------------------------------------------
470 CSET o c -> text "\tcset" <+> pprOp platform o <> comma <+> pprCond c
471
472 CBZ o (TBlock bid) -> text "\tcbz" <+> pprOp platform o <> comma <+> pdoc platform (mkLocalBlockLabel (getUnique bid))
473 CBZ o (TLabel lbl) -> text "\tcbz" <+> pprOp platform o <> comma <+> pdoc platform lbl
474 CBZ _ (TReg _) -> panic "AArch64.ppr: No conditional (cbz) branching to registers!"
475
476 CBNZ o (TBlock bid) -> text "\tcbnz" <+> pprOp platform o <> comma <+> pdoc platform (mkLocalBlockLabel (getUnique bid))
477 CBNZ o (TLabel lbl) -> text "\tcbnz" <+> pprOp platform o <> comma <+> pdoc platform lbl
478 CBNZ _ (TReg _) -> panic "AArch64.ppr: No conditional (cbnz) branching to registers!"
479
480 -- 7. Load and Store Instructions --------------------------------------------
481 -- NOTE: GHC may do whacky things where it only load the lower part of an
482 -- address. Not observing the correct size when loading will lead
483 -- inevitably to crashes.
484 STR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 ->
485 text "\tstrb" <+> pprOp platform o1 <> comma <+> pprOp platform o2
486 STR _f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 ->
487 text "\tstrh" <+> pprOp platform o1 <> comma <+> pprOp platform o2
488 STR _f o1 o2 -> text "\tstr" <+> pprOp platform o1 <> comma <+> pprOp platform o2
489
490 #if defined(darwin_HOST_OS)
491 LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
492 text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$
493 text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]" $$
494 text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.
495
496 LDR _f o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl ->
497 text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$
498 text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]" $$
499 text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.
500
501 LDR _f o1 (OpImm (ImmIndex lbl off)) ->
502 text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@page" $$
503 text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@pageoff" $$
504 text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.
505
506 LDR _f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
507 text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$
508 text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]"
509
510 LDR _f o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl ->
511 text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$
512 text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]"
513
514 LDR _f o1 (OpImm (ImmCLbl lbl)) ->
515 text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@page" $$
516 text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@pageoff"
517 #else
518 LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
519 text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$
520 text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]" $$
521 text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.
522
523 LDR _f o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl ->
524 text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$
525 text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]" $$
526 text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.
527
528 LDR _f o1 (OpImm (ImmIndex lbl off)) ->
529 text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl $$
530 text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pdoc platform lbl $$
531 text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.
532
533 LDR _f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
534 text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$
535 text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]"
536
537 LDR _f o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl ->
538 text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$
539 text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]"
540
541 LDR _f o1 (OpImm (ImmCLbl lbl)) ->
542 text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl $$
543 text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pdoc platform lbl
544 #endif
545
546 LDR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 ->
547 text "\tldrsb" <+> pprOp platform o1 <> comma <+> pprOp platform o2
548 LDR _f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 ->
549 text "\tldrsh" <+> pprOp platform o1 <> comma <+> pprOp platform o2
550 LDR _f o1 o2 -> text "\tldr" <+> pprOp platform o1 <> comma <+> pprOp platform o2
551
552 STP _f o1 o2 o3 -> text "\tstp" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
553 LDP _f o1 o2 o3 -> text "\tldp" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
554
555 -- 8. Synchronization Instructions -------------------------------------------
556 DMBSY -> text "\tdmb sy"
557 -- 9. Floating Point Instructions --------------------------------------------
558 FCVT o1 o2 -> text "\tfcvt" <+> pprOp platform o1 <> comma <+> pprOp platform o2
559 SCVTF o1 o2 -> text "\tscvtf" <+> pprOp platform o1 <> comma <+> pprOp platform o2
560 FCVTZS o1 o2 -> text "\tfcvtzs" <+> pprOp platform o1 <> comma <+> pprOp platform o2
561 FABS o1 o2 -> text "\tfabs" <+> pprOp platform o1 <> comma <+> pprOp platform o2
562
563 pprBcond :: Cond -> SDoc
564 pprBcond c = text "b." <> pprCond c
565
566 pprCond :: Cond -> SDoc
567 pprCond c = case c of
568 ALWAYS -> text "al" -- Always
569 EQ -> text "eq" -- Equal
570 NE -> text "ne" -- Not Equal
571
572 SLT -> text "lt" -- Signed less than ; Less than, or unordered
573 SLE -> text "le" -- Signed less than or equal ; Less than or equal, or unordered
574 SGE -> text "ge" -- Signed greater than or equal ; Greater than or equal
575 SGT -> text "gt" -- Signed greater than ; Greater than
576
577 ULT -> text "lo" -- Carry clear/ unsigned lower ; less than
578 ULE -> text "ls" -- Unsigned lower or same ; Less than or equal
579 UGE -> text "hs" -- Carry set/unsigned higher or same ; Greater than or equal, or unordered
580 UGT -> text "hi" -- Unsigned higher ; Greater than, or unordered
581
582 NEVER -> text "nv" -- Never
583 VS -> text "vs" -- Overflow ; Unordered (at least one NaN operand)
584 VC -> text "vc" -- No overflow ; Not unordered
585
586 -- Orderd variants. Respecting NaN.
587 OLT -> text "mi"
588 OLE -> text "ls"
589 OGE -> text "ge"
590 OGT -> text "gt"
591
592 -- Unordered
593 UOLT -> text "lt"
594 UOLE -> text "le"
595 UOGE -> text "pl"
596 UOGT -> text "hi"