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