0c9507ab287d41b3e368cf8810ec1693518a49c0
[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 pprFormat,
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 Format
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 :: Format -> Reg -> SDoc
190 pprReg f r
191 = case r of
192 RegReal (RealRegSingle i) ->
193 sdocWithPlatform $ \platform ->
194 if target32Bit platform then ppr32_reg_no f i
195 else ppr64_reg_no f 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 :: Format -> 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 :: Format -> 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 pprFormat :: Format -> SDoc
307 pprFormat 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 pprFormat_x87 :: Format -> SDoc
319 pprFormat_x87 x
320 = ptext $ case x of
321 FF32 -> sLit "s"
322 FF64 -> sLit "l"
323 FF80 -> sLit "t"
324 _ -> panic "X86.Ppr.pprFormat_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 (archWordFormat (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 (cmmTypeFormat $ 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
512 pprInstr (DELTA d)
513 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
514
515 pprInstr (NEWBLOCK _)
516 = panic "PprMach.pprInstr: NEWBLOCK"
517
518 pprInstr (LDATA _ _)
519 = panic "PprMach.pprInstr: LDATA"
520
521 {-
522 pprInstr (SPILL reg slot)
523 = hcat [
524 ptext (sLit "\tSPILL"),
525 char ' ',
526 pprUserReg reg,
527 comma,
528 ptext (sLit "SLOT") <> parens (int slot)]
529
530 pprInstr (RELOAD slot reg)
531 = hcat [
532 ptext (sLit "\tRELOAD"),
533 char ' ',
534 ptext (sLit "SLOT") <> parens (int slot),
535 comma,
536 pprUserReg reg]
537 -}
538
539 -- Replace 'mov $0x0,%reg' by 'xor %reg,%reg', which is smaller and cheaper.
540 -- The code generator catches most of these already, but not all.
541 pprInstr (MOV format (OpImm (ImmInt 0)) dst@(OpReg _))
542 = pprInstr (XOR format' dst dst)
543 where format' = case format of
544 II64 -> II32 -- 32-bit version is equivalent, and smaller
545 _ -> format
546 pprInstr (MOV format src dst)
547 = pprFormatOpOp (sLit "mov") format src dst
548
549 pprInstr (CMOV cc format src dst)
550 = pprCondOpReg (sLit "cmov") format cc src dst
551
552 pprInstr (MOVZxL II32 src dst) = pprFormatOpOp (sLit "mov") II32 src dst
553 -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
554 -- movl. But we represent it as a MOVZxL instruction, because
555 -- the reg alloc would tend to throw away a plain reg-to-reg
556 -- move, and we still want it to do that.
557
558 pprInstr (MOVZxL formats src dst)
559 = pprFormatOpOpCoerce (sLit "movz") formats 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 formats src dst)
565 = sdocWithPlatform $ \platform ->
566 pprFormatOpOpCoerce (sLit "movs") formats (archWordFormat (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 format (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
571 | reg1 == reg3
572 = pprFormatOpOp (sLit "add") format (OpReg reg2) dst
573
574 pprInstr (LEA format (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
575 | reg2 == reg3
576 = pprFormatOpOp (sLit "add") format (OpReg reg1) dst
577
578 pprInstr (LEA format (OpAddr (AddrBaseIndex (EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
579 | reg1 == reg3
580 = pprInstr (ADD format (OpImm displ) dst)
581
582 pprInstr (LEA format src dst) = pprFormatOpOp (sLit "lea") format src dst
583
584 pprInstr (ADD format (OpImm (ImmInt (-1))) dst)
585 = pprFormatOp (sLit "dec") format dst
586 pprInstr (ADD format (OpImm (ImmInt 1)) dst)
587 = pprFormatOp (sLit "inc") format dst
588 pprInstr (ADD format src dst) = pprFormatOpOp (sLit "add") format src dst
589 pprInstr (ADC format src dst) = pprFormatOpOp (sLit "adc") format src dst
590 pprInstr (SUB format src dst) = pprFormatOpOp (sLit "sub") format src dst
591 pprInstr (SBB format src dst) = pprFormatOpOp (sLit "sbb") format src dst
592 pprInstr (IMUL format op1 op2) = pprFormatOpOp (sLit "imul") format op1 op2
593
594 pprInstr (ADD_CC format src dst)
595 = pprFormatOpOp (sLit "add") format src dst
596 pprInstr (SUB_CC format src dst)
597 = pprFormatOpOp (sLit "sub") format 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 format src dst) = pprFormatOpOp (sLit "and") format src dst
615 pprInstr (OR format src dst) = pprFormatOpOp (sLit "or") format 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 format src dst) = pprFormatOpOp (sLit "xor") format src dst
620
621 pprInstr (POPCNT format src dst) = pprOpOp (sLit "popcnt") format src (OpReg dst)
622 pprInstr (BSF format src dst) = pprOpOp (sLit "bsf") format src (OpReg dst)
623 pprInstr (BSR format src dst) = pprOpOp (sLit "bsr") format src (OpReg dst)
624
625 pprInstr (PREFETCH NTA format src ) = pprFormatOp_ (sLit "prefetchnta") format src
626 pprInstr (PREFETCH Lvl0 format src) = pprFormatOp_ (sLit "prefetcht0") format src
627 pprInstr (PREFETCH Lvl1 format src) = pprFormatOp_ (sLit "prefetcht1") format src
628 pprInstr (PREFETCH Lvl2 format src) = pprFormatOp_ (sLit "prefetcht2") format src
629
630 pprInstr (NOT format op) = pprFormatOp (sLit "not") format op
631 pprInstr (BSWAP format op) = pprFormatOp (sLit "bswap") format (OpReg op)
632 pprInstr (NEGI format op) = pprFormatOp (sLit "neg") format op
633
634 pprInstr (SHL format src dst) = pprShift (sLit "shl") format src dst
635 pprInstr (SAR format src dst) = pprShift (sLit "sar") format src dst
636 pprInstr (SHR format src dst) = pprShift (sLit "shr") format src dst
637
638 pprInstr (BT format imm src) = pprFormatImmOp (sLit "bt") format imm src
639
640 pprInstr (CMP format src dst)
641 | isFloatFormat format = pprFormatOpOp (sLit "ucomi") format src dst -- SSE2
642 | otherwise = pprFormatOpOp (sLit "cmp") format src dst
643
644 pprInstr (TEST format src dst) = sdocWithPlatform $ \platform ->
645 let format' = case (src,dst) of
646 -- Match instructions like 'test $0x3,%esi' or 'test $0x7,%rbx'.
647 -- We can replace them by equivalent, but smaller instructions
648 -- by reducing the size of the immediate operand as far as possible.
649 -- (We could handle masks larger than a single byte too,
650 -- but it would complicate the code considerably
651 -- and tag checks are by far the most common case.)
652 (OpImm (ImmInteger mask), OpReg dstReg)
653 | 0 <= mask && mask < 256 -> minSizeOfReg platform dstReg
654 _ -> format
655 in pprFormatOpOp (sLit "test") format' src dst
656 where
657 minSizeOfReg platform (RegReal (RealRegSingle i))
658 | target32Bit platform && i <= 3 = II8 -- al, bl, cl, dl
659 | target32Bit platform && i <= 7 = II16 -- si, di, bp, sp
660 | not (target32Bit platform) && i <= 15 = II8 -- al .. r15b
661 minSizeOfReg _ _ = format -- other
662
663 pprInstr (PUSH format op) = pprFormatOp (sLit "push") format op
664 pprInstr (POP format op) = pprFormatOp (sLit "pop") format op
665
666 -- both unused (SDM):
667 -- pprInstr PUSHA = ptext (sLit "\tpushal")
668 -- pprInstr POPA = ptext (sLit "\tpopal")
669
670 pprInstr NOP = ptext (sLit "\tnop")
671 pprInstr (CLTD II32) = ptext (sLit "\tcltd")
672 pprInstr (CLTD II64) = ptext (sLit "\tcqto")
673
674 pprInstr (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand II8 op)
675
676 pprInstr (JXX cond blockid)
677 = pprCondInstr (sLit "j") cond (ppr lab)
678 where lab = mkAsmTempLabel (getUnique blockid)
679
680 pprInstr (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm imm)
681
682 pprInstr (JMP (OpImm imm) _) = ptext (sLit "\tjmp ") <> pprImm imm
683 pprInstr (JMP op _) = sdocWithPlatform $ \platform ->
684 ptext (sLit "\tjmp *")
685 <> pprOperand (archWordFormat (target32Bit platform)) op
686 pprInstr (JMP_TBL op _ _ _) = pprInstr (JMP op [])
687 pprInstr (CALL (Left imm) _) = ptext (sLit "\tcall ") <> pprImm imm
688 pprInstr (CALL (Right reg) _) = sdocWithPlatform $ \platform ->
689 ptext (sLit "\tcall *")
690 <> pprReg (archWordFormat (target32Bit platform)) reg
691
692 pprInstr (IDIV fmt op) = pprFormatOp (sLit "idiv") fmt op
693 pprInstr (DIV fmt op) = pprFormatOp (sLit "div") fmt op
694 pprInstr (IMUL2 fmt op) = pprFormatOp (sLit "imul") fmt op
695
696 -- x86_64 only
697 pprInstr (MUL format op1 op2) = pprFormatOpOp (sLit "mul") format op1 op2
698 pprInstr (MUL2 format op) = pprFormatOp (sLit "mul") format op
699
700 pprInstr (FDIV format op1 op2) = pprFormatOpOp (sLit "div") format op1 op2
701
702 pprInstr (CVTSS2SD from to) = pprRegReg (sLit "cvtss2sd") from to
703 pprInstr (CVTSD2SS from to) = pprRegReg (sLit "cvtsd2ss") from to
704 pprInstr (CVTTSS2SIQ fmt from to) = pprFormatFormatOpReg (sLit "cvttss2si") FF32 fmt from to
705 pprInstr (CVTTSD2SIQ fmt from to) = pprFormatFormatOpReg (sLit "cvttsd2si") FF64 fmt from to
706 pprInstr (CVTSI2SS fmt from to) = pprFormatOpReg (sLit "cvtsi2ss") fmt from to
707 pprInstr (CVTSI2SD fmt from to) = pprFormatOpReg (sLit "cvtsi2sd") fmt from to
708
709 -- FETCHGOT for PIC on ELF platforms
710 pprInstr (FETCHGOT reg)
711 = vcat [ ptext (sLit "\tcall 1f"),
712 hcat [ ptext (sLit "1:\tpopl\t"), pprReg II32 reg ],
713 hcat [ ptext (sLit "\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
714 pprReg II32 reg ]
715 ]
716
717 -- FETCHPC for PIC on Darwin/x86
718 -- get the instruction pointer into a register
719 -- (Terminology note: the IP is called Program Counter on PPC,
720 -- and it's a good thing to use the same name on both platforms)
721 pprInstr (FETCHPC reg)
722 = vcat [ ptext (sLit "\tcall 1f"),
723 hcat [ ptext (sLit "1:\tpopl\t"), pprReg II32 reg ]
724 ]
725
726
727 -- -----------------------------------------------------------------------------
728 -- i386 floating-point
729
730 -- Simulating a flat register set on the x86 FP stack is tricky.
731 -- you have to free %st(7) before pushing anything on the FP reg stack
732 -- so as to preclude the possibility of a FP stack overflow exception.
733 pprInstr g@(GMOV src dst)
734 | src == dst
735 = empty
736 | otherwise
737 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
738
739 -- GLD fmt addr dst ==> FLDsz addr ; FSTP (dst+1)
740 pprInstr g@(GLD fmt addr dst)
741 = pprG g (hcat [gtab, text "fld", pprFormat_x87 fmt, gsp,
742 pprAddr addr, gsemi, gpop dst 1])
743
744 -- GST fmt src addr ==> FLD dst ; FSTPsz addr
745 pprInstr g@(GST fmt src addr)
746 | src == fake0 && fmt /= FF80 -- fstt instruction doesn't exist
747 = pprG g (hcat [gtab,
748 text "fst", pprFormat_x87 fmt, gsp, pprAddr addr])
749 | otherwise
750 = pprG g (hcat [gtab, gpush src 0, gsemi,
751 text "fstp", pprFormat_x87 fmt, gsp, pprAddr addr])
752
753 pprInstr g@(GLDZ dst)
754 = pprG g (hcat [gtab, text "fldz ; ", gpop dst 1])
755 pprInstr g@(GLD1 dst)
756 = pprG g (hcat [gtab, text "fld1 ; ", gpop dst 1])
757
758 pprInstr (GFTOI src dst)
759 = pprInstr (GDTOI src dst)
760
761 pprInstr g@(GDTOI src dst)
762 = pprG g (vcat [
763 hcat [gtab, text "subl $8, %esp ; fnstcw 4(%esp)"],
764 hcat [gtab, gpush src 0],
765 hcat [gtab, text "movzwl 4(%esp), ", reg,
766 text " ; orl $0xC00, ", reg],
767 hcat [gtab, text "movl ", reg, text ", 0(%esp) ; fldcw 0(%esp)"],
768 hcat [gtab, text "fistpl 0(%esp)"],
769 hcat [gtab, text "fldcw 4(%esp) ; movl 0(%esp), ", reg],
770 hcat [gtab, text "addl $8, %esp"]
771 ])
772 where
773 reg = pprReg II32 dst
774
775 pprInstr (GITOF src dst)
776 = pprInstr (GITOD src dst)
777
778 pprInstr g@(GITOD src dst)
779 = pprG g (hcat [gtab, text "pushl ", pprReg II32 src,
780 text " ; fildl (%esp) ; ",
781 gpop dst 1, text " ; addl $4,%esp"])
782
783 pprInstr g@(GDTOF src dst)
784 = pprG g (vcat [gtab <> gpush src 0,
785 gtab <> text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ;",
786 gtab <> gpop dst 1])
787
788 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
789 this far into the jungle AND you give a Rat's Ass (tm) what's going
790 on, here's the deal. Generate code to do a floating point comparison
791 of src1 and src2, of kind cond, and set the Zero flag if true.
792
793 The complications are to do with handling NaNs correctly. We want the
794 property that if either argument is NaN, then the result of the
795 comparison is False ... except if we're comparing for inequality,
796 in which case the answer is True.
797
798 Here's how the general (non-inequality) case works. As an
799 example, consider generating the an equality test:
800
801 pushl %eax -- we need to mess with this
802 <get src1 to top of FPU stack>
803 fcomp <src2 location in FPU stack> and pop pushed src1
804 -- Result of comparison is in FPU Status Register bits
805 -- C3 C2 and C0
806 fstsw %ax -- Move FPU Status Reg to %ax
807 sahf -- move C3 C2 C0 from %ax to integer flag reg
808 -- now the serious magic begins
809 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
810 sete %al -- %al = if arg1 == arg2 then 1 else 0
811 andb %ah,%al -- %al &= %ah
812 -- so %al == 1 iff (comparable && same); else it holds 0
813 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
814 else %al == 0xFF, ZeroFlag=0
815 -- the zero flag is now set as we desire.
816 popl %eax
817
818 The special case of inequality differs thusly:
819
820 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
821 setne %al -- %al = if arg1 /= arg2 then 1 else 0
822 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
823 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
824 else (%al == 0xFF, ZF=0)
825 -}
826 pprInstr g@(GCMP cond src1 src2)
827 | case cond of { NE -> True; _ -> False }
828 = pprG g (vcat [
829 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
830 hcat [gtab, text "fcomp ", greg src2 1,
831 text "; fstsw %ax ; sahf ; setpe %ah"],
832 hcat [gtab, text "setne %al ; ",
833 text "orb %ah,%al ; decb %al ; popl %eax"]
834 ])
835 | otherwise
836 = pprG g (vcat [
837 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
838 hcat [gtab, text "fcomp ", greg src2 1,
839 text "; fstsw %ax ; sahf ; setpo %ah"],
840 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
841 text "andb %ah,%al ; decb %al ; popl %eax"]
842 ])
843 where
844 {- On the 486, the flags set by FP compare are the unsigned ones!
845 (This looks like a HACK to me. WDP 96/03)
846 -}
847 fix_FP_cond :: Cond -> Cond
848 fix_FP_cond GE = GEU
849 fix_FP_cond GTT = GU
850 fix_FP_cond LTT = LU
851 fix_FP_cond LE = LEU
852 fix_FP_cond EQQ = EQQ
853 fix_FP_cond NE = NE
854 fix_FP_cond _ = panic "X86.Ppr.fix_FP_cond: no match"
855 -- there should be no others
856
857
858 pprInstr g@(GABS _ src dst)
859 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
860
861 pprInstr g@(GNEG _ src dst)
862 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
863
864 pprInstr g@(GSQRT fmt src dst)
865 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
866 hcat [gtab, gcoerceto fmt, gpop dst 1])
867
868 pprInstr g@(GSIN fmt l1 l2 src dst)
869 = pprG g (pprTrigOp "fsin" False l1 l2 src dst fmt)
870
871 pprInstr g@(GCOS fmt l1 l2 src dst)
872 = pprG g (pprTrigOp "fcos" False l1 l2 src dst fmt)
873
874 pprInstr g@(GTAN fmt l1 l2 src dst)
875 = pprG g (pprTrigOp "fptan" True l1 l2 src dst fmt)
876
877 -- In the translations for GADD, GMUL, GSUB and GDIV,
878 -- the first two cases are mere optimisations. The otherwise clause
879 -- generates correct code under all circumstances.
880
881 pprInstr g@(GADD _ src1 src2 dst)
882 | src1 == dst
883 = pprG g (text "\t#GADD-xxxcase1" $$
884 hcat [gtab, gpush src2 0,
885 text " ; faddp %st(0),", greg src1 1])
886 | src2 == dst
887 = pprG g (text "\t#GADD-xxxcase2" $$
888 hcat [gtab, gpush src1 0,
889 text " ; faddp %st(0),", greg src2 1])
890 | otherwise
891 = pprG g (hcat [gtab, gpush src1 0,
892 text " ; fadd ", greg src2 1, text ",%st(0)",
893 gsemi, gpop dst 1])
894
895
896 pprInstr g@(GMUL _ src1 src2 dst)
897 | src1 == dst
898 = pprG g (text "\t#GMUL-xxxcase1" $$
899 hcat [gtab, gpush src2 0,
900 text " ; fmulp %st(0),", greg src1 1])
901 | src2 == dst
902 = pprG g (text "\t#GMUL-xxxcase2" $$
903 hcat [gtab, gpush src1 0,
904 text " ; fmulp %st(0),", greg src2 1])
905 | otherwise
906 = pprG g (hcat [gtab, gpush src1 0,
907 text " ; fmul ", greg src2 1, text ",%st(0)",
908 gsemi, gpop dst 1])
909
910
911 pprInstr g@(GSUB _ src1 src2 dst)
912 | src1 == dst
913 = pprG g (text "\t#GSUB-xxxcase1" $$
914 hcat [gtab, gpush src2 0,
915 text " ; fsubrp %st(0),", greg src1 1])
916 | src2 == dst
917 = pprG g (text "\t#GSUB-xxxcase2" $$
918 hcat [gtab, gpush src1 0,
919 text " ; fsubp %st(0),", greg src2 1])
920 | otherwise
921 = pprG g (hcat [gtab, gpush src1 0,
922 text " ; fsub ", greg src2 1, text ",%st(0)",
923 gsemi, gpop dst 1])
924
925
926 pprInstr g@(GDIV _ src1 src2 dst)
927 | src1 == dst
928 = pprG g (text "\t#GDIV-xxxcase1" $$
929 hcat [gtab, gpush src2 0,
930 text " ; fdivrp %st(0),", greg src1 1])
931 | src2 == dst
932 = pprG g (text "\t#GDIV-xxxcase2" $$
933 hcat [gtab, gpush src1 0,
934 text " ; fdivp %st(0),", greg src2 1])
935 | otherwise
936 = pprG g (hcat [gtab, gpush src1 0,
937 text " ; fdiv ", greg src2 1, text ",%st(0)",
938 gsemi, gpop dst 1])
939
940
941 pprInstr GFREE
942 = vcat [ ptext (sLit "\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
943 ptext (sLit "\tffree %st(4) ;ffree %st(5)")
944 ]
945
946 -- Atomics
947
948 pprInstr (LOCK i) = ptext (sLit "\tlock") $$ pprInstr i
949
950 pprInstr MFENCE = ptext (sLit "\tmfence")
951
952 pprInstr (XADD format src dst) = pprFormatOpOp (sLit "xadd") format src dst
953
954 pprInstr (CMPXCHG format src dst)
955 = pprFormatOpOp (sLit "cmpxchg") format src dst
956
957 pprInstr _
958 = panic "X86.Ppr.pprInstr: no match"
959
960
961 pprTrigOp :: String -> Bool -> CLabel -> CLabel
962 -> Reg -> Reg -> Format -> SDoc
963 pprTrigOp op -- fsin, fcos or fptan
964 isTan -- we need a couple of extra steps if we're doing tan
965 l1 l2 -- internal labels for us to use
966 src dst fmt
967 = -- We'll be needing %eax later on
968 hcat [gtab, text "pushl %eax;"] $$
969 -- tan is going to use an extra space on the FP stack
970 (if isTan then hcat [gtab, text "ffree %st(6)"] else empty) $$
971 -- First put the value in %st(0) and try to apply the op to it
972 hcat [gpush src 0, text ("; " ++ op)] $$
973 -- Now look to see if C2 was set (overflow, |value| >= 2^63)
974 hcat [gtab, text "fnstsw %ax"] $$
975 hcat [gtab, text "test $0x400,%eax"] $$
976 -- If we were in bounds then jump to the end
977 hcat [gtab, text "je " <> ppr l1] $$
978 -- Otherwise we need to shrink the value. Start by
979 -- loading pi, doubleing it (by adding it to itself),
980 -- and then swapping pi with the value, so the value we
981 -- want to apply op to is in %st(0) again
982 hcat [gtab, text "ffree %st(7); fldpi"] $$
983 hcat [gtab, text "fadd %st(0),%st"] $$
984 hcat [gtab, text "fxch %st(1)"] $$
985 -- Now we have a loop in which we make the value smaller,
986 -- see if it's small enough, and loop if not
987 (ppr l2 <> char ':') $$
988 hcat [gtab, text "fprem1"] $$
989 -- My Debian libc uses fstsw here for the tan code, but I can't
990 -- see any reason why it should need to be different for tan.
991 hcat [gtab, text "fnstsw %ax"] $$
992 hcat [gtab, text "test $0x400,%eax"] $$
993 hcat [gtab, text "jne " <> ppr l2] $$
994 hcat [gtab, text "fstp %st(1)"] $$
995 hcat [gtab, text op] $$
996 (ppr l1 <> char ':') $$
997 -- Pop the 1.0 tan gave us
998 (if isTan then hcat [gtab, text "fstp %st(0)"] else empty) $$
999 -- Restore %eax
1000 hcat [gtab, text "popl %eax;"] $$
1001 -- And finally make the result the right size
1002 hcat [gtab, gcoerceto fmt, gpop dst 1]
1003
1004 --------------------------
1005
1006 -- coerce %st(0) to the specified size
1007 gcoerceto :: Format -> SDoc
1008 gcoerceto FF64 = empty
1009 gcoerceto FF32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1010 gcoerceto _ = panic "X86.Ppr.gcoerceto: no match"
1011
1012 gpush :: Reg -> RegNo -> SDoc
1013 gpush reg offset
1014 = hcat [text "fld ", greg reg offset]
1015
1016 gpop :: Reg -> RegNo -> SDoc
1017 gpop reg offset
1018 = hcat [text "fstp ", greg reg offset]
1019
1020 greg :: Reg -> RegNo -> SDoc
1021 greg reg offset = text "%st(" <> int (gregno reg - firstfake+offset) <> char ')'
1022
1023 gsemi :: SDoc
1024 gsemi = text " ; "
1025
1026 gtab :: SDoc
1027 gtab = char '\t'
1028
1029 gsp :: SDoc
1030 gsp = char ' '
1031
1032 gregno :: Reg -> RegNo
1033 gregno (RegReal (RealRegSingle i)) = i
1034 gregno _ = --pprPanic "gregno" (ppr other)
1035 999 -- bogus; only needed for debug printing
1036
1037 pprG :: Instr -> SDoc -> SDoc
1038 pprG fake actual
1039 = (char '#' <> pprGInstr fake) $$ actual
1040
1041
1042 pprGInstr :: Instr -> SDoc
1043 pprGInstr (GMOV src dst) = pprFormatRegReg (sLit "gmov") FF64 src dst
1044 pprGInstr (GLD fmt src dst) = pprFormatAddrReg (sLit "gld") fmt src dst
1045 pprGInstr (GST fmt src dst) = pprFormatRegAddr (sLit "gst") fmt src dst
1046
1047 pprGInstr (GLDZ dst) = pprFormatReg (sLit "gldz") FF64 dst
1048 pprGInstr (GLD1 dst) = pprFormatReg (sLit "gld1") FF64 dst
1049
1050 pprGInstr (GFTOI src dst) = pprFormatFormatRegReg (sLit "gftoi") FF32 II32 src dst
1051 pprGInstr (GDTOI src dst) = pprFormatFormatRegReg (sLit "gdtoi") FF64 II32 src dst
1052
1053 pprGInstr (GITOF src dst) = pprFormatFormatRegReg (sLit "gitof") II32 FF32 src dst
1054 pprGInstr (GITOD src dst) = pprFormatFormatRegReg (sLit "gitod") II32 FF64 src dst
1055 pprGInstr (GDTOF src dst) = pprFormatFormatRegReg (sLit "gdtof") FF64 FF32 src dst
1056
1057 pprGInstr (GCMP co src dst) = pprCondRegReg (sLit "gcmp_") FF64 co src dst
1058 pprGInstr (GABS fmt src dst) = pprFormatRegReg (sLit "gabs") fmt src dst
1059 pprGInstr (GNEG fmt src dst) = pprFormatRegReg (sLit "gneg") fmt src dst
1060 pprGInstr (GSQRT fmt src dst) = pprFormatRegReg (sLit "gsqrt") fmt src dst
1061 pprGInstr (GSIN fmt _ _ src dst) = pprFormatRegReg (sLit "gsin") fmt src dst
1062 pprGInstr (GCOS fmt _ _ src dst) = pprFormatRegReg (sLit "gcos") fmt src dst
1063 pprGInstr (GTAN fmt _ _ src dst) = pprFormatRegReg (sLit "gtan") fmt src dst
1064
1065 pprGInstr (GADD fmt src1 src2 dst) = pprFormatRegRegReg (sLit "gadd") fmt src1 src2 dst
1066 pprGInstr (GSUB fmt src1 src2 dst) = pprFormatRegRegReg (sLit "gsub") fmt src1 src2 dst
1067 pprGInstr (GMUL fmt src1 src2 dst) = pprFormatRegRegReg (sLit "gmul") fmt src1 src2 dst
1068 pprGInstr (GDIV fmt src1 src2 dst) = pprFormatRegRegReg (sLit "gdiv") fmt src1 src2 dst
1069
1070 pprGInstr _ = panic "X86.Ppr.pprGInstr: no match"
1071
1072 pprDollImm :: Imm -> SDoc
1073 pprDollImm i = ptext (sLit "$") <> pprImm i
1074
1075
1076 pprOperand :: Format -> Operand -> SDoc
1077 pprOperand f (OpReg r) = pprReg f r
1078 pprOperand _ (OpImm i) = pprDollImm i
1079 pprOperand _ (OpAddr ea) = pprAddr ea
1080
1081
1082 pprMnemonic_ :: LitString -> SDoc
1083 pprMnemonic_ name =
1084 char '\t' <> ptext name <> space
1085
1086
1087 pprMnemonic :: LitString -> Format -> SDoc
1088 pprMnemonic name format =
1089 char '\t' <> ptext name <> pprFormat format <> space
1090
1091
1092 pprFormatImmOp :: LitString -> Format -> Imm -> Operand -> SDoc
1093 pprFormatImmOp name format imm op1
1094 = hcat [
1095 pprMnemonic name format,
1096 char '$',
1097 pprImm imm,
1098 comma,
1099 pprOperand format op1
1100 ]
1101
1102
1103 pprFormatOp_ :: LitString -> Format -> Operand -> SDoc
1104 pprFormatOp_ name format op1
1105 = hcat [
1106 pprMnemonic_ name ,
1107 pprOperand format op1
1108 ]
1109
1110 pprFormatOp :: LitString -> Format -> Operand -> SDoc
1111 pprFormatOp name format op1
1112 = hcat [
1113 pprMnemonic name format,
1114 pprOperand format op1
1115 ]
1116
1117
1118 pprFormatOpOp :: LitString -> Format -> Operand -> Operand -> SDoc
1119 pprFormatOpOp name format op1 op2
1120 = hcat [
1121 pprMnemonic name format,
1122 pprOperand format op1,
1123 comma,
1124 pprOperand format op2
1125 ]
1126
1127
1128 pprOpOp :: LitString -> Format -> Operand -> Operand -> SDoc
1129 pprOpOp name format op1 op2
1130 = hcat [
1131 pprMnemonic_ name,
1132 pprOperand format op1,
1133 comma,
1134 pprOperand format op2
1135 ]
1136
1137
1138 pprFormatReg :: LitString -> Format -> Reg -> SDoc
1139 pprFormatReg name format reg1
1140 = hcat [
1141 pprMnemonic name format,
1142 pprReg format reg1
1143 ]
1144
1145
1146 pprFormatRegReg :: LitString -> Format -> Reg -> Reg -> SDoc
1147 pprFormatRegReg name format reg1 reg2
1148 = hcat [
1149 pprMnemonic name format,
1150 pprReg format reg1,
1151 comma,
1152 pprReg format reg2
1153 ]
1154
1155
1156 pprRegReg :: LitString -> Reg -> Reg -> SDoc
1157 pprRegReg name reg1 reg2
1158 = sdocWithPlatform $ \platform ->
1159 hcat [
1160 pprMnemonic_ name,
1161 pprReg (archWordFormat (target32Bit platform)) reg1,
1162 comma,
1163 pprReg (archWordFormat (target32Bit platform)) reg2
1164 ]
1165
1166
1167 pprFormatOpReg :: LitString -> Format -> Operand -> Reg -> SDoc
1168 pprFormatOpReg name format op1 reg2
1169 = sdocWithPlatform $ \platform ->
1170 hcat [
1171 pprMnemonic name format,
1172 pprOperand format op1,
1173 comma,
1174 pprReg (archWordFormat (target32Bit platform)) reg2
1175 ]
1176
1177 pprCondOpReg :: LitString -> Format -> Cond -> Operand -> Reg -> SDoc
1178 pprCondOpReg name format cond op1 reg2
1179 = hcat [
1180 char '\t',
1181 ptext name,
1182 pprCond cond,
1183 space,
1184 pprOperand format op1,
1185 comma,
1186 pprReg format reg2
1187 ]
1188
1189 pprCondRegReg :: LitString -> Format -> Cond -> Reg -> Reg -> SDoc
1190 pprCondRegReg name format cond reg1 reg2
1191 = hcat [
1192 char '\t',
1193 ptext name,
1194 pprCond cond,
1195 space,
1196 pprReg format reg1,
1197 comma,
1198 pprReg format reg2
1199 ]
1200
1201 pprFormatFormatRegReg :: LitString -> Format -> Format -> Reg -> Reg -> SDoc
1202 pprFormatFormatRegReg name format1 format2 reg1 reg2
1203 = hcat [
1204 char '\t',
1205 ptext name,
1206 pprFormat format1,
1207 pprFormat format2,
1208 space,
1209 pprReg format1 reg1,
1210 comma,
1211 pprReg format2 reg2
1212 ]
1213
1214 pprFormatFormatOpReg :: LitString -> Format -> Format -> Operand -> Reg -> SDoc
1215 pprFormatFormatOpReg name format1 format2 op1 reg2
1216 = hcat [
1217 pprMnemonic name format2,
1218 pprOperand format1 op1,
1219 comma,
1220 pprReg format2 reg2
1221 ]
1222
1223 pprFormatRegRegReg :: LitString -> Format -> Reg -> Reg -> Reg -> SDoc
1224 pprFormatRegRegReg name format reg1 reg2 reg3
1225 = hcat [
1226 pprMnemonic name format,
1227 pprReg format reg1,
1228 comma,
1229 pprReg format reg2,
1230 comma,
1231 pprReg format reg3
1232 ]
1233
1234
1235 pprFormatAddrReg :: LitString -> Format -> AddrMode -> Reg -> SDoc
1236 pprFormatAddrReg name format op dst
1237 = hcat [
1238 pprMnemonic name format,
1239 pprAddr op,
1240 comma,
1241 pprReg format dst
1242 ]
1243
1244
1245 pprFormatRegAddr :: LitString -> Format -> Reg -> AddrMode -> SDoc
1246 pprFormatRegAddr name format src op
1247 = hcat [
1248 pprMnemonic name format,
1249 pprReg format src,
1250 comma,
1251 pprAddr op
1252 ]
1253
1254
1255 pprShift :: LitString -> Format -> Operand -> Operand -> SDoc
1256 pprShift name format src dest
1257 = hcat [
1258 pprMnemonic name format,
1259 pprOperand II8 src, -- src is 8-bit sized
1260 comma,
1261 pprOperand format dest
1262 ]
1263
1264
1265 pprFormatOpOpCoerce :: LitString -> Format -> Format -> Operand -> Operand -> SDoc
1266 pprFormatOpOpCoerce name format1 format2 op1 op2
1267 = hcat [ char '\t', ptext name, pprFormat format1, pprFormat format2, space,
1268 pprOperand format1 op1,
1269 comma,
1270 pprOperand format2 op2
1271 ]
1272
1273
1274 pprCondInstr :: LitString -> Cond -> SDoc -> SDoc
1275 pprCondInstr name cond arg
1276 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1277