1 -----------------------------------------------------------------------------
3 -- Pretty-printing assembly language
5 -- (c) The University of Glasgow 1993-2005
7 -----------------------------------------------------------------------------
23 #include "HsVersions.h"
24 #include "nativeGen/NCG.h"
38 import Unique ( pprUnique )
41 import qualified Outputable
42 import Outputable (panic, Outputable)
46 #if i386_TARGET_ARCH && darwin_TARGET_OS
50 -- -----------------------------------------------------------------------------
51 -- Printing this stuff out
53 pprNatCmmTop :: NatCmmTop Instr -> Doc
54 pprNatCmmTop (CmmData section dats) =
55 pprSectionHeader section $$ vcat (map pprData dats)
57 -- special case for split markers:
58 pprNatCmmTop (CmmProc [] lbl _ (ListGraph [])) = pprLabel lbl
60 pprNatCmmTop (CmmProc info lbl _ (ListGraph blocks)) =
61 pprSectionHeader Text $$
62 (if null info then -- blocks guaranteed not null, so label needed
65 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
66 pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
69 vcat (map pprData info) $$
70 pprLabel (entryLblToInfoLbl lbl)
72 vcat (map pprBasicBlock blocks)
73 -- above: Even the first block gets a label, because with branch-chain
74 -- elimination, it might be the target of a goto.
75 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
76 -- If we are using the .subsections_via_symbols directive
77 -- (available on recent versions of Darwin),
78 -- we have to make sure that there is some kind of reference
79 -- from the entry code to a label on the _top_ of of the info table,
80 -- so that the linker will not think it is unreferenced and dead-strip
81 -- it. That's why the label is called a DeadStripPreventer (_dsp).
84 <+> pprCLabel_asm (entryLblToInfoLbl lbl)
86 <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
91 pprBasicBlock :: NatBasicBlock Instr -> Doc
92 pprBasicBlock (BasicBlock (BlockId id) instrs) =
93 pprLabel (mkAsmTempLabel id) $$
94 vcat (map pprInstr instrs)
97 pprData :: CmmStatic -> Doc
98 pprData (CmmAlign bytes) = pprAlign bytes
99 pprData (CmmDataLabel lbl) = pprLabel lbl
100 pprData (CmmString str) = pprASCII str
103 pprData (CmmUninitialised bytes) = ptext (sLit ".space ") <> int bytes
105 pprData (CmmUninitialised bytes) = ptext (sLit ".skip ") <> int bytes
108 pprData (CmmStaticLit lit) = pprDataItem lit
110 pprGloblDecl :: CLabel -> Doc
112 | not (externallyVisibleCLabel lbl) = empty
113 | otherwise = ptext IF_ARCH_sparc((sLit ".global "),
117 pprTypeAndSizeDecl :: CLabel -> Doc
119 pprTypeAndSizeDecl lbl
120 | not (externallyVisibleCLabel lbl) = empty
121 | otherwise = ptext (sLit ".type ") <>
122 pprCLabel_asm lbl <> ptext (sLit ", @object")
128 pprLabel :: CLabel -> Doc
129 pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':')
132 pprASCII :: [Word8] -> Doc
134 = vcat (map do1 str) $$ do1 0
137 do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
139 pprAlign :: Int -> Doc
143 = ptext (sLit ".align ") <> int IF_OS_darwin(pow2, bytes)
149 log2 :: Int -> Int -- cache the common ones
154 log2 n = 1 + log2 (n `quot` 2)
157 -- -----------------------------------------------------------------------------
158 -- pprInstr: print an 'Instr'
160 instance Outputable Instr where
161 ppr instr = Outputable.docToSDoc $ pprInstr instr
174 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
175 pprUserReg :: Reg -> Doc
176 pprUserReg = pprReg IF_ARCH_i386(II32,) IF_ARCH_x86_64(II64,)
179 pprUserReg :: Reg -> Doc
180 pprUserReg = panic "X86.Ppr.pprUserReg: not defined"
184 pprReg :: Size -> Reg -> Doc
188 RealReg i -> ppr_reg_no s i
189 VirtualRegI u -> text "%vI_" <> asmSDoc (pprUnique u)
190 VirtualRegHi u -> text "%vHi_" <> asmSDoc (pprUnique u)
191 VirtualRegF u -> text "%vF_" <> asmSDoc (pprUnique u)
192 VirtualRegD u -> text "%vD_" <> asmSDoc (pprUnique u)
195 ppr_reg_no :: Size -> Int -> Doc
196 ppr_reg_no II8 = ppr_reg_byte
197 ppr_reg_no II16 = ppr_reg_word
198 ppr_reg_no _ = ppr_reg_long
200 ppr_reg_byte i = ptext
202 0 -> sLit "%al"; 1 -> sLit "%bl";
203 2 -> sLit "%cl"; 3 -> sLit "%dl";
204 _ -> sLit "very naughty I386 byte register"
207 ppr_reg_word i = ptext
209 0 -> sLit "%ax"; 1 -> sLit "%bx";
210 2 -> sLit "%cx"; 3 -> sLit "%dx";
211 4 -> sLit "%si"; 5 -> sLit "%di";
212 6 -> sLit "%bp"; 7 -> sLit "%sp";
213 _ -> sLit "very naughty I386 word register"
216 ppr_reg_long i = ptext
218 0 -> sLit "%eax"; 1 -> sLit "%ebx";
219 2 -> sLit "%ecx"; 3 -> sLit "%edx";
220 4 -> sLit "%esi"; 5 -> sLit "%edi";
221 6 -> sLit "%ebp"; 7 -> sLit "%esp";
222 8 -> sLit "%fake0"; 9 -> sLit "%fake1";
223 10 -> sLit "%fake2"; 11 -> sLit "%fake3";
224 12 -> sLit "%fake4"; 13 -> sLit "%fake5";
225 _ -> sLit "very naughty I386 register"
227 #elif x86_64_TARGET_ARCH
228 ppr_reg_no :: Size -> Int -> Doc
229 ppr_reg_no II8 = ppr_reg_byte
230 ppr_reg_no II16 = ppr_reg_word
231 ppr_reg_no II32 = ppr_reg_long
232 ppr_reg_no _ = ppr_reg_quad
234 ppr_reg_byte i = ptext
236 0 -> sLit "%al"; 1 -> sLit "%bl";
237 2 -> sLit "%cl"; 3 -> sLit "%dl";
238 4 -> sLit "%sil"; 5 -> sLit "%dil"; -- new 8-bit regs!
239 6 -> sLit "%bpl"; 7 -> sLit "%spl";
240 8 -> sLit "%r8b"; 9 -> sLit "%r9b";
241 10 -> sLit "%r10b"; 11 -> sLit "%r11b";
242 12 -> sLit "%r12b"; 13 -> sLit "%r13b";
243 14 -> sLit "%r14b"; 15 -> sLit "%r15b";
244 _ -> sLit "very naughty x86_64 byte register"
247 ppr_reg_word i = ptext
249 0 -> sLit "%ax"; 1 -> sLit "%bx";
250 2 -> sLit "%cx"; 3 -> sLit "%dx";
251 4 -> sLit "%si"; 5 -> sLit "%di";
252 6 -> sLit "%bp"; 7 -> sLit "%sp";
253 8 -> sLit "%r8w"; 9 -> sLit "%r9w";
254 10 -> sLit "%r10w"; 11 -> sLit "%r11w";
255 12 -> sLit "%r12w"; 13 -> sLit "%r13w";
256 14 -> sLit "%r14w"; 15 -> sLit "%r15w";
257 _ -> sLit "very naughty x86_64 word register"
260 ppr_reg_long i = ptext
262 0 -> sLit "%eax"; 1 -> sLit "%ebx";
263 2 -> sLit "%ecx"; 3 -> sLit "%edx";
264 4 -> sLit "%esi"; 5 -> sLit "%edi";
265 6 -> sLit "%ebp"; 7 -> sLit "%esp";
266 8 -> sLit "%r8d"; 9 -> sLit "%r9d";
267 10 -> sLit "%r10d"; 11 -> sLit "%r11d";
268 12 -> sLit "%r12d"; 13 -> sLit "%r13d";
269 14 -> sLit "%r14d"; 15 -> sLit "%r15d";
270 _ -> sLit "very naughty x86_64 register"
273 ppr_reg_quad i = ptext
275 0 -> sLit "%rax"; 1 -> sLit "%rbx";
276 2 -> sLit "%rcx"; 3 -> sLit "%rdx";
277 4 -> sLit "%rsi"; 5 -> sLit "%rdi";
278 6 -> sLit "%rbp"; 7 -> sLit "%rsp";
279 8 -> sLit "%r8"; 9 -> sLit "%r9";
280 10 -> sLit "%r10"; 11 -> sLit "%r11";
281 12 -> sLit "%r12"; 13 -> sLit "%r13";
282 14 -> sLit "%r14"; 15 -> sLit "%r15";
283 16 -> sLit "%xmm0"; 17 -> sLit "%xmm1";
284 18 -> sLit "%xmm2"; 19 -> sLit "%xmm3";
285 20 -> sLit "%xmm4"; 21 -> sLit "%xmm5";
286 22 -> sLit "%xmm6"; 23 -> sLit "%xmm7";
287 24 -> sLit "%xmm8"; 25 -> sLit "%xmm9";
288 26 -> sLit "%xmm10"; 27 -> sLit "%xmm11";
289 28 -> sLit "%xmm12"; 29 -> sLit "%xmm13";
290 30 -> sLit "%xmm14"; 31 -> sLit "%xmm15";
291 _ -> sLit "very naughty x86_64 register"
294 ppr_reg_no _ = panic "X86.Ppr.ppr_reg_no: no match"
298 pprSize :: Size -> Doc
309 #elif x86_64_TARGET_ARCH
310 FF32 -> sLit "ss" -- "scalar single-precision float" (SSE2)
311 FF64 -> sLit "sd" -- "scalar double-precision float" (SSE2)
312 _ -> panic "X86.Ppr.pprSize: no match"
314 _ -> panic "X86.Ppr.pprSize: no match"
318 pprCond :: Cond -> Doc
321 GEU -> sLit "ae"; LU -> sLit "b";
322 EQQ -> sLit "e"; GTT -> sLit "g";
323 GE -> sLit "ge"; GU -> sLit "a";
324 LTT -> sLit "l"; LE -> sLit "le";
325 LEU -> sLit "be"; NE -> sLit "ne";
326 NEG -> sLit "s"; POS -> sLit "ns";
327 CARRY -> sLit "c"; OFLO -> sLit "o";
328 PARITY -> sLit "p"; NOTPARITY -> sLit "np";
329 ALWAYS -> sLit "mp"})
333 pprImm (ImmInt i) = int i
334 pprImm (ImmInteger i) = integer i
335 pprImm (ImmCLbl l) = pprCLabel_asm l
336 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
337 pprImm (ImmLit s) = s
339 pprImm (ImmFloat _) = ptext (sLit "naughty float immediate")
340 pprImm (ImmDouble _) = ptext (sLit "naughty double immediate")
342 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
343 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
344 <> lparen <> pprImm b <> rparen
348 pprAddr :: AddrMode -> Doc
349 pprAddr (ImmAddr imm off)
350 = let pp_imm = pprImm imm
354 else if (off < 0) then
357 pp_imm <> char '+' <> int off
359 pprAddr (AddrBaseIndex base index displacement)
361 pp_disp = ppr_disp displacement
362 pp_off p = pp_disp <> char '(' <> p <> char ')'
363 pp_reg r = pprReg archWordSize r
365 case (base, index) of
366 (EABaseNone, EAIndexNone) -> pp_disp
367 (EABaseReg b, EAIndexNone) -> pp_off (pp_reg b)
368 (EABaseRip, EAIndexNone) -> pp_off (ptext (sLit "%rip"))
369 (EABaseNone, EAIndex r i) -> pp_off (comma <> pp_reg r <> comma <> int i)
370 (EABaseReg b, EAIndex r i) -> pp_off (pp_reg b <> comma <> pp_reg r
372 _ -> panic "X86.Ppr.pprAddr: no match"
375 ppr_disp (ImmInt 0) = empty
376 ppr_disp imm = pprImm imm
379 pprSectionHeader :: Section -> Doc
382 # if darwin_TARGET_OS
385 Text -> ptext (sLit ".text\n\t.align 2")
386 Data -> ptext (sLit ".data\n\t.align 2")
387 ReadOnlyData -> ptext (sLit ".const\n.align 2")
388 RelocatableReadOnlyData -> ptext (sLit ".const_data\n.align 2")
389 UninitialisedData -> ptext (sLit ".data\n\t.align 2")
390 ReadOnlyData16 -> ptext (sLit ".const\n.align 4")
391 OtherSection _ -> panic "X86.Ppr.pprSectionHeader: unknown section"
396 Text -> ptext (sLit ".text\n\t.align 4,0x90")
397 Data -> ptext (sLit ".data\n\t.align 4")
398 ReadOnlyData -> ptext (sLit ".section .rodata\n\t.align 4")
399 RelocatableReadOnlyData -> ptext (sLit ".section .data\n\t.align 4")
400 UninitialisedData -> ptext (sLit ".section .bss\n\t.align 4")
401 ReadOnlyData16 -> ptext (sLit ".section .rodata\n\t.align 16")
402 OtherSection _ -> panic "X86.Ppr.pprSectionHeader: unknown section"
406 #elif x86_64_TARGET_ARCH
407 # if darwin_TARGET_OS
410 Text -> ptext (sLit ".text\n.align 3")
411 Data -> ptext (sLit ".data\n.align 3")
412 ReadOnlyData -> ptext (sLit ".const\n.align 3")
413 RelocatableReadOnlyData -> ptext (sLit ".const_data\n.align 3")
414 UninitialisedData -> ptext (sLit ".data\n\t.align 3")
415 ReadOnlyData16 -> ptext (sLit ".const\n.align 4")
416 OtherSection _ -> panic "PprMach.pprSectionHeader: unknown section"
421 Text -> ptext (sLit ".text\n\t.align 8")
422 Data -> ptext (sLit ".data\n\t.align 8")
423 ReadOnlyData -> ptext (sLit ".section .rodata\n\t.align 8")
424 RelocatableReadOnlyData -> ptext (sLit ".section .data\n\t.align 8")
425 UninitialisedData -> ptext (sLit ".section .bss\n\t.align 8")
426 ReadOnlyData16 -> ptext (sLit ".section .rodata.cst16\n\t.align 16")
427 OtherSection _ -> panic "PprMach.pprSectionHeader: unknown section"
432 pprSectionHeader _ = panic "X86.Ppr.pprSectionHeader: not defined for this architecture"
439 pprDataItem :: CmmLit -> Doc
441 = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
445 -- These seem to be common:
446 ppr_item II8 _ = [ptext (sLit "\t.byte\t") <> pprImm imm]
447 ppr_item II32 _ = [ptext (sLit "\t.long\t") <> pprImm imm]
449 ppr_item FF32 (CmmFloat r _)
450 = let bs = floatToBytes (fromRational r)
451 in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
453 ppr_item FF64 (CmmFloat r _)
454 = let bs = doubleToBytes (fromRational r)
455 in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
457 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
458 ppr_item II16 _ = [ptext (sLit "\t.word\t") <> pprImm imm]
460 #if i386_TARGET_ARCH && darwin_TARGET_OS
461 ppr_item II64 (CmmInt x _) =
462 [ptext (sLit "\t.long\t")
463 <> int (fromIntegral (fromIntegral x :: Word32)),
464 ptext (sLit "\t.long\t")
466 (fromIntegral (x `shiftR` 32) :: Word32))]
468 #if i386_TARGET_ARCH || (darwin_TARGET_OS && x86_64_TARGET_ARCH)
469 ppr_item II64 _ = [ptext (sLit "\t.quad\t") <> pprImm imm]
471 #if x86_64_TARGET_ARCH && !darwin_TARGET_OS
472 -- x86_64: binutils can't handle the R_X86_64_PC64 relocation
473 -- type, which means we can't do pc-relative 64-bit addresses.
474 -- Fortunately we're assuming the small memory model, in which
475 -- all such offsets will fit into 32 bits, so we have to stick
476 -- to 32-bit offset fields and modify the RTS appropriately
478 -- See Note [x86-64-relative] in includes/InfoTables.h
481 | isRelativeReloc x =
482 [ptext (sLit "\t.long\t") <> pprImm imm,
483 ptext (sLit "\t.long\t0")]
485 [ptext (sLit "\t.quad\t") <> pprImm imm]
487 isRelativeReloc (CmmLabelDiffOff _ _ _) = True
488 isRelativeReloc _ = False
492 = panic "X86.Ppr.ppr_item: no match"
496 pprInstr :: Instr -> Doc
498 pprInstr (COMMENT _) = empty -- nuke 'em
501 = IF_ARCH_alpha( ((<>) (ptext (sLit "\t# ")) (ftext s))
502 ,IF_ARCH_sparc( ((<>) (ptext (sLit "# ")) (ftext s))
503 ,IF_ARCH_i386( ((<>) (ptext (sLit "# ")) (ftext s))
504 ,IF_ARCH_x86_64( ((<>) (ptext (sLit "# ")) (ftext s))
505 ,IF_ARCH_powerpc( IF_OS_linux(
506 ((<>) (ptext (sLit "# ")) (ftext s)),
507 ((<>) (ptext (sLit "; ")) (ftext s)))
511 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
513 pprInstr (NEWBLOCK _)
514 = panic "PprMach.pprInstr: NEWBLOCK"
517 = panic "PprMach.pprInstr: LDATA"
520 pprInstr (SPILL reg slot)
522 ptext (sLit "\tSPILL"),
526 ptext (sLit "SLOT") <> parens (int slot)]
528 pprInstr (RELOAD slot reg)
530 ptext (sLit "\tRELOAD"),
532 ptext (sLit "SLOT") <> parens (int slot),
537 pprInstr (MOV size src dst)
538 = pprSizeOpOp (sLit "mov") size src dst
540 pprInstr (MOVZxL II32 src dst) = pprSizeOpOp (sLit "mov") II32 src dst
541 -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
542 -- movl. But we represent it as a MOVZxL instruction, because
543 -- the reg alloc would tend to throw away a plain reg-to-reg
544 -- move, and we still want it to do that.
546 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce (sLit "movz") sizes II32 src dst
547 -- zero-extension only needs to extend to 32 bits: on x86_64,
548 -- the remaining zero-extension to 64 bits is automatic, and the 32-bit
549 -- instruction is shorter.
551 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce (sLit "movs") sizes archWordSize src dst
553 -- here we do some patching, since the physical registers are only set late
554 -- in the code generation.
555 pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
557 = pprSizeOpOp (sLit "add") size (OpReg reg2) dst
559 pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
561 = pprSizeOpOp (sLit "add") size (OpReg reg1) dst
563 pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
565 = pprInstr (ADD size (OpImm displ) dst)
567 pprInstr (LEA size src dst) = pprSizeOpOp (sLit "lea") size src dst
569 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
570 = pprSizeOp (sLit "dec") size dst
571 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
572 = pprSizeOp (sLit "inc") size dst
573 pprInstr (ADD size src dst)
574 = pprSizeOpOp (sLit "add") size src dst
575 pprInstr (ADC size src dst)
576 = pprSizeOpOp (sLit "adc") size src dst
577 pprInstr (SUB size src dst) = pprSizeOpOp (sLit "sub") size src dst
578 pprInstr (IMUL size op1 op2) = pprSizeOpOp (sLit "imul") size op1 op2
580 {- A hack. The Intel documentation says that "The two and three
581 operand forms [of IMUL] may also be used with unsigned operands
582 because the lower half of the product is the same regardless if
583 (sic) the operands are signed or unsigned. The CF and OF flags,
584 however, cannot be used to determine if the upper half of the
585 result is non-zero." So there.
587 pprInstr (AND size src dst) = pprSizeOpOp (sLit "and") size src dst
588 pprInstr (OR size src dst) = pprSizeOpOp (sLit "or") size src dst
590 pprInstr (XOR FF32 src dst) = pprOpOp (sLit "xorps") FF32 src dst
591 pprInstr (XOR FF64 src dst) = pprOpOp (sLit "xorpd") FF64 src dst
592 pprInstr (XOR size src dst) = pprSizeOpOp (sLit "xor") size src dst
594 pprInstr (NOT size op) = pprSizeOp (sLit "not") size op
595 pprInstr (NEGI size op) = pprSizeOp (sLit "neg") size op
597 pprInstr (SHL size src dst) = pprShift (sLit "shl") size src dst
598 pprInstr (SAR size src dst) = pprShift (sLit "sar") size src dst
599 pprInstr (SHR size src dst) = pprShift (sLit "shr") size src dst
601 pprInstr (BT size imm src) = pprSizeImmOp (sLit "bt") size imm src
603 pprInstr (CMP size src dst)
604 | is_float size = pprSizeOpOp (sLit "ucomi") size src dst -- SSE2
605 | otherwise = pprSizeOpOp (sLit "cmp") size src dst
607 -- This predicate is needed here and nowhere else
613 pprInstr (TEST size src dst) = pprSizeOpOp (sLit "test") size src dst
614 pprInstr (PUSH size op) = pprSizeOp (sLit "push") size op
615 pprInstr (POP size op) = pprSizeOp (sLit "pop") size op
617 -- both unused (SDM):
618 -- pprInstr PUSHA = ptext (sLit "\tpushal")
619 -- pprInstr POPA = ptext (sLit "\tpopal")
621 pprInstr NOP = ptext (sLit "\tnop")
622 pprInstr (CLTD II32) = ptext (sLit "\tcltd")
623 pprInstr (CLTD II64) = ptext (sLit "\tcqto")
625 pprInstr (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand II8 op)
627 pprInstr (JXX cond (BlockId id))
628 = pprCondInstr (sLit "j") cond (pprCLabel_asm lab)
629 where lab = mkAsmTempLabel id
631 pprInstr (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm imm)
633 pprInstr (JMP (OpImm imm)) = (<>) (ptext (sLit "\tjmp ")) (pprImm imm)
634 pprInstr (JMP op) = (<>) (ptext (sLit "\tjmp *")) (pprOperand archWordSize op)
635 pprInstr (JMP_TBL op _) = pprInstr (JMP op)
636 pprInstr (CALL (Left imm) _) = (<>) (ptext (sLit "\tcall ")) (pprImm imm)
637 pprInstr (CALL (Right reg) _) = (<>) (ptext (sLit "\tcall *")) (pprReg archWordSize reg)
639 pprInstr (IDIV sz op) = pprSizeOp (sLit "idiv") sz op
640 pprInstr (DIV sz op) = pprSizeOp (sLit "div") sz op
641 pprInstr (IMUL2 sz op) = pprSizeOp (sLit "imul") sz op
644 pprInstr (MUL size op1 op2) = pprSizeOpOp (sLit "mul") size op1 op2
646 pprInstr (FDIV size op1 op2) = pprSizeOpOp (sLit "div") size op1 op2
648 pprInstr (CVTSS2SD from to) = pprRegReg (sLit "cvtss2sd") from to
649 pprInstr (CVTSD2SS from to) = pprRegReg (sLit "cvtsd2ss") from to
650 pprInstr (CVTTSS2SIQ from to) = pprOpReg (sLit "cvttss2siq") from to
651 pprInstr (CVTTSD2SIQ from to) = pprOpReg (sLit "cvttsd2siq") from to
652 pprInstr (CVTSI2SS from to) = pprOpReg (sLit "cvtsi2ssq") from to
653 pprInstr (CVTSI2SD from to) = pprOpReg (sLit "cvtsi2sdq") from to
655 -- FETCHGOT for PIC on ELF platforms
656 pprInstr (FETCHGOT reg)
657 = vcat [ ptext (sLit "\tcall 1f"),
658 hcat [ ptext (sLit "1:\tpopl\t"), pprReg II32 reg ],
659 hcat [ ptext (sLit "\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
663 -- FETCHPC for PIC on Darwin/x86
664 -- get the instruction pointer into a register
665 -- (Terminology note: the IP is called Program Counter on PPC,
666 -- and it's a good thing to use the same name on both platforms)
667 pprInstr (FETCHPC reg)
668 = vcat [ ptext (sLit "\tcall 1f"),
669 hcat [ ptext (sLit "1:\tpopl\t"), pprReg II32 reg ]
673 -- -----------------------------------------------------------------------------
674 -- i386 floating-point
676 -- Simulating a flat register set on the x86 FP stack is tricky.
677 -- you have to free %st(7) before pushing anything on the FP reg stack
678 -- so as to preclude the possibility of a FP stack overflow exception.
679 pprInstr g@(GMOV src dst)
683 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
685 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
686 pprInstr g@(GLD sz addr dst)
687 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
688 pprAddr addr, gsemi, gpop dst 1])
690 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
691 pprInstr g@(GST sz src addr)
692 = pprG g (hcat [gtab, gpush src 0, gsemi,
693 text "fstp", pprSize sz, gsp, pprAddr addr])
695 pprInstr g@(GLDZ dst)
696 = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
697 pprInstr g@(GLD1 dst)
698 = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
700 pprInstr (GFTOI src dst)
701 = pprInstr (GDTOI src dst)
703 pprInstr g@(GDTOI src dst)
705 hcat [gtab, text "subl $8, %esp ; fnstcw 4(%esp)"],
706 hcat [gtab, gpush src 0],
707 hcat [gtab, text "movzwl 4(%esp), ", reg,
708 text " ; orl $0xC00, ", reg],
709 hcat [gtab, text "movl ", reg, text ", 0(%esp) ; fldcw 0(%esp)"],
710 hcat [gtab, text "fistpl 0(%esp)"],
711 hcat [gtab, text "fldcw 4(%esp) ; movl 0(%esp), ", reg],
712 hcat [gtab, text "addl $8, %esp"]
715 reg = pprReg II32 dst
717 pprInstr (GITOF src dst)
718 = pprInstr (GITOD src dst)
720 pprInstr g@(GITOD src dst)
721 = pprG g (hcat [gtab, text "pushl ", pprReg II32 src,
722 text " ; ffree %st(7); fildl (%esp) ; ",
723 gpop dst 1, text " ; addl $4,%esp"])
725 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
726 this far into the jungle AND you give a Rat's Ass (tm) what's going
727 on, here's the deal. Generate code to do a floating point comparison
728 of src1 and src2, of kind cond, and set the Zero flag if true.
730 The complications are to do with handling NaNs correctly. We want the
731 property that if either argument is NaN, then the result of the
732 comparison is False ... except if we're comparing for inequality,
733 in which case the answer is True.
735 Here's how the general (non-inequality) case works. As an
736 example, consider generating the an equality test:
738 pushl %eax -- we need to mess with this
739 <get src1 to top of FPU stack>
740 fcomp <src2 location in FPU stack> and pop pushed src1
741 -- Result of comparison is in FPU Status Register bits
743 fstsw %ax -- Move FPU Status Reg to %ax
744 sahf -- move C3 C2 C0 from %ax to integer flag reg
745 -- now the serious magic begins
746 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
747 sete %al -- %al = if arg1 == arg2 then 1 else 0
748 andb %ah,%al -- %al &= %ah
749 -- so %al == 1 iff (comparable && same); else it holds 0
750 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
751 else %al == 0xFF, ZeroFlag=0
752 -- the zero flag is now set as we desire.
755 The special case of inequality differs thusly:
757 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
758 setne %al -- %al = if arg1 /= arg2 then 1 else 0
759 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
760 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
761 else (%al == 0xFF, ZF=0)
763 pprInstr g@(GCMP cond src1 src2)
764 | case cond of { NE -> True; _ -> False }
766 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
767 hcat [gtab, text "fcomp ", greg src2 1,
768 text "; fstsw %ax ; sahf ; setpe %ah"],
769 hcat [gtab, text "setne %al ; ",
770 text "orb %ah,%al ; decb %al ; popl %eax"]
774 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
775 hcat [gtab, text "fcomp ", greg src2 1,
776 text "; fstsw %ax ; sahf ; setpo %ah"],
777 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
778 text "andb %ah,%al ; decb %al ; popl %eax"]
781 {- On the 486, the flags set by FP compare are the unsigned ones!
782 (This looks like a HACK to me. WDP 96/03)
784 fix_FP_cond :: Cond -> Cond
789 fix_FP_cond EQQ = EQQ
791 fix_FP_cond _ = panic "X86.Ppr.fix_FP_cond: no match"
792 -- there should be no others
795 pprInstr g@(GABS _ src dst)
796 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
798 pprInstr g@(GNEG _ src dst)
799 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
801 pprInstr g@(GSQRT sz src dst)
802 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
803 hcat [gtab, gcoerceto sz, gpop dst 1])
805 pprInstr g@(GSIN sz l1 l2 src dst)
806 = pprG g (pprTrigOp "fsin" False l1 l2 src dst sz)
808 pprInstr g@(GCOS sz l1 l2 src dst)
809 = pprG g (pprTrigOp "fcos" False l1 l2 src dst sz)
811 pprInstr g@(GTAN sz l1 l2 src dst)
812 = pprG g (pprTrigOp "fptan" True l1 l2 src dst sz)
814 -- In the translations for GADD, GMUL, GSUB and GDIV,
815 -- the first two cases are mere optimisations. The otherwise clause
816 -- generates correct code under all circumstances.
818 pprInstr g@(GADD _ src1 src2 dst)
820 = pprG g (text "\t#GADD-xxxcase1" $$
821 hcat [gtab, gpush src2 0,
822 text " ; faddp %st(0),", greg src1 1])
824 = pprG g (text "\t#GADD-xxxcase2" $$
825 hcat [gtab, gpush src1 0,
826 text " ; faddp %st(0),", greg src2 1])
828 = pprG g (hcat [gtab, gpush src1 0,
829 text " ; fadd ", greg src2 1, text ",%st(0)",
833 pprInstr g@(GMUL _ src1 src2 dst)
835 = pprG g (text "\t#GMUL-xxxcase1" $$
836 hcat [gtab, gpush src2 0,
837 text " ; fmulp %st(0),", greg src1 1])
839 = pprG g (text "\t#GMUL-xxxcase2" $$
840 hcat [gtab, gpush src1 0,
841 text " ; fmulp %st(0),", greg src2 1])
843 = pprG g (hcat [gtab, gpush src1 0,
844 text " ; fmul ", greg src2 1, text ",%st(0)",
848 pprInstr g@(GSUB _ src1 src2 dst)
850 = pprG g (text "\t#GSUB-xxxcase1" $$
851 hcat [gtab, gpush src2 0,
852 text " ; fsubrp %st(0),", greg src1 1])
854 = pprG g (text "\t#GSUB-xxxcase2" $$
855 hcat [gtab, gpush src1 0,
856 text " ; fsubp %st(0),", greg src2 1])
858 = pprG g (hcat [gtab, gpush src1 0,
859 text " ; fsub ", greg src2 1, text ",%st(0)",
863 pprInstr g@(GDIV _ src1 src2 dst)
865 = pprG g (text "\t#GDIV-xxxcase1" $$
866 hcat [gtab, gpush src2 0,
867 text " ; fdivrp %st(0),", greg src1 1])
869 = pprG g (text "\t#GDIV-xxxcase2" $$
870 hcat [gtab, gpush src1 0,
871 text " ; fdivp %st(0),", greg src2 1])
873 = pprG g (hcat [gtab, gpush src1 0,
874 text " ; fdiv ", greg src2 1, text ",%st(0)",
879 = vcat [ ptext (sLit "\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
880 ptext (sLit "\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
884 = panic "X86.Ppr.pprInstr: no match"
887 pprTrigOp :: String -> Bool -> CLabel -> CLabel -> Reg -> Reg -> Size -> Doc
888 pprTrigOp op -- fsin, fcos or fptan
889 isTan -- we need a couple of extra steps if we're doing tan
890 l1 l2 -- internal labels for us to use
892 = -- We'll be needing %eax later on
893 hcat [gtab, text "pushl %eax;"] $$
894 -- tan is going to use an extra space on the FP stack
895 (if isTan then hcat [gtab, text "ffree %st(6)"] else empty) $$
896 -- First put the value in %st(0) and try to apply the op to it
897 hcat [gpush src 0, text ("; " ++ op)] $$
898 -- Now look to see if C2 was set (overflow, |value| >= 2^63)
899 hcat [gtab, text "fnstsw %ax"] $$
900 hcat [gtab, text "test $0x400,%eax"] $$
901 -- If we were in bounds then jump to the end
902 hcat [gtab, text "je " <> pprCLabel_asm l1] $$
903 -- Otherwise we need to shrink the value. Start by
904 -- loading pi, doubleing it (by adding it to itself),
905 -- and then swapping pi with the value, so the value we
906 -- want to apply op to is in %st(0) again
907 hcat [gtab, text "ffree %st(7); fldpi"] $$
908 hcat [gtab, text "fadd %st(0),%st"] $$
909 hcat [gtab, text "fxch %st(1)"] $$
910 -- Now we have a loop in which we make the value smaller,
911 -- see if it's small enough, and loop if not
912 (pprCLabel_asm l2 <> char ':') $$
913 hcat [gtab, text "fprem1"] $$
914 -- My Debian libc uses fstsw here for the tan code, but I can't
915 -- see any reason why it should need to be different for tan.
916 hcat [gtab, text "fnstsw %ax"] $$
917 hcat [gtab, text "test $0x400,%eax"] $$
918 hcat [gtab, text "jne " <> pprCLabel_asm l2] $$
919 hcat [gtab, text "fstp %st(1)"] $$
920 hcat [gtab, text op] $$
921 (pprCLabel_asm l1 <> char ':') $$
922 -- Pop the 1.0 tan gave us
923 (if isTan then hcat [gtab, text "fstp %st(0)"] else empty) $$
925 hcat [gtab, text "popl %eax;"] $$
926 -- And finally make the result the right size
927 hcat [gtab, gcoerceto sz, gpop dst 1]
929 --------------------------
931 -- coerce %st(0) to the specified size
932 gcoerceto :: Size -> Doc
933 gcoerceto FF64 = empty
934 gcoerceto FF32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
935 gcoerceto _ = panic "X86.Ppr.gcoerceto: no match"
937 gpush :: Reg -> RegNo -> Doc
939 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
942 gpop :: Reg -> RegNo -> Doc
944 = hcat [text "fstp ", greg reg offset]
946 greg :: Reg -> RegNo -> Doc
947 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
958 gregno :: Reg -> RegNo
959 gregno (RealReg i) = i
960 gregno _ = --pprPanic "gregno" (ppr other)
961 999 -- bogus; only needed for debug printing
963 pprG :: Instr -> Doc -> Doc
965 = (char '#' <> pprGInstr fake) $$ actual
968 pprGInstr :: Instr -> Doc
969 pprGInstr (GMOV src dst) = pprSizeRegReg (sLit "gmov") FF64 src dst
970 pprGInstr (GLD sz src dst) = pprSizeAddrReg (sLit "gld") sz src dst
971 pprGInstr (GST sz src dst) = pprSizeRegAddr (sLit "gst") sz src dst
973 pprGInstr (GLDZ dst) = pprSizeReg (sLit "gldz") FF64 dst
974 pprGInstr (GLD1 dst) = pprSizeReg (sLit "gld1") FF64 dst
976 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg (sLit "gftoi") FF32 II32 src dst
977 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg (sLit "gdtoi") FF64 II32 src dst
979 pprGInstr (GITOF src dst) = pprSizeSizeRegReg (sLit "gitof") II32 FF32 src dst
980 pprGInstr (GITOD src dst) = pprSizeSizeRegReg (sLit "gitod") II32 FF64 src dst
982 pprGInstr (GCMP co src dst) = pprCondRegReg (sLit "gcmp_") FF64 co src dst
983 pprGInstr (GABS sz src dst) = pprSizeRegReg (sLit "gabs") sz src dst
984 pprGInstr (GNEG sz src dst) = pprSizeRegReg (sLit "gneg") sz src dst
985 pprGInstr (GSQRT sz src dst) = pprSizeRegReg (sLit "gsqrt") sz src dst
986 pprGInstr (GSIN sz _ _ src dst) = pprSizeRegReg (sLit "gsin") sz src dst
987 pprGInstr (GCOS sz _ _ src dst) = pprSizeRegReg (sLit "gcos") sz src dst
988 pprGInstr (GTAN sz _ _ src dst) = pprSizeRegReg (sLit "gtan") sz src dst
990 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg (sLit "gadd") sz src1 src2 dst
991 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg (sLit "gsub") sz src1 src2 dst
992 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg (sLit "gmul") sz src1 src2 dst
993 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg (sLit "gdiv") sz src1 src2 dst
995 pprGInstr _ = panic "X86.Ppr.pprGInstr: no match"
997 pprDollImm :: Imm -> Doc
998 pprDollImm i = ptext (sLit "$") <> pprImm i
1001 pprOperand :: Size -> Operand -> Doc
1002 pprOperand s (OpReg r) = pprReg s r
1003 pprOperand _ (OpImm i) = pprDollImm i
1004 pprOperand _ (OpAddr ea) = pprAddr ea
1007 pprMnemonic_ :: LitString -> Doc
1009 char '\t' <> ptext name <> space
1012 pprMnemonic :: LitString -> Size -> Doc
1013 pprMnemonic name size =
1014 char '\t' <> ptext name <> pprSize size <> space
1017 pprSizeImmOp :: LitString -> Size -> Imm -> Operand -> Doc
1018 pprSizeImmOp name size imm op1
1020 pprMnemonic name size,
1028 pprSizeOp :: LitString -> Size -> Operand -> Doc
1029 pprSizeOp name size op1
1031 pprMnemonic name size,
1036 pprSizeOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1037 pprSizeOpOp name size op1 op2
1039 pprMnemonic name size,
1040 pprOperand size op1,
1046 pprOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1047 pprOpOp name size op1 op2
1050 pprOperand size op1,
1056 pprSizeReg :: LitString -> Size -> Reg -> Doc
1057 pprSizeReg name size reg1
1059 pprMnemonic name size,
1064 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
1065 pprSizeRegReg name size reg1 reg2
1067 pprMnemonic name size,
1074 pprRegReg :: LitString -> Reg -> Reg -> Doc
1075 pprRegReg name reg1 reg2
1078 pprReg archWordSize reg1,
1080 pprReg archWordSize reg2
1084 pprOpReg :: LitString -> Operand -> Reg -> Doc
1085 pprOpReg name op1 reg2
1088 pprOperand archWordSize op1,
1090 pprReg archWordSize reg2
1094 pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> Doc
1095 pprCondRegReg name size cond reg1 reg2
1106 pprSizeSizeRegReg :: LitString -> Size -> Size -> Reg -> Reg -> Doc
1107 pprSizeSizeRegReg name size1 size2 reg1 reg2
1121 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1122 pprSizeRegRegReg name size reg1 reg2 reg3
1124 pprMnemonic name size,
1133 pprSizeAddrReg :: LitString -> Size -> AddrMode -> Reg -> Doc
1134 pprSizeAddrReg name size op dst
1136 pprMnemonic name size,
1143 pprSizeRegAddr :: LitString -> Size -> Reg -> AddrMode -> Doc
1144 pprSizeRegAddr name size src op
1146 pprMnemonic name size,
1153 pprShift :: LitString -> Size -> Operand -> Operand -> Doc
1154 pprShift name size src dest
1156 pprMnemonic name size,
1157 pprOperand II8 src, -- src is 8-bit sized
1159 pprOperand size dest
1163 pprSizeOpOpCoerce :: LitString -> Size -> Size -> Operand -> Operand -> Doc
1164 pprSizeOpOpCoerce name size1 size2 op1 op2
1165 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1166 pprOperand size1 op1,
1168 pprOperand size2 op2
1172 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1173 pprCondInstr name cond arg
1174 = hcat [ char '\t', ptext name, pprCond cond, space, arg]