7022e596479233d04164d409b2123c144abb92ba
[ghc.git] / compiler / nativeGen / X86 / Ppr.hs
1 {-# LANGUAGE CPP #-}
2
3 -----------------------------------------------------------------------------
4 --
5 -- Pretty-printing assembly language
6 --
7 -- (c) The University of Glasgow 1993-2005
8 --
9 -----------------------------------------------------------------------------
10
11 {-# OPTIONS_GHC -fno-warn-orphans #-}
12 module X86.Ppr (
13 pprNatCmmDecl,
14 pprBasicBlock,
15 pprSectionHeader,
16 pprData,
17 pprInstr,
18 pprSize,
19 pprImm,
20 pprDataItem,
21 )
22
23 where
24
25 #include "HsVersions.h"
26 #include "nativeGen/NCG.h"
27
28 import X86.Regs
29 import X86.Instr
30 import X86.Cond
31 import Instruction
32 import Size
33 import Reg
34 import PprBase
35
36
37 import BlockId
38 import BasicTypes (Alignment)
39 import DynFlags
40 import Cmm hiding (topInfoTable)
41 import CLabel
42 import Unique ( pprUnique, Uniquable(..) )
43 import Platform
44 import FastString
45 import Outputable
46
47 import Data.Word
48
49 import Data.Bits
50
51 -- -----------------------------------------------------------------------------
52 -- Printing this stuff out
53
54 pprNatCmmDecl :: NatCmmDecl (Alignment, CmmStatics) Instr -> SDoc
55 pprNatCmmDecl (CmmData section dats) =
56 pprSectionHeader section $$ pprDatas dats
57
58 pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
59 sdocWithDynFlags $ \dflags ->
60 case topInfoTable proc of
61 Nothing ->
62 case blocks of
63 [] -> -- special case for split markers:
64 pprLabel lbl
65 blocks -> -- special case for code without info table:
66 pprSectionHeader Text $$
67 pprLabel lbl $$ -- blocks guaranteed not null, so label needed
68 vcat (map (pprBasicBlock top_info) blocks) $$
69 (if gopt Opt_Debug dflags
70 then ppr (mkAsmTempEndLabel lbl) <> char ':' else empty) $$
71 pprSizeDecl lbl
72
73 Just (Statics info_lbl _) ->
74 sdocWithPlatform $ \platform ->
75 (if platformHasSubsectionsViaSymbols platform
76 then pprSectionHeader Text $$
77 ppr (mkDeadStripPreventer info_lbl) <> char ':'
78 else empty) $$
79 vcat (map (pprBasicBlock top_info) blocks) $$
80 -- above: Even the first block gets a label, because with branch-chain
81 -- elimination, it might be the target of a goto.
82 (if platformHasSubsectionsViaSymbols platform
83 then
84 -- See Note [Subsections Via Symbols]
85 text "\t.long "
86 <+> ppr info_lbl
87 <+> char '-'
88 <+> ppr (mkDeadStripPreventer info_lbl)
89 else empty) $$
90 (if gopt Opt_Debug dflags
91 then ppr (mkAsmTempEndLabel info_lbl) <> char ':' else empty) $$
92 pprSizeDecl info_lbl
93
94 -- | Output the ELF .size directive.
95 pprSizeDecl :: CLabel -> SDoc
96 pprSizeDecl lbl
97 = sdocWithPlatform $ \platform ->
98 if osElfTarget (platformOS platform)
99 then ptext (sLit "\t.size") <+> ppr lbl
100 <> ptext (sLit ", .-") <> ppr lbl
101 else empty
102
103 pprBasicBlock :: BlockEnv CmmStatics -> NatBasicBlock Instr -> SDoc
104 pprBasicBlock info_env (BasicBlock blockid instrs)
105 = sdocWithDynFlags $ \dflags ->
106 maybe_infotable $$
107 pprLabel asmLbl $$
108 vcat (map pprInstr instrs) $$
109 (if gopt Opt_Debug dflags
110 then ppr (mkAsmTempEndLabel asmLbl) <> char ':' else empty)
111 where
112 asmLbl = mkAsmTempLabel (getUnique blockid)
113 maybe_infotable = case mapLookup blockid info_env of
114 Nothing -> empty
115 Just (Statics info_lbl info) ->
116 pprSectionHeader Text $$
117 infoTableLoc $$
118 vcat (map pprData info) $$
119 pprLabel info_lbl
120 -- Make sure the info table has the right .loc for the block
121 -- coming right after it. See [Note: Info Offset]
122 infoTableLoc = case instrs of
123 (l@LOCATION{} : _) -> pprInstr l
124 _other -> empty
125
126 pprDatas :: (Alignment, CmmStatics) -> SDoc
127 pprDatas (align, (Statics lbl dats))
128 = vcat (pprAlign align : pprLabel lbl : map pprData dats)
129 -- TODO: could remove if align == 1
130
131 pprData :: CmmStatic -> SDoc
132 pprData (CmmString str) = pprASCII str
133
134 pprData (CmmUninitialised bytes)
135 = sdocWithPlatform $ \platform ->
136 if platformOS platform == OSDarwin then ptext (sLit ".space ") <> int bytes
137 else ptext (sLit ".skip ") <> int bytes
138
139 pprData (CmmStaticLit lit) = pprDataItem lit
140
141 pprGloblDecl :: CLabel -> SDoc
142 pprGloblDecl lbl
143 | not (externallyVisibleCLabel lbl) = empty
144 | otherwise = ptext (sLit ".globl ") <> ppr lbl
145
146 pprTypeAndSizeDecl :: CLabel -> SDoc
147 pprTypeAndSizeDecl lbl
148 = sdocWithPlatform $ \platform ->
149 if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl
150 then ptext (sLit ".type ") <> ppr lbl <> ptext (sLit ", @object")
151 else empty
152
153 pprLabel :: CLabel -> SDoc
154 pprLabel lbl = pprGloblDecl lbl
155 $$ pprTypeAndSizeDecl lbl
156 $$ (ppr lbl <> char ':')
157
158
159 pprASCII :: [Word8] -> SDoc
160 pprASCII str
161 = vcat (map do1 str) $$ do1 0
162 where
163 do1 :: Word8 -> SDoc
164 do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
165
166 pprAlign :: Int -> SDoc
167 pprAlign bytes
168 = sdocWithPlatform $ \platform ->
169 ptext (sLit ".align ") <> int (alignment platform)
170 where
171 alignment platform = if platformOS platform == OSDarwin
172 then log2 bytes
173 else bytes
174
175 log2 :: Int -> Int -- cache the common ones
176 log2 1 = 0
177 log2 2 = 1
178 log2 4 = 2
179 log2 8 = 3
180 log2 n = 1 + log2 (n `quot` 2)
181
182 -- -----------------------------------------------------------------------------
183 -- pprInstr: print an 'Instr'
184
185 instance Outputable Instr where
186 ppr instr = pprInstr instr
187
188
189 pprReg :: Size -> Reg -> SDoc
190 pprReg s r
191 = case r of
192 RegReal (RealRegSingle i) ->
193 sdocWithPlatform $ \platform ->
194 if target32Bit platform then ppr32_reg_no s i
195 else ppr64_reg_no s i
196 RegReal (RealRegPair _ _) -> panic "X86.Ppr: no reg pairs on this arch"
197 RegVirtual (VirtualRegI u) -> text "%vI_" <> pprUnique u
198 RegVirtual (VirtualRegHi u) -> text "%vHi_" <> pprUnique u
199 RegVirtual (VirtualRegF u) -> text "%vF_" <> pprUnique u
200 RegVirtual (VirtualRegD u) -> text "%vD_" <> pprUnique u
201 RegVirtual (VirtualRegSSE u) -> text "%vSSE_" <> pprUnique u
202 where
203 ppr32_reg_no :: Size -> Int -> SDoc
204 ppr32_reg_no II8 = ppr32_reg_byte
205 ppr32_reg_no II16 = ppr32_reg_word
206 ppr32_reg_no _ = ppr32_reg_long
207
208 ppr32_reg_byte i = ptext
209 (case i of {
210 0 -> sLit "%al"; 1 -> sLit "%bl";
211 2 -> sLit "%cl"; 3 -> sLit "%dl";
212 _ -> sLit "very naughty I386 byte register"
213 })
214
215 ppr32_reg_word i = ptext
216 (case i of {
217 0 -> sLit "%ax"; 1 -> sLit "%bx";
218 2 -> sLit "%cx"; 3 -> sLit "%dx";
219 4 -> sLit "%si"; 5 -> sLit "%di";
220 6 -> sLit "%bp"; 7 -> sLit "%sp";
221 _ -> sLit "very naughty I386 word register"
222 })
223
224 ppr32_reg_long i = ptext
225 (case i of {
226 0 -> sLit "%eax"; 1 -> sLit "%ebx";
227 2 -> sLit "%ecx"; 3 -> sLit "%edx";
228 4 -> sLit "%esi"; 5 -> sLit "%edi";
229 6 -> sLit "%ebp"; 7 -> sLit "%esp";
230 _ -> ppr_reg_float i
231 })
232
233 ppr64_reg_no :: Size -> Int -> SDoc
234 ppr64_reg_no II8 = ppr64_reg_byte
235 ppr64_reg_no II16 = ppr64_reg_word
236 ppr64_reg_no II32 = ppr64_reg_long
237 ppr64_reg_no _ = ppr64_reg_quad
238
239 ppr64_reg_byte i = ptext
240 (case i of {
241 0 -> sLit "%al"; 1 -> sLit "%bl";
242 2 -> sLit "%cl"; 3 -> sLit "%dl";
243 4 -> sLit "%sil"; 5 -> sLit "%dil"; -- new 8-bit regs!
244 6 -> sLit "%bpl"; 7 -> sLit "%spl";
245 8 -> sLit "%r8b"; 9 -> sLit "%r9b";
246 10 -> sLit "%r10b"; 11 -> sLit "%r11b";
247 12 -> sLit "%r12b"; 13 -> sLit "%r13b";
248 14 -> sLit "%r14b"; 15 -> sLit "%r15b";
249 _ -> sLit "very naughty x86_64 byte register"
250 })
251
252 ppr64_reg_word i = ptext
253 (case i of {
254 0 -> sLit "%ax"; 1 -> sLit "%bx";
255 2 -> sLit "%cx"; 3 -> sLit "%dx";
256 4 -> sLit "%si"; 5 -> sLit "%di";
257 6 -> sLit "%bp"; 7 -> sLit "%sp";
258 8 -> sLit "%r8w"; 9 -> sLit "%r9w";
259 10 -> sLit "%r10w"; 11 -> sLit "%r11w";
260 12 -> sLit "%r12w"; 13 -> sLit "%r13w";
261 14 -> sLit "%r14w"; 15 -> sLit "%r15w";
262 _ -> sLit "very naughty x86_64 word register"
263 })
264
265 ppr64_reg_long i = ptext
266 (case i of {
267 0 -> sLit "%eax"; 1 -> sLit "%ebx";
268 2 -> sLit "%ecx"; 3 -> sLit "%edx";
269 4 -> sLit "%esi"; 5 -> sLit "%edi";
270 6 -> sLit "%ebp"; 7 -> sLit "%esp";
271 8 -> sLit "%r8d"; 9 -> sLit "%r9d";
272 10 -> sLit "%r10d"; 11 -> sLit "%r11d";
273 12 -> sLit "%r12d"; 13 -> sLit "%r13d";
274 14 -> sLit "%r14d"; 15 -> sLit "%r15d";
275 _ -> sLit "very naughty x86_64 register"
276 })
277
278 ppr64_reg_quad i = ptext
279 (case i of {
280 0 -> sLit "%rax"; 1 -> sLit "%rbx";
281 2 -> sLit "%rcx"; 3 -> sLit "%rdx";
282 4 -> sLit "%rsi"; 5 -> sLit "%rdi";
283 6 -> sLit "%rbp"; 7 -> sLit "%rsp";
284 8 -> sLit "%r8"; 9 -> sLit "%r9";
285 10 -> sLit "%r10"; 11 -> sLit "%r11";
286 12 -> sLit "%r12"; 13 -> sLit "%r13";
287 14 -> sLit "%r14"; 15 -> sLit "%r15";
288 _ -> ppr_reg_float i
289 })
290
291 ppr_reg_float :: Int -> LitString
292 ppr_reg_float i = case i of
293 16 -> sLit "%fake0"; 17 -> sLit "%fake1"
294 18 -> sLit "%fake2"; 19 -> sLit "%fake3"
295 20 -> sLit "%fake4"; 21 -> sLit "%fake5"
296 24 -> sLit "%xmm0"; 25 -> sLit "%xmm1"
297 26 -> sLit "%xmm2"; 27 -> sLit "%xmm3"
298 28 -> sLit "%xmm4"; 29 -> sLit "%xmm5"
299 30 -> sLit "%xmm6"; 31 -> sLit "%xmm7"
300 32 -> sLit "%xmm8"; 33 -> sLit "%xmm9"
301 34 -> sLit "%xmm10"; 35 -> sLit "%xmm11"
302 36 -> sLit "%xmm12"; 37 -> sLit "%xmm13"
303 38 -> sLit "%xmm14"; 39 -> sLit "%xmm15"
304 _ -> sLit "very naughty x86 register"
305
306 pprSize :: Size -> SDoc
307 pprSize x
308 = ptext (case x of
309 II8 -> sLit "b"
310 II16 -> sLit "w"
311 II32 -> sLit "l"
312 II64 -> sLit "q"
313 FF32 -> sLit "ss" -- "scalar single-precision float" (SSE2)
314 FF64 -> sLit "sd" -- "scalar double-precision float" (SSE2)
315 FF80 -> sLit "t"
316 )
317
318 pprSize_x87 :: Size -> SDoc
319 pprSize_x87 x
320 = ptext $ case x of
321 FF32 -> sLit "s"
322 FF64 -> sLit "l"
323 FF80 -> sLit "t"
324 _ -> panic "X86.Ppr.pprSize_x87"
325
326 pprCond :: Cond -> SDoc
327 pprCond c
328 = ptext (case c of {
329 GEU -> sLit "ae"; LU -> sLit "b";
330 EQQ -> sLit "e"; GTT -> sLit "g";
331 GE -> sLit "ge"; GU -> sLit "a";
332 LTT -> sLit "l"; LE -> sLit "le";
333 LEU -> sLit "be"; NE -> sLit "ne";
334 NEG -> sLit "s"; POS -> sLit "ns";
335 CARRY -> sLit "c"; OFLO -> sLit "o";
336 PARITY -> sLit "p"; NOTPARITY -> sLit "np";
337 ALWAYS -> sLit "mp"})
338
339
340 pprImm :: Imm -> SDoc
341 pprImm (ImmInt i) = int i
342 pprImm (ImmInteger i) = integer i
343 pprImm (ImmCLbl l) = ppr l
344 pprImm (ImmIndex l i) = ppr l <> char '+' <> int i
345 pprImm (ImmLit s) = s
346
347 pprImm (ImmFloat _) = ptext (sLit "naughty float immediate")
348 pprImm (ImmDouble _) = ptext (sLit "naughty double immediate")
349
350 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
351 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
352 <> lparen <> pprImm b <> rparen
353
354
355
356 pprAddr :: AddrMode -> SDoc
357 pprAddr (ImmAddr imm off)
358 = let pp_imm = pprImm imm
359 in
360 if (off == 0) then
361 pp_imm
362 else if (off < 0) then
363 pp_imm <> int off
364 else
365 pp_imm <> char '+' <> int off
366
367 pprAddr (AddrBaseIndex base index displacement)
368 = sdocWithPlatform $ \platform ->
369 let
370 pp_disp = ppr_disp displacement
371 pp_off p = pp_disp <> char '(' <> p <> char ')'
372 pp_reg r = pprReg (archWordSize (target32Bit platform)) r
373 in
374 case (base, index) of
375 (EABaseNone, EAIndexNone) -> pp_disp
376 (EABaseReg b, EAIndexNone) -> pp_off (pp_reg b)
377 (EABaseRip, EAIndexNone) -> pp_off (ptext (sLit "%rip"))
378 (EABaseNone, EAIndex r i) -> pp_off (comma <> pp_reg r <> comma <> int i)
379 (EABaseReg b, EAIndex r i) -> pp_off (pp_reg b <> comma <> pp_reg r
380 <> comma <> int i)
381 _ -> panic "X86.Ppr.pprAddr: no match"
382
383 where
384 ppr_disp (ImmInt 0) = empty
385 ppr_disp imm = pprImm imm
386
387
388 pprSectionHeader :: Section -> SDoc
389 pprSectionHeader seg =
390 sdocWithPlatform $ \platform ->
391 case platformOS platform of
392 OSDarwin
393 | target32Bit platform ->
394 case seg of
395 Text -> text ".text\n\t.align 2"
396 Data -> text ".data\n\t.align 2"
397 ReadOnlyData -> text ".const\n\t.align 2"
398 RelocatableReadOnlyData
399 -> text ".const_data\n\t.align 2"
400 UninitialisedData -> text ".data\n\t.align 2"
401 ReadOnlyData16 -> text ".const\n\t.align 4"
402 OtherSection _ -> panic "X86.Ppr.pprSectionHeader: unknown section"
403 | otherwise ->
404 case seg of
405 Text -> text ".text\n\t.align 3"
406 Data -> text ".data\n\t.align 3"
407 ReadOnlyData -> text ".const\n\t.align 3"
408 RelocatableReadOnlyData
409 -> text ".const_data\n\t.align 3"
410 UninitialisedData -> text ".data\n\t.align 3"
411 ReadOnlyData16 -> text ".const\n\t.align 4"
412 OtherSection _ -> panic "PprMach.pprSectionHeader: unknown section"
413 _
414 | target32Bit platform ->
415 case seg of
416 Text -> text ".text\n\t.align 4,0x90"
417 Data -> text ".data\n\t.align 4"
418 ReadOnlyData -> text ".section .rodata\n\t.align 4"
419 RelocatableReadOnlyData
420 -> text ".section .data\n\t.align 4"
421 UninitialisedData -> text ".section .bss\n\t.align 4"
422 ReadOnlyData16 -> text ".section .rodata\n\t.align 16"
423 OtherSection _ -> panic "X86.Ppr.pprSectionHeader: unknown section"
424 | otherwise ->
425 case seg of
426 Text -> text ".text\n\t.align 8"
427 Data -> text ".data\n\t.align 8"
428 ReadOnlyData -> text ".section .rodata\n\t.align 8"
429 RelocatableReadOnlyData
430 -> text ".section .data\n\t.align 8"
431 UninitialisedData -> text ".section .bss\n\t.align 8"
432 ReadOnlyData16 -> text ".section .rodata.cst16\n\t.align 16"
433 OtherSection _ -> panic "PprMach.pprSectionHeader: unknown section"
434
435
436
437
438 pprDataItem :: CmmLit -> SDoc
439 pprDataItem lit = sdocWithDynFlags $ \dflags -> pprDataItem' dflags lit
440
441 pprDataItem' :: DynFlags -> CmmLit -> SDoc
442 pprDataItem' dflags lit
443 = vcat (ppr_item (cmmTypeSize $ cmmLitType dflags lit) lit)
444 where
445 platform = targetPlatform dflags
446 imm = litToImm lit
447
448 -- These seem to be common:
449 ppr_item II8 _ = [ptext (sLit "\t.byte\t") <> pprImm imm]
450 ppr_item II16 _ = [ptext (sLit "\t.word\t") <> pprImm imm]
451 ppr_item II32 _ = [ptext (sLit "\t.long\t") <> pprImm imm]
452
453 ppr_item FF32 (CmmFloat r _)
454 = let bs = floatToBytes (fromRational r)
455 in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
456
457 ppr_item FF64 (CmmFloat r _)
458 = let bs = doubleToBytes (fromRational r)
459 in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
460
461 ppr_item II64 _
462 = case platformOS platform of
463 OSDarwin
464 | target32Bit platform ->
465 case lit of
466 CmmInt x _ ->
467 [ptext (sLit "\t.long\t")
468 <> int (fromIntegral (fromIntegral x :: Word32)),
469 ptext (sLit "\t.long\t")
470 <> int (fromIntegral
471 (fromIntegral (x `shiftR` 32) :: Word32))]
472 _ -> panic "X86.Ppr.ppr_item: no match for II64"
473 | otherwise ->
474 [ptext (sLit "\t.quad\t") <> pprImm imm]
475 _
476 | target32Bit platform ->
477 [ptext (sLit "\t.quad\t") <> pprImm imm]
478 | otherwise ->
479 -- x86_64: binutils can't handle the R_X86_64_PC64
480 -- relocation type, which means we can't do
481 -- pc-relative 64-bit addresses. Fortunately we're
482 -- assuming the small memory model, in which all such
483 -- offsets will fit into 32 bits, so we have to stick
484 -- to 32-bit offset fields and modify the RTS
485 -- appropriately
486 --
487 -- See Note [x86-64-relative] in includes/rts/storage/InfoTables.h
488 --
489 case lit of
490 -- A relative relocation:
491 CmmLabelDiffOff _ _ _ ->
492 [ptext (sLit "\t.long\t") <> pprImm imm,
493 ptext (sLit "\t.long\t0")]
494 _ ->
495 [ptext (sLit "\t.quad\t") <> pprImm imm]
496
497 ppr_item _ _
498 = panic "X86.Ppr.ppr_item: no match"
499
500
501
502 pprInstr :: Instr -> SDoc
503
504 pprInstr (COMMENT _) = empty -- nuke 'em
505 {-
506 pprInstr (COMMENT s) = ptext (sLit "# ") <> ftext s
507 -}
508
509 pprInstr (LOCATION file line col name)
510 = ptext (sLit "\t.loc ") <> ppr file <+> ppr line <+> ppr col <>
511 ptext (sLit " /* ") <> text name <> ptext (sLit " */")
512
513 pprInstr (DELTA d)
514 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
515
516 pprInstr (NEWBLOCK _)
517 = panic "PprMach.pprInstr: NEWBLOCK"
518
519 pprInstr (LDATA _ _)
520 = panic "PprMach.pprInstr: LDATA"
521
522 {-
523 pprInstr (SPILL reg slot)
524 = hcat [
525 ptext (sLit "\tSPILL"),
526 char ' ',
527 pprUserReg reg,
528 comma,
529 ptext (sLit "SLOT") <> parens (int slot)]
530
531 pprInstr (RELOAD slot reg)
532 = hcat [
533 ptext (sLit "\tRELOAD"),
534 char ' ',
535 ptext (sLit "SLOT") <> parens (int slot),
536 comma,
537 pprUserReg reg]
538 -}
539
540 -- Replace 'mov $0x0,%reg' by 'xor %reg,%reg', which is smaller and cheaper.
541 -- The code generator catches most of these already, but not all.
542 pprInstr (MOV size (OpImm (ImmInt 0)) dst@(OpReg _))
543 = pprInstr (XOR size' dst dst)
544 where size' = case size of
545 II64 -> II32 -- 32-bit version is equivalent, and smaller
546 _ -> size
547 pprInstr (MOV size src dst)
548 = pprSizeOpOp (sLit "mov") size src dst
549
550 pprInstr (CMOV cc size src dst)
551 = pprCondOpReg (sLit "cmov") size cc src dst
552
553 pprInstr (MOVZxL II32 src dst) = pprSizeOpOp (sLit "mov") II32 src dst
554 -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
555 -- movl. But we represent it as a MOVZxL instruction, because
556 -- the reg alloc would tend to throw away a plain reg-to-reg
557 -- move, and we still want it to do that.
558
559 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce (sLit "movz") sizes II32 src dst
560 -- zero-extension only needs to extend to 32 bits: on x86_64,
561 -- the remaining zero-extension to 64 bits is automatic, and the 32-bit
562 -- instruction is shorter.
563
564 pprInstr (MOVSxL sizes src dst)
565 = sdocWithPlatform $ \platform ->
566 pprSizeOpOpCoerce (sLit "movs") sizes (archWordSize (target32Bit platform)) src dst
567
568 -- here we do some patching, since the physical registers are only set late
569 -- in the code generation.
570 pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
571 | reg1 == reg3
572 = pprSizeOpOp (sLit "add") size (OpReg reg2) dst
573
574 pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
575 | reg2 == reg3
576 = pprSizeOpOp (sLit "add") size (OpReg reg1) dst
577
578 pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
579 | reg1 == reg3
580 = pprInstr (ADD size (OpImm displ) dst)
581
582 pprInstr (LEA size src dst) = pprSizeOpOp (sLit "lea") size src dst
583
584 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
585 = pprSizeOp (sLit "dec") size dst
586 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
587 = pprSizeOp (sLit "inc") size dst
588 pprInstr (ADD size src dst) = pprSizeOpOp (sLit "add") size src dst
589 pprInstr (ADC size src dst) = pprSizeOpOp (sLit "adc") size src dst
590 pprInstr (SUB size src dst) = pprSizeOpOp (sLit "sub") size src dst
591 pprInstr (SBB size src dst) = pprSizeOpOp (sLit "sbb") size src dst
592 pprInstr (IMUL size op1 op2) = pprSizeOpOp (sLit "imul") size op1 op2
593
594 pprInstr (ADD_CC size src dst)
595 = pprSizeOpOp (sLit "add") size src dst
596 pprInstr (SUB_CC size src dst)
597 = pprSizeOpOp (sLit "sub") size src dst
598
599 {- A hack. The Intel documentation says that "The two and three
600 operand forms [of IMUL] may also be used with unsigned operands
601 because the lower half of the product is the same regardless if
602 (sic) the operands are signed or unsigned. The CF and OF flags,
603 however, cannot be used to determine if the upper half of the
604 result is non-zero." So there.
605 -}
606
607 -- Use a 32-bit instruction when possible as it saves a byte.
608 -- Notably, extracting the tag bits of a pointer has this form.
609 -- TODO: we could save a byte in a subsequent CMP instruction too,
610 -- but need something like a peephole pass for this
611 pprInstr (AND II64 src@(OpImm (ImmInteger mask)) dst)
612 | 0 <= mask && mask < 0xffffffff
613 = pprInstr (AND II32 src dst)
614 pprInstr (AND size src dst) = pprSizeOpOp (sLit "and") size src dst
615 pprInstr (OR size src dst) = pprSizeOpOp (sLit "or") size src dst
616
617 pprInstr (XOR FF32 src dst) = pprOpOp (sLit "xorps") FF32 src dst
618 pprInstr (XOR FF64 src dst) = pprOpOp (sLit "xorpd") FF64 src dst
619 pprInstr (XOR size src dst) = pprSizeOpOp (sLit "xor") size src dst
620
621 pprInstr (POPCNT size src dst) = pprOpOp (sLit "popcnt") size src (OpReg dst)
622 pprInstr (BSF size src dst) = pprOpOp (sLit "bsf") size src (OpReg dst)
623 pprInstr (BSR size src dst) = pprOpOp (sLit "bsr") size src (OpReg dst)
624
625 pprInstr (PREFETCH NTA size src ) = pprSizeOp_ (sLit "prefetchnta") size src
626 pprInstr (PREFETCH Lvl0 size src) = pprSizeOp_ (sLit "prefetcht0") size src
627 pprInstr (PREFETCH Lvl1 size src) = pprSizeOp_ (sLit "prefetcht1") size src
628 pprInstr (PREFETCH Lvl2 size src) = pprSizeOp_ (sLit "prefetcht2") size src
629
630 pprInstr (NOT size op) = pprSizeOp (sLit "not") size op
631 pprInstr (BSWAP size op) = pprSizeOp (sLit "bswap") size (OpReg op)
632 pprInstr (NEGI size op) = pprSizeOp (sLit "neg") size op
633
634 pprInstr (SHL size src dst) = pprShift (sLit "shl") size src dst
635 pprInstr (SAR size src dst) = pprShift (sLit "sar") size src dst
636 pprInstr (SHR size src dst) = pprShift (sLit "shr") size src dst
637
638 pprInstr (BT size imm src) = pprSizeImmOp (sLit "bt") size imm src
639
640 pprInstr (CMP size src dst)
641 | is_float size = pprSizeOpOp (sLit "ucomi") size src dst -- SSE2
642 | otherwise = pprSizeOpOp (sLit "cmp") size src dst
643 where
644 -- This predicate is needed here and nowhere else
645 is_float FF32 = True
646 is_float FF64 = True
647 is_float FF80 = True
648 is_float _ = False
649
650 pprInstr (TEST size src dst) = sdocWithPlatform $ \platform ->
651 let size' = case (src,dst) of
652 -- Match instructions like 'test $0x3,%esi' or 'test $0x7,%rbx'.
653 -- We can replace them by equivalent, but smaller instructions
654 -- by reducing the size of the immediate operand as far as possible.
655 -- (We could handle masks larger than a single byte too,
656 -- but it would complicate the code considerably
657 -- and tag checks are by far the most common case.)
658 (OpImm (ImmInteger mask), OpReg dstReg)
659 | 0 <= mask && mask < 256 -> minSizeOfReg platform dstReg
660 _ -> size
661 in pprSizeOpOp (sLit "test") size' src dst
662 where
663 minSizeOfReg platform (RegReal (RealRegSingle i))
664 | target32Bit platform && i <= 3 = II8 -- al, bl, cl, dl
665 | target32Bit platform && i <= 7 = II16 -- si, di, bp, sp
666 | not (target32Bit platform) && i <= 15 = II8 -- al .. r15b
667 minSizeOfReg _ _ = size -- other
668
669 pprInstr (PUSH size op) = pprSizeOp (sLit "push") size op
670 pprInstr (POP size op) = pprSizeOp (sLit "pop") size op
671
672 -- both unused (SDM):
673 -- pprInstr PUSHA = ptext (sLit "\tpushal")
674 -- pprInstr POPA = ptext (sLit "\tpopal")
675
676 pprInstr NOP = ptext (sLit "\tnop")
677 pprInstr (CLTD II32) = ptext (sLit "\tcltd")
678 pprInstr (CLTD II64) = ptext (sLit "\tcqto")
679
680 pprInstr (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand II8 op)
681
682 pprInstr (JXX cond blockid)
683 = pprCondInstr (sLit "j") cond (ppr lab)
684 where lab = mkAsmTempLabel (getUnique blockid)
685
686 pprInstr (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm imm)
687
688 pprInstr (JMP (OpImm imm) _) = ptext (sLit "\tjmp ") <> pprImm imm
689 pprInstr (JMP op _) = sdocWithPlatform $ \platform ->
690 ptext (sLit "\tjmp *") <> pprOperand (archWordSize (target32Bit platform)) op
691 pprInstr (JMP_TBL op _ _ _) = pprInstr (JMP op [])
692 pprInstr (CALL (Left imm) _) = ptext (sLit "\tcall ") <> pprImm imm
693 pprInstr (CALL (Right reg) _) = sdocWithPlatform $ \platform ->
694 ptext (sLit "\tcall *") <> pprReg (archWordSize (target32Bit platform)) reg
695
696 pprInstr (IDIV sz op) = pprSizeOp (sLit "idiv") sz op
697 pprInstr (DIV sz op) = pprSizeOp (sLit "div") sz op
698 pprInstr (IMUL2 sz op) = pprSizeOp (sLit "imul") sz op
699
700 -- x86_64 only
701 pprInstr (MUL size op1 op2) = pprSizeOpOp (sLit "mul") size op1 op2
702 pprInstr (MUL2 size op) = pprSizeOp (sLit "mul") size op
703
704 pprInstr (FDIV size op1 op2) = pprSizeOpOp (sLit "div") size op1 op2
705
706 pprInstr (CVTSS2SD from to) = pprRegReg (sLit "cvtss2sd") from to
707 pprInstr (CVTSD2SS from to) = pprRegReg (sLit "cvtsd2ss") from to
708 pprInstr (CVTTSS2SIQ sz from to) = pprSizeSizeOpReg (sLit "cvttss2si") FF32 sz from to
709 pprInstr (CVTTSD2SIQ sz from to) = pprSizeSizeOpReg (sLit "cvttsd2si") FF64 sz from to
710 pprInstr (CVTSI2SS sz from to) = pprSizeOpReg (sLit "cvtsi2ss") sz from to
711 pprInstr (CVTSI2SD sz from to) = pprSizeOpReg (sLit "cvtsi2sd") sz from to
712
713 -- FETCHGOT for PIC on ELF platforms
714 pprInstr (FETCHGOT reg)
715 = vcat [ ptext (sLit "\tcall 1f"),
716 hcat [ ptext (sLit "1:\tpopl\t"), pprReg II32 reg ],
717 hcat [ ptext (sLit "\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
718 pprReg II32 reg ]
719 ]
720
721 -- FETCHPC for PIC on Darwin/x86
722 -- get the instruction pointer into a register
723 -- (Terminology note: the IP is called Program Counter on PPC,
724 -- and it's a good thing to use the same name on both platforms)
725 pprInstr (FETCHPC reg)
726 = vcat [ ptext (sLit "\tcall 1f"),
727 hcat [ ptext (sLit "1:\tpopl\t"), pprReg II32 reg ]
728 ]
729
730
731 -- -----------------------------------------------------------------------------
732 -- i386 floating-point
733
734 -- Simulating a flat register set on the x86 FP stack is tricky.
735 -- you have to free %st(7) before pushing anything on the FP reg stack
736 -- so as to preclude the possibility of a FP stack overflow exception.
737 pprInstr g@(GMOV src dst)
738 | src == dst
739 = empty
740 | otherwise
741 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
742
743 -- GLD sz addr dst ==> FLDsz addr ; FSTP (dst+1)
744 pprInstr g@(GLD sz addr dst)
745 = pprG g (hcat [gtab, text "fld", pprSize_x87 sz, gsp,
746 pprAddr addr, gsemi, gpop dst 1])
747
748 -- GST sz src addr ==> FLD dst ; FSTPsz addr
749 pprInstr g@(GST sz src addr)
750 | src == fake0 && sz /= FF80 -- fstt instruction doesn't exist
751 = pprG g (hcat [gtab,
752 text "fst", pprSize_x87 sz, gsp, pprAddr addr])
753 | otherwise
754 = pprG g (hcat [gtab, gpush src 0, gsemi,
755 text "fstp", pprSize_x87 sz, gsp, pprAddr addr])
756
757 pprInstr g@(GLDZ dst)
758 = pprG g (hcat [gtab, text "fldz ; ", gpop dst 1])
759 pprInstr g@(GLD1 dst)
760 = pprG g (hcat [gtab, text "fld1 ; ", gpop dst 1])
761
762 pprInstr (GFTOI src dst)
763 = pprInstr (GDTOI src dst)
764
765 pprInstr g@(GDTOI src dst)
766 = pprG g (vcat [
767 hcat [gtab, text "subl $8, %esp ; fnstcw 4(%esp)"],
768 hcat [gtab, gpush src 0],
769 hcat [gtab, text "movzwl 4(%esp), ", reg,
770 text " ; orl $0xC00, ", reg],
771 hcat [gtab, text "movl ", reg, text ", 0(%esp) ; fldcw 0(%esp)"],
772 hcat [gtab, text "fistpl 0(%esp)"],
773 hcat [gtab, text "fldcw 4(%esp) ; movl 0(%esp), ", reg],
774 hcat [gtab, text "addl $8, %esp"]
775 ])
776 where
777 reg = pprReg II32 dst
778
779 pprInstr (GITOF src dst)
780 = pprInstr (GITOD src dst)
781
782 pprInstr g@(GITOD src dst)
783 = pprG g (hcat [gtab, text "pushl ", pprReg II32 src,
784 text " ; fildl (%esp) ; ",
785 gpop dst 1, text " ; addl $4,%esp"])
786
787 pprInstr g@(GDTOF src dst)
788 = pprG g (vcat [gtab <> gpush src 0,
789 gtab <> text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ;",
790 gtab <> gpop dst 1])
791
792 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
793 this far into the jungle AND you give a Rat's Ass (tm) what's going
794 on, here's the deal. Generate code to do a floating point comparison
795 of src1 and src2, of kind cond, and set the Zero flag if true.
796
797 The complications are to do with handling NaNs correctly. We want the
798 property that if either argument is NaN, then the result of the
799 comparison is False ... except if we're comparing for inequality,
800 in which case the answer is True.
801
802 Here's how the general (non-inequality) case works. As an
803 example, consider generating the an equality test:
804
805 pushl %eax -- we need to mess with this
806 <get src1 to top of FPU stack>
807 fcomp <src2 location in FPU stack> and pop pushed src1
808 -- Result of comparison is in FPU Status Register bits
809 -- C3 C2 and C0
810 fstsw %ax -- Move FPU Status Reg to %ax
811 sahf -- move C3 C2 C0 from %ax to integer flag reg
812 -- now the serious magic begins
813 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
814 sete %al -- %al = if arg1 == arg2 then 1 else 0
815 andb %ah,%al -- %al &= %ah
816 -- so %al == 1 iff (comparable && same); else it holds 0
817 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
818 else %al == 0xFF, ZeroFlag=0
819 -- the zero flag is now set as we desire.
820 popl %eax
821
822 The special case of inequality differs thusly:
823
824 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
825 setne %al -- %al = if arg1 /= arg2 then 1 else 0
826 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
827 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
828 else (%al == 0xFF, ZF=0)
829 -}
830 pprInstr g@(GCMP cond src1 src2)
831 | case cond of { NE -> True; _ -> False }
832 = pprG g (vcat [
833 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
834 hcat [gtab, text "fcomp ", greg src2 1,
835 text "; fstsw %ax ; sahf ; setpe %ah"],
836 hcat [gtab, text "setne %al ; ",
837 text "orb %ah,%al ; decb %al ; popl %eax"]
838 ])
839 | otherwise
840 = pprG g (vcat [
841 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
842 hcat [gtab, text "fcomp ", greg src2 1,
843 text "; fstsw %ax ; sahf ; setpo %ah"],
844 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
845 text "andb %ah,%al ; decb %al ; popl %eax"]
846 ])
847 where
848 {- On the 486, the flags set by FP compare are the unsigned ones!
849 (This looks like a HACK to me. WDP 96/03)
850 -}
851 fix_FP_cond :: Cond -> Cond
852 fix_FP_cond GE = GEU
853 fix_FP_cond GTT = GU
854 fix_FP_cond LTT = LU
855 fix_FP_cond LE = LEU
856 fix_FP_cond EQQ = EQQ
857 fix_FP_cond NE = NE
858 fix_FP_cond _ = panic "X86.Ppr.fix_FP_cond: no match"
859 -- there should be no others
860
861
862 pprInstr g@(GABS _ src dst)
863 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
864
865 pprInstr g@(GNEG _ src dst)
866 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
867
868 pprInstr g@(GSQRT sz src dst)
869 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
870 hcat [gtab, gcoerceto sz, gpop dst 1])
871
872 pprInstr g@(GSIN sz l1 l2 src dst)
873 = pprG g (pprTrigOp "fsin" False l1 l2 src dst sz)
874
875 pprInstr g@(GCOS sz l1 l2 src dst)
876 = pprG g (pprTrigOp "fcos" False l1 l2 src dst sz)
877
878 pprInstr g@(GTAN sz l1 l2 src dst)
879 = pprG g (pprTrigOp "fptan" True l1 l2 src dst sz)
880
881 -- In the translations for GADD, GMUL, GSUB and GDIV,
882 -- the first two cases are mere optimisations. The otherwise clause
883 -- generates correct code under all circumstances.
884
885 pprInstr g@(GADD _ src1 src2 dst)
886 | src1 == dst
887 = pprG g (text "\t#GADD-xxxcase1" $$
888 hcat [gtab, gpush src2 0,
889 text " ; faddp %st(0),", greg src1 1])
890 | src2 == dst
891 = pprG g (text "\t#GADD-xxxcase2" $$
892 hcat [gtab, gpush src1 0,
893 text " ; faddp %st(0),", greg src2 1])
894 | otherwise
895 = pprG g (hcat [gtab, gpush src1 0,
896 text " ; fadd ", greg src2 1, text ",%st(0)",
897 gsemi, gpop dst 1])
898
899
900 pprInstr g@(GMUL _ src1 src2 dst)
901 | src1 == dst
902 = pprG g (text "\t#GMUL-xxxcase1" $$
903 hcat [gtab, gpush src2 0,
904 text " ; fmulp %st(0),", greg src1 1])
905 | src2 == dst
906 = pprG g (text "\t#GMUL-xxxcase2" $$
907 hcat [gtab, gpush src1 0,
908 text " ; fmulp %st(0),", greg src2 1])
909 | otherwise
910 = pprG g (hcat [gtab, gpush src1 0,
911 text " ; fmul ", greg src2 1, text ",%st(0)",
912 gsemi, gpop dst 1])
913
914
915 pprInstr g@(GSUB _ src1 src2 dst)
916 | src1 == dst
917 = pprG g (text "\t#GSUB-xxxcase1" $$
918 hcat [gtab, gpush src2 0,
919 text " ; fsubrp %st(0),", greg src1 1])
920 | src2 == dst
921 = pprG g (text "\t#GSUB-xxxcase2" $$
922 hcat [gtab, gpush src1 0,
923 text " ; fsubp %st(0),", greg src2 1])
924 | otherwise
925 = pprG g (hcat [gtab, gpush src1 0,
926 text " ; fsub ", greg src2 1, text ",%st(0)",
927 gsemi, gpop dst 1])
928
929
930 pprInstr g@(GDIV _ src1 src2 dst)
931 | src1 == dst
932 = pprG g (text "\t#GDIV-xxxcase1" $$
933 hcat [gtab, gpush src2 0,
934 text " ; fdivrp %st(0),", greg src1 1])
935 | src2 == dst
936 = pprG g (text "\t#GDIV-xxxcase2" $$
937 hcat [gtab, gpush src1 0,
938 text " ; fdivp %st(0),", greg src2 1])
939 | otherwise
940 = pprG g (hcat [gtab, gpush src1 0,
941 text " ; fdiv ", greg src2 1, text ",%st(0)",
942 gsemi, gpop dst 1])
943
944
945 pprInstr GFREE
946 = vcat [ ptext (sLit "\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
947 ptext (sLit "\tffree %st(4) ;ffree %st(5)")
948 ]
949
950 -- Atomics
951
952 pprInstr (LOCK i) = ptext (sLit "\tlock") $$ pprInstr i
953
954 pprInstr MFENCE = ptext (sLit "\tmfence")
955
956 pprInstr (XADD size src dst) = pprSizeOpOp (sLit "xadd") size src dst
957
958 pprInstr (CMPXCHG size src dst) = pprSizeOpOp (sLit "cmpxchg") size src dst
959
960 pprInstr _
961 = panic "X86.Ppr.pprInstr: no match"
962
963
964 pprTrigOp :: String -> Bool -> CLabel -> CLabel
965 -> Reg -> Reg -> Size -> SDoc
966 pprTrigOp op -- fsin, fcos or fptan
967 isTan -- we need a couple of extra steps if we're doing tan
968 l1 l2 -- internal labels for us to use
969 src dst sz
970 = -- We'll be needing %eax later on
971 hcat [gtab, text "pushl %eax;"] $$
972 -- tan is going to use an extra space on the FP stack
973 (if isTan then hcat [gtab, text "ffree %st(6)"] else empty) $$
974 -- First put the value in %st(0) and try to apply the op to it
975 hcat [gpush src 0, text ("; " ++ op)] $$
976 -- Now look to see if C2 was set (overflow, |value| >= 2^63)
977 hcat [gtab, text "fnstsw %ax"] $$
978 hcat [gtab, text "test $0x400,%eax"] $$
979 -- If we were in bounds then jump to the end
980 hcat [gtab, text "je " <> ppr l1] $$
981 -- Otherwise we need to shrink the value. Start by
982 -- loading pi, doubleing it (by adding it to itself),
983 -- and then swapping pi with the value, so the value we
984 -- want to apply op to is in %st(0) again
985 hcat [gtab, text "ffree %st(7); fldpi"] $$
986 hcat [gtab, text "fadd %st(0),%st"] $$
987 hcat [gtab, text "fxch %st(1)"] $$
988 -- Now we have a loop in which we make the value smaller,
989 -- see if it's small enough, and loop if not
990 (ppr l2 <> char ':') $$
991 hcat [gtab, text "fprem1"] $$
992 -- My Debian libc uses fstsw here for the tan code, but I can't
993 -- see any reason why it should need to be different for tan.
994 hcat [gtab, text "fnstsw %ax"] $$
995 hcat [gtab, text "test $0x400,%eax"] $$
996 hcat [gtab, text "jne " <> ppr l2] $$
997 hcat [gtab, text "fstp %st(1)"] $$
998 hcat [gtab, text op] $$
999 (ppr l1 <> char ':') $$
1000 -- Pop the 1.0 tan gave us
1001 (if isTan then hcat [gtab, text "fstp %st(0)"] else empty) $$
1002 -- Restore %eax
1003 hcat [gtab, text "popl %eax;"] $$
1004 -- And finally make the result the right size
1005 hcat [gtab, gcoerceto sz, gpop dst 1]
1006
1007 --------------------------
1008
1009 -- coerce %st(0) to the specified size
1010 gcoerceto :: Size -> SDoc
1011 gcoerceto FF64 = empty
1012 gcoerceto FF32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1013 gcoerceto _ = panic "X86.Ppr.gcoerceto: no match"
1014
1015 gpush :: Reg -> RegNo -> SDoc
1016 gpush reg offset
1017 = hcat [text "fld ", greg reg offset]
1018
1019 gpop :: Reg -> RegNo -> SDoc
1020 gpop reg offset
1021 = hcat [text "fstp ", greg reg offset]
1022
1023 greg :: Reg -> RegNo -> SDoc
1024 greg reg offset = text "%st(" <> int (gregno reg - firstfake+offset) <> char ')'
1025
1026 gsemi :: SDoc
1027 gsemi = text " ; "
1028
1029 gtab :: SDoc
1030 gtab = char '\t'
1031
1032 gsp :: SDoc
1033 gsp = char ' '
1034
1035 gregno :: Reg -> RegNo
1036 gregno (RegReal (RealRegSingle i)) = i
1037 gregno _ = --pprPanic "gregno" (ppr other)
1038 999 -- bogus; only needed for debug printing
1039
1040 pprG :: Instr -> SDoc -> SDoc
1041 pprG fake actual
1042 = (char '#' <> pprGInstr fake) $$ actual
1043
1044
1045 pprGInstr :: Instr -> SDoc
1046 pprGInstr (GMOV src dst) = pprSizeRegReg (sLit "gmov") FF64 src dst
1047 pprGInstr (GLD sz src dst) = pprSizeAddrReg (sLit "gld") sz src dst
1048 pprGInstr (GST sz src dst) = pprSizeRegAddr (sLit "gst") sz src dst
1049
1050 pprGInstr (GLDZ dst) = pprSizeReg (sLit "gldz") FF64 dst
1051 pprGInstr (GLD1 dst) = pprSizeReg (sLit "gld1") FF64 dst
1052
1053 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg (sLit "gftoi") FF32 II32 src dst
1054 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg (sLit "gdtoi") FF64 II32 src dst
1055
1056 pprGInstr (GITOF src dst) = pprSizeSizeRegReg (sLit "gitof") II32 FF32 src dst
1057 pprGInstr (GITOD src dst) = pprSizeSizeRegReg (sLit "gitod") II32 FF64 src dst
1058 pprGInstr (GDTOF src dst) = pprSizeSizeRegReg (sLit "gdtof") FF64 FF32 src dst
1059
1060 pprGInstr (GCMP co src dst) = pprCondRegReg (sLit "gcmp_") FF64 co src dst
1061 pprGInstr (GABS sz src dst) = pprSizeRegReg (sLit "gabs") sz src dst
1062 pprGInstr (GNEG sz src dst) = pprSizeRegReg (sLit "gneg") sz src dst
1063 pprGInstr (GSQRT sz src dst) = pprSizeRegReg (sLit "gsqrt") sz src dst
1064 pprGInstr (GSIN sz _ _ src dst) = pprSizeRegReg (sLit "gsin") sz src dst
1065 pprGInstr (GCOS sz _ _ src dst) = pprSizeRegReg (sLit "gcos") sz src dst
1066 pprGInstr (GTAN sz _ _ src dst) = pprSizeRegReg (sLit "gtan") sz src dst
1067
1068 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg (sLit "gadd") sz src1 src2 dst
1069 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg (sLit "gsub") sz src1 src2 dst
1070 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg (sLit "gmul") sz src1 src2 dst
1071 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg (sLit "gdiv") sz src1 src2 dst
1072
1073 pprGInstr _ = panic "X86.Ppr.pprGInstr: no match"
1074
1075 pprDollImm :: Imm -> SDoc
1076 pprDollImm i = ptext (sLit "$") <> pprImm i
1077
1078
1079 pprOperand :: Size -> Operand -> SDoc
1080 pprOperand s (OpReg r) = pprReg s r
1081 pprOperand _ (OpImm i) = pprDollImm i
1082 pprOperand _ (OpAddr ea) = pprAddr ea
1083
1084
1085 pprMnemonic_ :: LitString -> SDoc
1086 pprMnemonic_ name =
1087 char '\t' <> ptext name <> space
1088
1089
1090 pprMnemonic :: LitString -> Size -> SDoc
1091 pprMnemonic name size =
1092 char '\t' <> ptext name <> pprSize size <> space
1093
1094
1095 pprSizeImmOp :: LitString -> Size -> Imm -> Operand -> SDoc
1096 pprSizeImmOp name size imm op1
1097 = hcat [
1098 pprMnemonic name size,
1099 char '$',
1100 pprImm imm,
1101 comma,
1102 pprOperand size op1
1103 ]
1104
1105
1106 pprSizeOp_ :: LitString -> Size -> Operand -> SDoc
1107 pprSizeOp_ name size op1
1108 = hcat [
1109 pprMnemonic_ name ,
1110 pprOperand size op1
1111 ]
1112
1113 pprSizeOp :: LitString -> Size -> Operand -> SDoc
1114 pprSizeOp name size op1
1115 = hcat [
1116 pprMnemonic name size,
1117 pprOperand size op1
1118 ]
1119
1120
1121 pprSizeOpOp :: LitString -> Size -> Operand -> Operand -> SDoc
1122 pprSizeOpOp name size op1 op2
1123 = hcat [
1124 pprMnemonic name size,
1125 pprOperand size op1,
1126 comma,
1127 pprOperand size op2
1128 ]
1129
1130
1131 pprOpOp :: LitString -> Size -> Operand -> Operand -> SDoc
1132 pprOpOp name size op1 op2
1133 = hcat [
1134 pprMnemonic_ name,
1135 pprOperand size op1,
1136 comma,
1137 pprOperand size op2
1138 ]
1139
1140
1141 pprSizeReg :: LitString -> Size -> Reg -> SDoc
1142 pprSizeReg name size reg1
1143 = hcat [
1144 pprMnemonic name size,
1145 pprReg size reg1
1146 ]
1147
1148
1149 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> SDoc
1150 pprSizeRegReg name size reg1 reg2
1151 = hcat [
1152 pprMnemonic name size,
1153 pprReg size reg1,
1154 comma,
1155 pprReg size reg2
1156 ]
1157
1158
1159 pprRegReg :: LitString -> Reg -> Reg -> SDoc
1160 pprRegReg name reg1 reg2
1161 = sdocWithPlatform $ \platform ->
1162 hcat [
1163 pprMnemonic_ name,
1164 pprReg (archWordSize (target32Bit platform)) reg1,
1165 comma,
1166 pprReg (archWordSize (target32Bit platform)) reg2
1167 ]
1168
1169
1170 pprSizeOpReg :: LitString -> Size -> Operand -> Reg -> SDoc
1171 pprSizeOpReg name size op1 reg2
1172 = sdocWithPlatform $ \platform ->
1173 hcat [
1174 pprMnemonic name size,
1175 pprOperand size op1,
1176 comma,
1177 pprReg (archWordSize (target32Bit platform)) reg2
1178 ]
1179
1180 pprCondOpReg :: LitString -> Size -> Cond -> Operand -> Reg -> SDoc
1181 pprCondOpReg name size cond op1 reg2
1182 = hcat [
1183 char '\t',
1184 ptext name,
1185 pprCond cond,
1186 space,
1187 pprOperand size op1,
1188 comma,
1189 pprReg size reg2
1190 ]
1191
1192 pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> SDoc
1193 pprCondRegReg name size cond reg1 reg2
1194 = hcat [
1195 char '\t',
1196 ptext name,
1197 pprCond cond,
1198 space,
1199 pprReg size reg1,
1200 comma,
1201 pprReg size reg2
1202 ]
1203
1204 pprSizeSizeRegReg :: LitString -> Size -> Size -> Reg -> Reg -> SDoc
1205 pprSizeSizeRegReg name size1 size2 reg1 reg2
1206 = hcat [
1207 char '\t',
1208 ptext name,
1209 pprSize size1,
1210 pprSize size2,
1211 space,
1212 pprReg size1 reg1,
1213 comma,
1214 pprReg size2 reg2
1215 ]
1216
1217 pprSizeSizeOpReg :: LitString -> Size -> Size -> Operand -> Reg -> SDoc
1218 pprSizeSizeOpReg name size1 size2 op1 reg2
1219 = hcat [
1220 pprMnemonic name size2,
1221 pprOperand size1 op1,
1222 comma,
1223 pprReg size2 reg2
1224 ]
1225
1226 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> SDoc
1227 pprSizeRegRegReg name size reg1 reg2 reg3
1228 = hcat [
1229 pprMnemonic name size,
1230 pprReg size reg1,
1231 comma,
1232 pprReg size reg2,
1233 comma,
1234 pprReg size reg3
1235 ]
1236
1237
1238 pprSizeAddrReg :: LitString -> Size -> AddrMode -> Reg -> SDoc
1239 pprSizeAddrReg name size op dst
1240 = hcat [
1241 pprMnemonic name size,
1242 pprAddr op,
1243 comma,
1244 pprReg size dst
1245 ]
1246
1247
1248 pprSizeRegAddr :: LitString -> Size -> Reg -> AddrMode -> SDoc
1249 pprSizeRegAddr name size src op
1250 = hcat [
1251 pprMnemonic name size,
1252 pprReg size src,
1253 comma,
1254 pprAddr op
1255 ]
1256
1257
1258 pprShift :: LitString -> Size -> Operand -> Operand -> SDoc
1259 pprShift name size src dest
1260 = hcat [
1261 pprMnemonic name size,
1262 pprOperand II8 src, -- src is 8-bit sized
1263 comma,
1264 pprOperand size dest
1265 ]
1266
1267
1268 pprSizeOpOpCoerce :: LitString -> Size -> Size -> Operand -> Operand -> SDoc
1269 pprSizeOpOpCoerce name size1 size2 op1 op2
1270 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1271 pprOperand size1 op1,
1272 comma,
1273 pprOperand size2 op2
1274 ]
1275
1276
1277 pprCondInstr :: LitString -> Cond -> SDoc -> SDoc
1278 pprCondInstr name cond arg
1279 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1280