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, Uniquable(..) )
41 import qualified Outputable
42 import Outputable (panic, Outputable)
45 import Distribution.System
47 #if i386_TARGET_ARCH && darwin_TARGET_OS
51 -- -----------------------------------------------------------------------------
52 -- Printing this stuff out
54 pprNatCmmTop :: NatCmmTop Instr -> Doc
55 pprNatCmmTop (CmmData section dats) =
56 pprSectionHeader section $$ vcat (map pprData dats)
58 -- special case for split markers:
59 pprNatCmmTop (CmmProc [] lbl (ListGraph [])) = pprLabel lbl
61 pprNatCmmTop (CmmProc info lbl (ListGraph blocks)) =
62 pprSectionHeader Text $$
63 (if null info then -- blocks guaranteed not null, so label needed
66 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
67 pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
70 vcat (map pprData info) $$
71 pprLabel (entryLblToInfoLbl lbl)
73 vcat (map pprBasicBlock blocks)
74 -- above: Even the first block gets a label, because with branch-chain
75 -- elimination, it might be the target of a goto.
76 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
77 -- If we are using the .subsections_via_symbols directive
78 -- (available on recent versions of Darwin),
79 -- we have to make sure that there is some kind of reference
80 -- from the entry code to a label on the _top_ of of the info table,
81 -- so that the linker will not think it is unreferenced and dead-strip
82 -- it. That's why the label is called a DeadStripPreventer (_dsp).
85 <+> pprCLabel_asm (entryLblToInfoLbl lbl)
87 <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
90 $$ pprSizeDecl (if null info then lbl else entryLblToInfoLbl lbl)
92 -- | Output the ELF .size directive.
93 pprSizeDecl :: CLabel -> Doc
96 ptext (sLit "\t.size") <+> pprCLabel_asm lbl
97 <> ptext (sLit ", .-") <> pprCLabel_asm lbl
102 pprBasicBlock :: NatBasicBlock Instr -> Doc
103 pprBasicBlock (BasicBlock blockid instrs) =
104 pprLabel (mkAsmTempLabel (getUnique blockid)) $$
105 vcat (map pprInstr instrs)
108 pprData :: CmmStatic -> Doc
109 pprData (CmmAlign bytes) = pprAlign bytes
110 pprData (CmmDataLabel lbl) = pprLabel lbl
111 pprData (CmmString str) = pprASCII str
114 pprData (CmmUninitialised bytes) = ptext (sLit ".space ") <> int bytes
116 pprData (CmmUninitialised bytes) = ptext (sLit ".skip ") <> int bytes
119 pprData (CmmStaticLit lit) = pprDataItem lit
121 pprGloblDecl :: CLabel -> Doc
123 | not (externallyVisibleCLabel lbl) = empty
124 | otherwise = ptext IF_ARCH_sparc((sLit ".global "),
128 pprTypeAndSizeDecl :: CLabel -> Doc
130 pprTypeAndSizeDecl lbl
131 | not (externallyVisibleCLabel lbl) = empty
132 | otherwise = ptext (sLit ".type ") <>
133 pprCLabel_asm lbl <> ptext (sLit ", @object")
139 pprLabel :: CLabel -> Doc
140 pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':')
143 pprASCII :: [Word8] -> Doc
145 = vcat (map do1 str) $$ do1 0
148 do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
150 pprAlign :: Int -> Doc
154 = ptext (sLit ".align ") <> int IF_OS_darwin(pow2, bytes)
160 log2 :: Int -> Int -- cache the common ones
165 log2 n = 1 + log2 (n `quot` 2)
168 -- -----------------------------------------------------------------------------
169 -- pprInstr: print an 'Instr'
171 instance Outputable Instr where
172 ppr instr = Outputable.docToSDoc $ pprInstr instr
175 pprUserReg :: Reg -> Doc
177 | cTargetArch == I386 = pprReg II32
178 | cTargetArch == X86_64 = pprReg II64
179 | otherwise = panic "X86.Ppr.pprUserReg: not defined"
181 pprReg :: Size -> Reg -> Doc
185 RegReal (RealRegSingle i) -> ppr_reg_no s i
186 RegReal (RealRegPair _ _) -> panic "X86.Ppr: no reg pairs on this arch"
187 RegVirtual (VirtualRegI u) -> text "%vI_" <> asmSDoc (pprUnique u)
188 RegVirtual (VirtualRegHi u) -> text "%vHi_" <> asmSDoc (pprUnique u)
189 RegVirtual (VirtualRegF u) -> text "%vF_" <> asmSDoc (pprUnique u)
190 RegVirtual (VirtualRegD u) -> text "%vD_" <> asmSDoc (pprUnique u)
191 RegVirtual (VirtualRegSSE u) -> text "%vSSE_" <> asmSDoc (pprUnique u)
194 ppr_reg_no :: Size -> Int -> Doc
195 ppr_reg_no II8 = ppr_reg_byte
196 ppr_reg_no II16 = ppr_reg_word
197 ppr_reg_no _ = ppr_reg_long
199 ppr_reg_byte i = ptext
201 0 -> sLit "%al"; 1 -> sLit "%bl";
202 2 -> sLit "%cl"; 3 -> sLit "%dl";
203 _ -> sLit "very naughty I386 byte register"
206 ppr_reg_word i = ptext
208 0 -> sLit "%ax"; 1 -> sLit "%bx";
209 2 -> sLit "%cx"; 3 -> sLit "%dx";
210 4 -> sLit "%si"; 5 -> sLit "%di";
211 6 -> sLit "%bp"; 7 -> sLit "%sp";
212 _ -> sLit "very naughty I386 word register"
215 ppr_reg_long i = ptext
217 0 -> sLit "%eax"; 1 -> sLit "%ebx";
218 2 -> sLit "%ecx"; 3 -> sLit "%edx";
219 4 -> sLit "%esi"; 5 -> sLit "%edi";
220 6 -> sLit "%ebp"; 7 -> sLit "%esp";
223 #elif x86_64_TARGET_ARCH
224 ppr_reg_no :: Size -> Int -> Doc
225 ppr_reg_no II8 = ppr_reg_byte
226 ppr_reg_no II16 = ppr_reg_word
227 ppr_reg_no II32 = ppr_reg_long
228 ppr_reg_no _ = ppr_reg_quad
230 ppr_reg_byte i = ptext
232 0 -> sLit "%al"; 1 -> sLit "%bl";
233 2 -> sLit "%cl"; 3 -> sLit "%dl";
234 4 -> sLit "%sil"; 5 -> sLit "%dil"; -- new 8-bit regs!
235 6 -> sLit "%bpl"; 7 -> sLit "%spl";
236 8 -> sLit "%r8b"; 9 -> sLit "%r9b";
237 10 -> sLit "%r10b"; 11 -> sLit "%r11b";
238 12 -> sLit "%r12b"; 13 -> sLit "%r13b";
239 14 -> sLit "%r14b"; 15 -> sLit "%r15b";
240 _ -> sLit "very naughty x86_64 byte register"
243 ppr_reg_word i = ptext
245 0 -> sLit "%ax"; 1 -> sLit "%bx";
246 2 -> sLit "%cx"; 3 -> sLit "%dx";
247 4 -> sLit "%si"; 5 -> sLit "%di";
248 6 -> sLit "%bp"; 7 -> sLit "%sp";
249 8 -> sLit "%r8w"; 9 -> sLit "%r9w";
250 10 -> sLit "%r10w"; 11 -> sLit "%r11w";
251 12 -> sLit "%r12w"; 13 -> sLit "%r13w";
252 14 -> sLit "%r14w"; 15 -> sLit "%r15w";
253 _ -> sLit "very naughty x86_64 word register"
256 ppr_reg_long i = ptext
258 0 -> sLit "%eax"; 1 -> sLit "%ebx";
259 2 -> sLit "%ecx"; 3 -> sLit "%edx";
260 4 -> sLit "%esi"; 5 -> sLit "%edi";
261 6 -> sLit "%ebp"; 7 -> sLit "%esp";
262 8 -> sLit "%r8d"; 9 -> sLit "%r9d";
263 10 -> sLit "%r10d"; 11 -> sLit "%r11d";
264 12 -> sLit "%r12d"; 13 -> sLit "%r13d";
265 14 -> sLit "%r14d"; 15 -> sLit "%r15d";
266 _ -> sLit "very naughty x86_64 register"
269 ppr_reg_quad i = ptext
271 0 -> sLit "%rax"; 1 -> sLit "%rbx";
272 2 -> sLit "%rcx"; 3 -> sLit "%rdx";
273 4 -> sLit "%rsi"; 5 -> sLit "%rdi";
274 6 -> sLit "%rbp"; 7 -> sLit "%rsp";
275 8 -> sLit "%r8"; 9 -> sLit "%r9";
276 10 -> sLit "%r10"; 11 -> sLit "%r11";
277 12 -> sLit "%r12"; 13 -> sLit "%r13";
278 14 -> sLit "%r14"; 15 -> sLit "%r15";
282 ppr_reg_no _ = panic "X86.Ppr.ppr_reg_no: no match"
285 #if defined(i386_TARGET_ARCH) || defined(x86_64_TARGET_ARCH)
286 ppr_reg_float :: Int -> LitString
287 ppr_reg_float i = case i of
288 16 -> sLit "%fake0"; 17 -> sLit "%fake1"
289 18 -> sLit "%fake2"; 19 -> sLit "%fake3"
290 20 -> sLit "%fake4"; 21 -> sLit "%fake5"
291 24 -> sLit "%xmm0"; 25 -> sLit "%xmm1"
292 26 -> sLit "%xmm2"; 27 -> sLit "%xmm3"
293 28 -> sLit "%xmm4"; 29 -> sLit "%xmm5"
294 30 -> sLit "%xmm6"; 31 -> sLit "%xmm7"
295 32 -> sLit "%xmm8"; 33 -> sLit "%xmm9"
296 34 -> sLit "%xmm10"; 35 -> sLit "%xmm11"
297 36 -> sLit "%xmm12"; 37 -> sLit "%xmm13"
298 38 -> sLit "%xmm14"; 39 -> sLit "%xmm15"
299 _ -> sLit "very naughty x86 register"
302 pprSize :: Size -> Doc
309 FF32 -> sLit "ss" -- "scalar single-precision float" (SSE2)
310 FF64 -> sLit "sd" -- "scalar double-precision float" (SSE2)
314 pprSize_x87 :: Size -> Doc
320 _ -> panic "X86.Ppr.pprSize_x87"
322 pprCond :: Cond -> Doc
325 GEU -> sLit "ae"; LU -> sLit "b";
326 EQQ -> sLit "e"; GTT -> sLit "g";
327 GE -> sLit "ge"; GU -> sLit "a";
328 LTT -> sLit "l"; LE -> sLit "le";
329 LEU -> sLit "be"; NE -> sLit "ne";
330 NEG -> sLit "s"; POS -> sLit "ns";
331 CARRY -> sLit "c"; OFLO -> sLit "o";
332 PARITY -> sLit "p"; NOTPARITY -> sLit "np";
333 ALWAYS -> sLit "mp"})
337 pprImm (ImmInt i) = int i
338 pprImm (ImmInteger i) = integer i
339 pprImm (ImmCLbl l) = pprCLabel_asm l
340 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
341 pprImm (ImmLit s) = s
343 pprImm (ImmFloat _) = ptext (sLit "naughty float immediate")
344 pprImm (ImmDouble _) = ptext (sLit "naughty double immediate")
346 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
347 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
348 <> lparen <> pprImm b <> rparen
352 pprAddr :: AddrMode -> Doc
353 pprAddr (ImmAddr imm off)
354 = let pp_imm = pprImm imm
358 else if (off < 0) then
361 pp_imm <> char '+' <> int off
363 pprAddr (AddrBaseIndex base index displacement)
365 pp_disp = ppr_disp displacement
366 pp_off p = pp_disp <> char '(' <> p <> char ')'
367 pp_reg r = pprReg archWordSize r
369 case (base, index) of
370 (EABaseNone, EAIndexNone) -> pp_disp
371 (EABaseReg b, EAIndexNone) -> pp_off (pp_reg b)
372 (EABaseRip, EAIndexNone) -> pp_off (ptext (sLit "%rip"))
373 (EABaseNone, EAIndex r i) -> pp_off (comma <> pp_reg r <> comma <> int i)
374 (EABaseReg b, EAIndex r i) -> pp_off (pp_reg b <> comma <> pp_reg r
376 _ -> panic "X86.Ppr.pprAddr: no match"
379 ppr_disp (ImmInt 0) = empty
380 ppr_disp imm = pprImm imm
383 pprSectionHeader :: Section -> Doc
386 # if darwin_TARGET_OS
389 Text -> ptext (sLit ".text\n\t.align 2")
390 Data -> ptext (sLit ".data\n\t.align 2")
391 ReadOnlyData -> ptext (sLit ".const\n.align 2")
392 RelocatableReadOnlyData -> ptext (sLit ".const_data\n.align 2")
393 UninitialisedData -> ptext (sLit ".data\n\t.align 2")
394 ReadOnlyData16 -> ptext (sLit ".const\n.align 4")
395 OtherSection _ -> panic "X86.Ppr.pprSectionHeader: unknown section"
400 Text -> ptext (sLit ".text\n\t.align 4,0x90")
401 Data -> ptext (sLit ".data\n\t.align 4")
402 ReadOnlyData -> ptext (sLit ".section .rodata\n\t.align 4")
403 RelocatableReadOnlyData -> ptext (sLit ".section .data\n\t.align 4")
404 UninitialisedData -> ptext (sLit ".section .bss\n\t.align 4")
405 ReadOnlyData16 -> ptext (sLit ".section .rodata\n\t.align 16")
406 OtherSection _ -> panic "X86.Ppr.pprSectionHeader: unknown section"
410 #elif x86_64_TARGET_ARCH
411 # if darwin_TARGET_OS
414 Text -> ptext (sLit ".text\n.align 3")
415 Data -> ptext (sLit ".data\n.align 3")
416 ReadOnlyData -> ptext (sLit ".const\n.align 3")
417 RelocatableReadOnlyData -> ptext (sLit ".const_data\n.align 3")
418 UninitialisedData -> ptext (sLit ".data\n\t.align 3")
419 ReadOnlyData16 -> ptext (sLit ".const\n.align 4")
420 OtherSection _ -> panic "PprMach.pprSectionHeader: unknown section"
425 Text -> ptext (sLit ".text\n\t.align 8")
426 Data -> ptext (sLit ".data\n\t.align 8")
427 ReadOnlyData -> ptext (sLit ".section .rodata\n\t.align 8")
428 RelocatableReadOnlyData -> ptext (sLit ".section .data\n\t.align 8")
429 UninitialisedData -> ptext (sLit ".section .bss\n\t.align 8")
430 ReadOnlyData16 -> ptext (sLit ".section .rodata.cst16\n\t.align 16")
431 OtherSection _ -> panic "PprMach.pprSectionHeader: unknown section"
436 pprSectionHeader _ = panic "X86.Ppr.pprSectionHeader: not defined for this architecture"
443 pprDataItem :: CmmLit -> Doc
445 = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
449 -- These seem to be common:
450 ppr_item II8 _ = [ptext (sLit "\t.byte\t") <> pprImm imm]
451 ppr_item II32 _ = [ptext (sLit "\t.long\t") <> pprImm imm]
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
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
461 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
462 ppr_item II16 _ = [ptext (sLit "\t.word\t") <> pprImm imm]
464 #if i386_TARGET_ARCH && darwin_TARGET_OS
465 ppr_item II64 (CmmInt x _) =
466 [ptext (sLit "\t.long\t")
467 <> int (fromIntegral (fromIntegral x :: Word32)),
468 ptext (sLit "\t.long\t")
470 (fromIntegral (x `shiftR` 32) :: Word32))]
472 #if i386_TARGET_ARCH || (darwin_TARGET_OS && x86_64_TARGET_ARCH)
473 ppr_item II64 _ = [ptext (sLit "\t.quad\t") <> pprImm imm]
475 #if x86_64_TARGET_ARCH && !darwin_TARGET_OS
476 -- x86_64: binutils can't handle the R_X86_64_PC64 relocation
477 -- type, which means we can't do pc-relative 64-bit addresses.
478 -- Fortunately we're assuming the small memory model, in which
479 -- all such offsets will fit into 32 bits, so we have to stick
480 -- to 32-bit offset fields and modify the RTS appropriately
482 -- See Note [x86-64-relative] in includes/rts/storage/InfoTables.h
485 | isRelativeReloc x =
486 [ptext (sLit "\t.long\t") <> pprImm imm,
487 ptext (sLit "\t.long\t0")]
489 [ptext (sLit "\t.quad\t") <> pprImm imm]
491 isRelativeReloc (CmmLabelDiffOff _ _ _) = True
492 isRelativeReloc _ = False
496 = panic "X86.Ppr.ppr_item: no match"
500 pprInstr :: Instr -> Doc
502 pprInstr (COMMENT _) = empty -- nuke 'em
505 = IF_ARCH_alpha( ((<>) (ptext (sLit "\t# ")) (ftext s))
506 ,IF_ARCH_sparc( ((<>) (ptext (sLit "# ")) (ftext s))
507 ,IF_ARCH_i386( ((<>) (ptext (sLit "# ")) (ftext s))
508 ,IF_ARCH_x86_64( ((<>) (ptext (sLit "# ")) (ftext s))
509 ,IF_ARCH_powerpc( IF_OS_linux(
510 ((<>) (ptext (sLit "# ")) (ftext s)),
511 ((<>) (ptext (sLit "; ")) (ftext s)))
515 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
517 pprInstr (NEWBLOCK _)
518 = panic "PprMach.pprInstr: NEWBLOCK"
521 = panic "PprMach.pprInstr: LDATA"
524 pprInstr (SPILL reg slot)
526 ptext (sLit "\tSPILL"),
530 ptext (sLit "SLOT") <> parens (int slot)]
532 pprInstr (RELOAD slot reg)
534 ptext (sLit "\tRELOAD"),
536 ptext (sLit "SLOT") <> parens (int slot),
541 pprInstr (MOV size src dst)
542 = pprSizeOpOp (sLit "mov") size src dst
544 pprInstr (MOVZxL II32 src dst) = pprSizeOpOp (sLit "mov") II32 src dst
545 -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
546 -- movl. But we represent it as a MOVZxL instruction, because
547 -- the reg alloc would tend to throw away a plain reg-to-reg
548 -- move, and we still want it to do that.
550 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce (sLit "movz") sizes II32 src dst
551 -- zero-extension only needs to extend to 32 bits: on x86_64,
552 -- the remaining zero-extension to 64 bits is automatic, and the 32-bit
553 -- instruction is shorter.
555 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce (sLit "movs") sizes archWordSize src dst
557 -- here we do some patching, since the physical registers are only set late
558 -- in the code generation.
559 pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
561 = pprSizeOpOp (sLit "add") size (OpReg reg2) dst
563 pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
565 = pprSizeOpOp (sLit "add") size (OpReg reg1) dst
567 pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
569 = pprInstr (ADD size (OpImm displ) dst)
571 pprInstr (LEA size src dst) = pprSizeOpOp (sLit "lea") size src dst
573 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
574 = pprSizeOp (sLit "dec") size dst
575 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
576 = pprSizeOp (sLit "inc") size dst
577 pprInstr (ADD size src dst)
578 = pprSizeOpOp (sLit "add") size src dst
579 pprInstr (ADC size src dst)
580 = pprSizeOpOp (sLit "adc") size src dst
581 pprInstr (SUB size src dst) = pprSizeOpOp (sLit "sub") size src dst
582 pprInstr (IMUL size op1 op2) = pprSizeOpOp (sLit "imul") size op1 op2
584 {- A hack. The Intel documentation says that "The two and three
585 operand forms [of IMUL] may also be used with unsigned operands
586 because the lower half of the product is the same regardless if
587 (sic) the operands are signed or unsigned. The CF and OF flags,
588 however, cannot be used to determine if the upper half of the
589 result is non-zero." So there.
591 pprInstr (AND size src dst) = pprSizeOpOp (sLit "and") size src dst
592 pprInstr (OR size src dst) = pprSizeOpOp (sLit "or") size src dst
594 pprInstr (XOR FF32 src dst) = pprOpOp (sLit "xorps") FF32 src dst
595 pprInstr (XOR FF64 src dst) = pprOpOp (sLit "xorpd") FF64 src dst
596 pprInstr (XOR size src dst) = pprSizeOpOp (sLit "xor") size src dst
598 pprInstr (NOT size op) = pprSizeOp (sLit "not") size op
599 pprInstr (NEGI size op) = pprSizeOp (sLit "neg") size op
601 pprInstr (SHL size src dst) = pprShift (sLit "shl") size src dst
602 pprInstr (SAR size src dst) = pprShift (sLit "sar") size src dst
603 pprInstr (SHR size src dst) = pprShift (sLit "shr") size src dst
605 pprInstr (BT size imm src) = pprSizeImmOp (sLit "bt") size imm src
607 pprInstr (CMP size src dst)
608 | is_float size = pprSizeOpOp (sLit "ucomi") size src dst -- SSE2
609 | otherwise = pprSizeOpOp (sLit "cmp") size src dst
611 -- This predicate is needed here and nowhere else
617 pprInstr (TEST size src dst) = pprSizeOpOp (sLit "test") size src dst
618 pprInstr (PUSH size op) = pprSizeOp (sLit "push") size op
619 pprInstr (POP size op) = pprSizeOp (sLit "pop") size op
621 -- both unused (SDM):
622 -- pprInstr PUSHA = ptext (sLit "\tpushal")
623 -- pprInstr POPA = ptext (sLit "\tpopal")
625 pprInstr NOP = ptext (sLit "\tnop")
626 pprInstr (CLTD II32) = ptext (sLit "\tcltd")
627 pprInstr (CLTD II64) = ptext (sLit "\tcqto")
629 pprInstr (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand II8 op)
631 pprInstr (JXX cond blockid)
632 = pprCondInstr (sLit "j") cond (pprCLabel_asm lab)
633 where lab = mkAsmTempLabel (getUnique blockid)
635 pprInstr (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm imm)
637 pprInstr (JMP (OpImm imm)) = (<>) (ptext (sLit "\tjmp ")) (pprImm imm)
638 pprInstr (JMP op) = (<>) (ptext (sLit "\tjmp *")) (pprOperand archWordSize op)
639 pprInstr (JMP_TBL op _ _ _) = pprInstr (JMP op)
640 pprInstr (CALL (Left imm) _) = (<>) (ptext (sLit "\tcall ")) (pprImm imm)
641 pprInstr (CALL (Right reg) _) = (<>) (ptext (sLit "\tcall *")) (pprReg archWordSize reg)
643 pprInstr (IDIV sz op) = pprSizeOp (sLit "idiv") sz op
644 pprInstr (DIV sz op) = pprSizeOp (sLit "div") sz op
645 pprInstr (IMUL2 sz op) = pprSizeOp (sLit "imul") sz op
648 pprInstr (MUL size op1 op2) = pprSizeOpOp (sLit "mul") size op1 op2
650 pprInstr (FDIV size op1 op2) = pprSizeOpOp (sLit "div") size op1 op2
652 pprInstr (CVTSS2SD from to) = pprRegReg (sLit "cvtss2sd") from to
653 pprInstr (CVTSD2SS from to) = pprRegReg (sLit "cvtsd2ss") from to
654 pprInstr (CVTTSS2SIQ sz from to) = pprSizeOpReg (sLit "cvttss2si") sz from to
655 pprInstr (CVTTSD2SIQ sz from to) = pprSizeOpReg (sLit "cvttsd2si") sz from to
656 pprInstr (CVTSI2SS sz from to) = pprSizeOpReg (sLit "cvtsi2ss") sz from to
657 pprInstr (CVTSI2SD sz from to) = pprSizeOpReg (sLit "cvtsi2sd") sz from to
659 -- FETCHGOT for PIC on ELF platforms
660 pprInstr (FETCHGOT reg)
661 = vcat [ ptext (sLit "\tcall 1f"),
662 hcat [ ptext (sLit "1:\tpopl\t"), pprReg II32 reg ],
663 hcat [ ptext (sLit "\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
667 -- FETCHPC for PIC on Darwin/x86
668 -- get the instruction pointer into a register
669 -- (Terminology note: the IP is called Program Counter on PPC,
670 -- and it's a good thing to use the same name on both platforms)
671 pprInstr (FETCHPC reg)
672 = vcat [ ptext (sLit "\tcall 1f"),
673 hcat [ ptext (sLit "1:\tpopl\t"), pprReg II32 reg ]
677 -- -----------------------------------------------------------------------------
678 -- i386 floating-point
680 -- Simulating a flat register set on the x86 FP stack is tricky.
681 -- you have to free %st(7) before pushing anything on the FP reg stack
682 -- so as to preclude the possibility of a FP stack overflow exception.
683 pprInstr g@(GMOV src dst)
687 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
689 -- GLD sz addr dst ==> FLDsz addr ; FSTP (dst+1)
690 pprInstr g@(GLD sz addr dst)
691 = pprG g (hcat [gtab, text "fld", pprSize_x87 sz, gsp,
692 pprAddr addr, gsemi, gpop dst 1])
694 -- GST sz src addr ==> FLD dst ; FSTPsz addr
695 pprInstr g@(GST sz src addr)
696 | src == fake0 && sz /= FF80 -- fstt instruction doesn't exist
697 = pprG g (hcat [gtab,
698 text "fst", pprSize_x87 sz, gsp, pprAddr addr])
700 = pprG g (hcat [gtab, gpush src 0, gsemi,
701 text "fstp", pprSize_x87 sz, gsp, pprAddr addr])
703 pprInstr g@(GLDZ dst)
704 = pprG g (hcat [gtab, text "fldz ; ", gpop dst 1])
705 pprInstr g@(GLD1 dst)
706 = pprG g (hcat [gtab, text "fld1 ; ", gpop dst 1])
708 pprInstr (GFTOI src dst)
709 = pprInstr (GDTOI src dst)
711 pprInstr g@(GDTOI src dst)
713 hcat [gtab, text "subl $8, %esp ; fnstcw 4(%esp)"],
714 hcat [gtab, gpush src 0],
715 hcat [gtab, text "movzwl 4(%esp), ", reg,
716 text " ; orl $0xC00, ", reg],
717 hcat [gtab, text "movl ", reg, text ", 0(%esp) ; fldcw 0(%esp)"],
718 hcat [gtab, text "fistpl 0(%esp)"],
719 hcat [gtab, text "fldcw 4(%esp) ; movl 0(%esp), ", reg],
720 hcat [gtab, text "addl $8, %esp"]
723 reg = pprReg II32 dst
725 pprInstr (GITOF src dst)
726 = pprInstr (GITOD src dst)
728 pprInstr g@(GITOD src dst)
729 = pprG g (hcat [gtab, text "pushl ", pprReg II32 src,
730 text " ; fildl (%esp) ; ",
731 gpop dst 1, text " ; addl $4,%esp"])
733 pprInstr g@(GDTOF src dst)
734 = pprG g (vcat [gtab <> gpush src 0,
735 gtab <> text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ;",
738 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
739 this far into the jungle AND you give a Rat's Ass (tm) what's going
740 on, here's the deal. Generate code to do a floating point comparison
741 of src1 and src2, of kind cond, and set the Zero flag if true.
743 The complications are to do with handling NaNs correctly. We want the
744 property that if either argument is NaN, then the result of the
745 comparison is False ... except if we're comparing for inequality,
746 in which case the answer is True.
748 Here's how the general (non-inequality) case works. As an
749 example, consider generating the an equality test:
751 pushl %eax -- we need to mess with this
752 <get src1 to top of FPU stack>
753 fcomp <src2 location in FPU stack> and pop pushed src1
754 -- Result of comparison is in FPU Status Register bits
756 fstsw %ax -- Move FPU Status Reg to %ax
757 sahf -- move C3 C2 C0 from %ax to integer flag reg
758 -- now the serious magic begins
759 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
760 sete %al -- %al = if arg1 == arg2 then 1 else 0
761 andb %ah,%al -- %al &= %ah
762 -- so %al == 1 iff (comparable && same); else it holds 0
763 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
764 else %al == 0xFF, ZeroFlag=0
765 -- the zero flag is now set as we desire.
768 The special case of inequality differs thusly:
770 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
771 setne %al -- %al = if arg1 /= arg2 then 1 else 0
772 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
773 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
774 else (%al == 0xFF, ZF=0)
776 pprInstr g@(GCMP cond src1 src2)
777 | case cond of { NE -> True; _ -> False }
779 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
780 hcat [gtab, text "fcomp ", greg src2 1,
781 text "; fstsw %ax ; sahf ; setpe %ah"],
782 hcat [gtab, text "setne %al ; ",
783 text "orb %ah,%al ; decb %al ; popl %eax"]
787 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
788 hcat [gtab, text "fcomp ", greg src2 1,
789 text "; fstsw %ax ; sahf ; setpo %ah"],
790 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
791 text "andb %ah,%al ; decb %al ; popl %eax"]
794 {- On the 486, the flags set by FP compare are the unsigned ones!
795 (This looks like a HACK to me. WDP 96/03)
797 fix_FP_cond :: Cond -> Cond
802 fix_FP_cond EQQ = EQQ
804 fix_FP_cond _ = panic "X86.Ppr.fix_FP_cond: no match"
805 -- there should be no others
808 pprInstr g@(GABS _ src dst)
809 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
811 pprInstr g@(GNEG _ src dst)
812 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
814 pprInstr g@(GSQRT sz src dst)
815 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
816 hcat [gtab, gcoerceto sz, gpop dst 1])
818 pprInstr g@(GSIN sz l1 l2 src dst)
819 = pprG g (pprTrigOp "fsin" False l1 l2 src dst sz)
821 pprInstr g@(GCOS sz l1 l2 src dst)
822 = pprG g (pprTrigOp "fcos" False l1 l2 src dst sz)
824 pprInstr g@(GTAN sz l1 l2 src dst)
825 = pprG g (pprTrigOp "fptan" True l1 l2 src dst sz)
827 -- In the translations for GADD, GMUL, GSUB and GDIV,
828 -- the first two cases are mere optimisations. The otherwise clause
829 -- generates correct code under all circumstances.
831 pprInstr g@(GADD _ src1 src2 dst)
833 = pprG g (text "\t#GADD-xxxcase1" $$
834 hcat [gtab, gpush src2 0,
835 text " ; faddp %st(0),", greg src1 1])
837 = pprG g (text "\t#GADD-xxxcase2" $$
838 hcat [gtab, gpush src1 0,
839 text " ; faddp %st(0),", greg src2 1])
841 = pprG g (hcat [gtab, gpush src1 0,
842 text " ; fadd ", greg src2 1, text ",%st(0)",
846 pprInstr g@(GMUL _ src1 src2 dst)
848 = pprG g (text "\t#GMUL-xxxcase1" $$
849 hcat [gtab, gpush src2 0,
850 text " ; fmulp %st(0),", greg src1 1])
852 = pprG g (text "\t#GMUL-xxxcase2" $$
853 hcat [gtab, gpush src1 0,
854 text " ; fmulp %st(0),", greg src2 1])
856 = pprG g (hcat [gtab, gpush src1 0,
857 text " ; fmul ", greg src2 1, text ",%st(0)",
861 pprInstr g@(GSUB _ src1 src2 dst)
863 = pprG g (text "\t#GSUB-xxxcase1" $$
864 hcat [gtab, gpush src2 0,
865 text " ; fsubrp %st(0),", greg src1 1])
867 = pprG g (text "\t#GSUB-xxxcase2" $$
868 hcat [gtab, gpush src1 0,
869 text " ; fsubp %st(0),", greg src2 1])
871 = pprG g (hcat [gtab, gpush src1 0,
872 text " ; fsub ", greg src2 1, text ",%st(0)",
876 pprInstr g@(GDIV _ src1 src2 dst)
878 = pprG g (text "\t#GDIV-xxxcase1" $$
879 hcat [gtab, gpush src2 0,
880 text " ; fdivrp %st(0),", greg src1 1])
882 = pprG g (text "\t#GDIV-xxxcase2" $$
883 hcat [gtab, gpush src1 0,
884 text " ; fdivp %st(0),", greg src2 1])
886 = pprG g (hcat [gtab, gpush src1 0,
887 text " ; fdiv ", greg src2 1, text ",%st(0)",
892 = vcat [ ptext (sLit "\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
893 ptext (sLit "\tffree %st(4) ;ffree %st(5)")
897 = panic "X86.Ppr.pprInstr: no match"
900 pprTrigOp :: String -> Bool -> CLabel -> CLabel -> Reg -> Reg -> Size -> Doc
901 pprTrigOp op -- fsin, fcos or fptan
902 isTan -- we need a couple of extra steps if we're doing tan
903 l1 l2 -- internal labels for us to use
905 = -- We'll be needing %eax later on
906 hcat [gtab, text "pushl %eax;"] $$
907 -- tan is going to use an extra space on the FP stack
908 (if isTan then hcat [gtab, text "ffree %st(6)"] else empty) $$
909 -- First put the value in %st(0) and try to apply the op to it
910 hcat [gpush src 0, text ("; " ++ op)] $$
911 -- Now look to see if C2 was set (overflow, |value| >= 2^63)
912 hcat [gtab, text "fnstsw %ax"] $$
913 hcat [gtab, text "test $0x400,%eax"] $$
914 -- If we were in bounds then jump to the end
915 hcat [gtab, text "je " <> pprCLabel_asm l1] $$
916 -- Otherwise we need to shrink the value. Start by
917 -- loading pi, doubleing it (by adding it to itself),
918 -- and then swapping pi with the value, so the value we
919 -- want to apply op to is in %st(0) again
920 hcat [gtab, text "ffree %st(7); fldpi"] $$
921 hcat [gtab, text "fadd %st(0),%st"] $$
922 hcat [gtab, text "fxch %st(1)"] $$
923 -- Now we have a loop in which we make the value smaller,
924 -- see if it's small enough, and loop if not
925 (pprCLabel_asm l2 <> char ':') $$
926 hcat [gtab, text "fprem1"] $$
927 -- My Debian libc uses fstsw here for the tan code, but I can't
928 -- see any reason why it should need to be different for tan.
929 hcat [gtab, text "fnstsw %ax"] $$
930 hcat [gtab, text "test $0x400,%eax"] $$
931 hcat [gtab, text "jne " <> pprCLabel_asm l2] $$
932 hcat [gtab, text "fstp %st(1)"] $$
933 hcat [gtab, text op] $$
934 (pprCLabel_asm l1 <> char ':') $$
935 -- Pop the 1.0 tan gave us
936 (if isTan then hcat [gtab, text "fstp %st(0)"] else empty) $$
938 hcat [gtab, text "popl %eax;"] $$
939 -- And finally make the result the right size
940 hcat [gtab, gcoerceto sz, gpop dst 1]
942 --------------------------
944 -- coerce %st(0) to the specified size
945 gcoerceto :: Size -> Doc
946 gcoerceto FF64 = empty
947 gcoerceto FF32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
948 gcoerceto _ = panic "X86.Ppr.gcoerceto: no match"
950 gpush :: Reg -> RegNo -> Doc
952 = hcat [text "fld ", greg reg offset]
954 gpop :: Reg -> RegNo -> Doc
956 = hcat [text "fstp ", greg reg offset]
958 greg :: Reg -> RegNo -> Doc
959 greg reg offset = text "%st(" <> int (gregno reg - firstfake+offset) <> char ')'
970 gregno :: Reg -> RegNo
971 gregno (RegReal (RealRegSingle i)) = i
972 gregno _ = --pprPanic "gregno" (ppr other)
973 999 -- bogus; only needed for debug printing
975 pprG :: Instr -> Doc -> Doc
977 = (char '#' <> pprGInstr fake) $$ actual
980 pprGInstr :: Instr -> Doc
981 pprGInstr (GMOV src dst) = pprSizeRegReg (sLit "gmov") FF64 src dst
982 pprGInstr (GLD sz src dst) = pprSizeAddrReg (sLit "gld") sz src dst
983 pprGInstr (GST sz src dst) = pprSizeRegAddr (sLit "gst") sz src dst
985 pprGInstr (GLDZ dst) = pprSizeReg (sLit "gldz") FF64 dst
986 pprGInstr (GLD1 dst) = pprSizeReg (sLit "gld1") FF64 dst
988 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg (sLit "gftoi") FF32 II32 src dst
989 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg (sLit "gdtoi") FF64 II32 src dst
991 pprGInstr (GITOF src dst) = pprSizeSizeRegReg (sLit "gitof") II32 FF32 src dst
992 pprGInstr (GITOD src dst) = pprSizeSizeRegReg (sLit "gitod") II32 FF64 src dst
993 pprGInstr (GDTOF src dst) = pprSizeSizeRegReg (sLit "gdtof") FF64 FF32 src dst
995 pprGInstr (GCMP co src dst) = pprCondRegReg (sLit "gcmp_") FF64 co src dst
996 pprGInstr (GABS sz src dst) = pprSizeRegReg (sLit "gabs") sz src dst
997 pprGInstr (GNEG sz src dst) = pprSizeRegReg (sLit "gneg") sz src dst
998 pprGInstr (GSQRT sz src dst) = pprSizeRegReg (sLit "gsqrt") sz src dst
999 pprGInstr (GSIN sz _ _ src dst) = pprSizeRegReg (sLit "gsin") sz src dst
1000 pprGInstr (GCOS sz _ _ src dst) = pprSizeRegReg (sLit "gcos") sz src dst
1001 pprGInstr (GTAN sz _ _ src dst) = pprSizeRegReg (sLit "gtan") sz src dst
1003 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg (sLit "gadd") sz src1 src2 dst
1004 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg (sLit "gsub") sz src1 src2 dst
1005 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg (sLit "gmul") sz src1 src2 dst
1006 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg (sLit "gdiv") sz src1 src2 dst
1008 pprGInstr _ = panic "X86.Ppr.pprGInstr: no match"
1010 pprDollImm :: Imm -> Doc
1011 pprDollImm i = ptext (sLit "$") <> pprImm i
1014 pprOperand :: Size -> Operand -> Doc
1015 pprOperand s (OpReg r) = pprReg s r
1016 pprOperand _ (OpImm i) = pprDollImm i
1017 pprOperand _ (OpAddr ea) = pprAddr ea
1020 pprMnemonic_ :: LitString -> Doc
1022 char '\t' <> ptext name <> space
1025 pprMnemonic :: LitString -> Size -> Doc
1026 pprMnemonic name size =
1027 char '\t' <> ptext name <> pprSize size <> space
1030 pprSizeImmOp :: LitString -> Size -> Imm -> Operand -> Doc
1031 pprSizeImmOp name size imm op1
1033 pprMnemonic name size,
1041 pprSizeOp :: LitString -> Size -> Operand -> Doc
1042 pprSizeOp name size op1
1044 pprMnemonic name size,
1049 pprSizeOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1050 pprSizeOpOp name size op1 op2
1052 pprMnemonic name size,
1053 pprOperand size op1,
1059 pprOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1060 pprOpOp name size op1 op2
1063 pprOperand size op1,
1069 pprSizeReg :: LitString -> Size -> Reg -> Doc
1070 pprSizeReg name size reg1
1072 pprMnemonic name size,
1077 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
1078 pprSizeRegReg name size reg1 reg2
1080 pprMnemonic name size,
1087 pprRegReg :: LitString -> Reg -> Reg -> Doc
1088 pprRegReg name reg1 reg2
1091 pprReg archWordSize reg1,
1093 pprReg archWordSize reg2
1097 pprSizeOpReg :: LitString -> Size -> Operand -> Reg -> Doc
1098 pprSizeOpReg name size op1 reg2
1100 pprMnemonic name size,
1101 pprOperand size op1,
1103 pprReg archWordSize reg2
1107 pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> Doc
1108 pprCondRegReg name size cond reg1 reg2
1119 pprSizeSizeRegReg :: LitString -> Size -> Size -> Reg -> Reg -> Doc
1120 pprSizeSizeRegReg name size1 size2 reg1 reg2
1134 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1135 pprSizeRegRegReg name size reg1 reg2 reg3
1137 pprMnemonic name size,
1146 pprSizeAddrReg :: LitString -> Size -> AddrMode -> Reg -> Doc
1147 pprSizeAddrReg name size op dst
1149 pprMnemonic name size,
1156 pprSizeRegAddr :: LitString -> Size -> Reg -> AddrMode -> Doc
1157 pprSizeRegAddr name size src op
1159 pprMnemonic name size,
1166 pprShift :: LitString -> Size -> Operand -> Operand -> Doc
1167 pprShift name size src dest
1169 pprMnemonic name size,
1170 pprOperand II8 src, -- src is 8-bit sized
1172 pprOperand size dest
1176 pprSizeOpOpCoerce :: LitString -> Size -> Size -> Operand -> Operand -> Doc
1177 pprSizeOpOpCoerce name size1 size2 op1 op2
1178 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1179 pprOperand size1 op1,
1181 pprOperand size2 op2
1185 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1186 pprCondInstr name cond arg
1187 = hcat [ char '\t', ptext name, pprCond cond, space, arg]