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
164 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
165 pprUserReg :: Reg -> Doc
166 pprUserReg = pprReg IF_ARCH_i386(II32,) IF_ARCH_x86_64(II64,)
169 pprUserReg :: Reg -> Doc
170 pprUserReg = panic "X86.Ppr.pprUserReg: not defined"
174 pprReg :: Size -> Reg -> Doc
178 RegReal (RealRegSingle i) -> ppr_reg_no s i
179 RegReal (RealRegPair _ _) -> panic "X86.Ppr: no reg pairs on this arch"
180 RegVirtual (VirtualRegI u) -> text "%vI_" <> asmSDoc (pprUnique u)
181 RegVirtual (VirtualRegHi u) -> text "%vHi_" <> asmSDoc (pprUnique u)
182 RegVirtual (VirtualRegF u) -> text "%vF_" <> asmSDoc (pprUnique u)
183 RegVirtual (VirtualRegD u) -> text "%vD_" <> asmSDoc (pprUnique u)
186 ppr_reg_no :: Size -> Int -> Doc
187 ppr_reg_no II8 = ppr_reg_byte
188 ppr_reg_no II16 = ppr_reg_word
189 ppr_reg_no _ = ppr_reg_long
191 ppr_reg_byte i = ptext
193 0 -> sLit "%al"; 1 -> sLit "%bl";
194 2 -> sLit "%cl"; 3 -> sLit "%dl";
195 _ -> sLit "very naughty I386 byte register"
198 ppr_reg_word i = ptext
200 0 -> sLit "%ax"; 1 -> sLit "%bx";
201 2 -> sLit "%cx"; 3 -> sLit "%dx";
202 4 -> sLit "%si"; 5 -> sLit "%di";
203 6 -> sLit "%bp"; 7 -> sLit "%sp";
204 _ -> sLit "very naughty I386 word register"
207 ppr_reg_long i = ptext
209 0 -> sLit "%eax"; 1 -> sLit "%ebx";
210 2 -> sLit "%ecx"; 3 -> sLit "%edx";
211 4 -> sLit "%esi"; 5 -> sLit "%edi";
212 6 -> sLit "%ebp"; 7 -> sLit "%esp";
213 8 -> sLit "%fake0"; 9 -> sLit "%fake1";
214 10 -> sLit "%fake2"; 11 -> sLit "%fake3";
215 12 -> sLit "%fake4"; 13 -> sLit "%fake5";
216 _ -> sLit "very naughty I386 register"
218 #elif x86_64_TARGET_ARCH
219 ppr_reg_no :: Size -> Int -> Doc
220 ppr_reg_no II8 = ppr_reg_byte
221 ppr_reg_no II16 = ppr_reg_word
222 ppr_reg_no II32 = ppr_reg_long
223 ppr_reg_no _ = ppr_reg_quad
225 ppr_reg_byte i = ptext
227 0 -> sLit "%al"; 1 -> sLit "%bl";
228 2 -> sLit "%cl"; 3 -> sLit "%dl";
229 4 -> sLit "%sil"; 5 -> sLit "%dil"; -- new 8-bit regs!
230 6 -> sLit "%bpl"; 7 -> sLit "%spl";
231 8 -> sLit "%r8b"; 9 -> sLit "%r9b";
232 10 -> sLit "%r10b"; 11 -> sLit "%r11b";
233 12 -> sLit "%r12b"; 13 -> sLit "%r13b";
234 14 -> sLit "%r14b"; 15 -> sLit "%r15b";
235 _ -> sLit "very naughty x86_64 byte register"
238 ppr_reg_word i = ptext
240 0 -> sLit "%ax"; 1 -> sLit "%bx";
241 2 -> sLit "%cx"; 3 -> sLit "%dx";
242 4 -> sLit "%si"; 5 -> sLit "%di";
243 6 -> sLit "%bp"; 7 -> sLit "%sp";
244 8 -> sLit "%r8w"; 9 -> sLit "%r9w";
245 10 -> sLit "%r10w"; 11 -> sLit "%r11w";
246 12 -> sLit "%r12w"; 13 -> sLit "%r13w";
247 14 -> sLit "%r14w"; 15 -> sLit "%r15w";
248 _ -> sLit "very naughty x86_64 word register"
251 ppr_reg_long i = ptext
253 0 -> sLit "%eax"; 1 -> sLit "%ebx";
254 2 -> sLit "%ecx"; 3 -> sLit "%edx";
255 4 -> sLit "%esi"; 5 -> sLit "%edi";
256 6 -> sLit "%ebp"; 7 -> sLit "%esp";
257 8 -> sLit "%r8d"; 9 -> sLit "%r9d";
258 10 -> sLit "%r10d"; 11 -> sLit "%r11d";
259 12 -> sLit "%r12d"; 13 -> sLit "%r13d";
260 14 -> sLit "%r14d"; 15 -> sLit "%r15d";
261 _ -> sLit "very naughty x86_64 register"
264 ppr_reg_quad i = ptext
266 0 -> sLit "%rax"; 1 -> sLit "%rbx";
267 2 -> sLit "%rcx"; 3 -> sLit "%rdx";
268 4 -> sLit "%rsi"; 5 -> sLit "%rdi";
269 6 -> sLit "%rbp"; 7 -> sLit "%rsp";
270 8 -> sLit "%r8"; 9 -> sLit "%r9";
271 10 -> sLit "%r10"; 11 -> sLit "%r11";
272 12 -> sLit "%r12"; 13 -> sLit "%r13";
273 14 -> sLit "%r14"; 15 -> sLit "%r15";
274 16 -> sLit "%xmm0"; 17 -> sLit "%xmm1";
275 18 -> sLit "%xmm2"; 19 -> sLit "%xmm3";
276 20 -> sLit "%xmm4"; 21 -> sLit "%xmm5";
277 22 -> sLit "%xmm6"; 23 -> sLit "%xmm7";
278 24 -> sLit "%xmm8"; 25 -> sLit "%xmm9";
279 26 -> sLit "%xmm10"; 27 -> sLit "%xmm11";
280 28 -> sLit "%xmm12"; 29 -> sLit "%xmm13";
281 30 -> sLit "%xmm14"; 31 -> sLit "%xmm15";
282 _ -> sLit "very naughty x86_64 register"
285 ppr_reg_no _ = panic "X86.Ppr.ppr_reg_no: no match"
289 pprSize :: Size -> Doc
300 #elif x86_64_TARGET_ARCH
301 FF32 -> sLit "ss" -- "scalar single-precision float" (SSE2)
302 FF64 -> sLit "sd" -- "scalar double-precision float" (SSE2)
303 _ -> panic "X86.Ppr.pprSize: no match"
305 _ -> panic "X86.Ppr.pprSize: no match"
309 pprCond :: Cond -> Doc
312 GEU -> sLit "ae"; LU -> sLit "b";
313 EQQ -> sLit "e"; GTT -> sLit "g";
314 GE -> sLit "ge"; GU -> sLit "a";
315 LTT -> sLit "l"; LE -> sLit "le";
316 LEU -> sLit "be"; NE -> sLit "ne";
317 NEG -> sLit "s"; POS -> sLit "ns";
318 CARRY -> sLit "c"; OFLO -> sLit "o";
319 PARITY -> sLit "p"; NOTPARITY -> sLit "np";
320 ALWAYS -> sLit "mp"})
324 pprImm (ImmInt i) = int i
325 pprImm (ImmInteger i) = integer i
326 pprImm (ImmCLbl l) = pprCLabel_asm l
327 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
328 pprImm (ImmLit s) = s
330 pprImm (ImmFloat _) = ptext (sLit "naughty float immediate")
331 pprImm (ImmDouble _) = ptext (sLit "naughty double immediate")
333 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
334 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
335 <> lparen <> pprImm b <> rparen
339 pprAddr :: AddrMode -> Doc
340 pprAddr (ImmAddr imm off)
341 = let pp_imm = pprImm imm
345 else if (off < 0) then
348 pp_imm <> char '+' <> int off
350 pprAddr (AddrBaseIndex base index displacement)
352 pp_disp = ppr_disp displacement
353 pp_off p = pp_disp <> char '(' <> p <> char ')'
354 pp_reg r = pprReg archWordSize r
356 case (base, index) of
357 (EABaseNone, EAIndexNone) -> pp_disp
358 (EABaseReg b, EAIndexNone) -> pp_off (pp_reg b)
359 (EABaseRip, EAIndexNone) -> pp_off (ptext (sLit "%rip"))
360 (EABaseNone, EAIndex r i) -> pp_off (comma <> pp_reg r <> comma <> int i)
361 (EABaseReg b, EAIndex r i) -> pp_off (pp_reg b <> comma <> pp_reg r
363 _ -> panic "X86.Ppr.pprAddr: no match"
366 ppr_disp (ImmInt 0) = empty
367 ppr_disp imm = pprImm imm
370 pprSectionHeader :: Section -> Doc
373 # if darwin_TARGET_OS
376 Text -> ptext (sLit ".text\n\t.align 2")
377 Data -> ptext (sLit ".data\n\t.align 2")
378 ReadOnlyData -> ptext (sLit ".const\n.align 2")
379 RelocatableReadOnlyData -> ptext (sLit ".const_data\n.align 2")
380 UninitialisedData -> ptext (sLit ".data\n\t.align 2")
381 ReadOnlyData16 -> ptext (sLit ".const\n.align 4")
382 OtherSection _ -> panic "X86.Ppr.pprSectionHeader: unknown section"
387 Text -> ptext (sLit ".text\n\t.align 4,0x90")
388 Data -> ptext (sLit ".data\n\t.align 4")
389 ReadOnlyData -> ptext (sLit ".section .rodata\n\t.align 4")
390 RelocatableReadOnlyData -> ptext (sLit ".section .data\n\t.align 4")
391 UninitialisedData -> ptext (sLit ".section .bss\n\t.align 4")
392 ReadOnlyData16 -> ptext (sLit ".section .rodata\n\t.align 16")
393 OtherSection _ -> panic "X86.Ppr.pprSectionHeader: unknown section"
397 #elif x86_64_TARGET_ARCH
398 # if darwin_TARGET_OS
401 Text -> ptext (sLit ".text\n.align 3")
402 Data -> ptext (sLit ".data\n.align 3")
403 ReadOnlyData -> ptext (sLit ".const\n.align 3")
404 RelocatableReadOnlyData -> ptext (sLit ".const_data\n.align 3")
405 UninitialisedData -> ptext (sLit ".data\n\t.align 3")
406 ReadOnlyData16 -> ptext (sLit ".const\n.align 4")
407 OtherSection _ -> panic "PprMach.pprSectionHeader: unknown section"
412 Text -> ptext (sLit ".text\n\t.align 8")
413 Data -> ptext (sLit ".data\n\t.align 8")
414 ReadOnlyData -> ptext (sLit ".section .rodata\n\t.align 8")
415 RelocatableReadOnlyData -> ptext (sLit ".section .data\n\t.align 8")
416 UninitialisedData -> ptext (sLit ".section .bss\n\t.align 8")
417 ReadOnlyData16 -> ptext (sLit ".section .rodata.cst16\n\t.align 16")
418 OtherSection _ -> panic "PprMach.pprSectionHeader: unknown section"
423 pprSectionHeader _ = panic "X86.Ppr.pprSectionHeader: not defined for this architecture"
430 pprDataItem :: CmmLit -> Doc
432 = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
436 -- These seem to be common:
437 ppr_item II8 _ = [ptext (sLit "\t.byte\t") <> pprImm imm]
438 ppr_item II32 _ = [ptext (sLit "\t.long\t") <> pprImm imm]
440 ppr_item FF32 (CmmFloat r _)
441 = let bs = floatToBytes (fromRational r)
442 in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
444 ppr_item FF64 (CmmFloat r _)
445 = let bs = doubleToBytes (fromRational r)
446 in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
448 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
449 ppr_item II16 _ = [ptext (sLit "\t.word\t") <> pprImm imm]
451 #if i386_TARGET_ARCH && darwin_TARGET_OS
452 ppr_item II64 (CmmInt x _) =
453 [ptext (sLit "\t.long\t")
454 <> int (fromIntegral (fromIntegral x :: Word32)),
455 ptext (sLit "\t.long\t")
457 (fromIntegral (x `shiftR` 32) :: Word32))]
459 #if i386_TARGET_ARCH || (darwin_TARGET_OS && x86_64_TARGET_ARCH)
460 ppr_item II64 _ = [ptext (sLit "\t.quad\t") <> pprImm imm]
462 #if x86_64_TARGET_ARCH && !darwin_TARGET_OS
463 -- x86_64: binutils can't handle the R_X86_64_PC64 relocation
464 -- type, which means we can't do pc-relative 64-bit addresses.
465 -- Fortunately we're assuming the small memory model, in which
466 -- all such offsets will fit into 32 bits, so we have to stick
467 -- to 32-bit offset fields and modify the RTS appropriately
469 -- See Note [x86-64-relative] in includes/rts/storage/InfoTables.h
472 | isRelativeReloc x =
473 [ptext (sLit "\t.long\t") <> pprImm imm,
474 ptext (sLit "\t.long\t0")]
476 [ptext (sLit "\t.quad\t") <> pprImm imm]
478 isRelativeReloc (CmmLabelDiffOff _ _ _) = True
479 isRelativeReloc _ = False
483 = panic "X86.Ppr.ppr_item: no match"
487 pprInstr :: Instr -> Doc
489 pprInstr (COMMENT _) = empty -- nuke 'em
492 = IF_ARCH_alpha( ((<>) (ptext (sLit "\t# ")) (ftext s))
493 ,IF_ARCH_sparc( ((<>) (ptext (sLit "# ")) (ftext s))
494 ,IF_ARCH_i386( ((<>) (ptext (sLit "# ")) (ftext s))
495 ,IF_ARCH_x86_64( ((<>) (ptext (sLit "# ")) (ftext s))
496 ,IF_ARCH_powerpc( IF_OS_linux(
497 ((<>) (ptext (sLit "# ")) (ftext s)),
498 ((<>) (ptext (sLit "; ")) (ftext s)))
502 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
504 pprInstr (NEWBLOCK _)
505 = panic "PprMach.pprInstr: NEWBLOCK"
508 = panic "PprMach.pprInstr: LDATA"
511 pprInstr (SPILL reg slot)
513 ptext (sLit "\tSPILL"),
517 ptext (sLit "SLOT") <> parens (int slot)]
519 pprInstr (RELOAD slot reg)
521 ptext (sLit "\tRELOAD"),
523 ptext (sLit "SLOT") <> parens (int slot),
528 pprInstr (MOV size src dst)
529 = pprSizeOpOp (sLit "mov") size src dst
531 pprInstr (MOVZxL II32 src dst) = pprSizeOpOp (sLit "mov") II32 src dst
532 -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
533 -- movl. But we represent it as a MOVZxL instruction, because
534 -- the reg alloc would tend to throw away a plain reg-to-reg
535 -- move, and we still want it to do that.
537 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce (sLit "movz") sizes II32 src dst
538 -- zero-extension only needs to extend to 32 bits: on x86_64,
539 -- the remaining zero-extension to 64 bits is automatic, and the 32-bit
540 -- instruction is shorter.
542 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce (sLit "movs") sizes archWordSize src dst
544 -- here we do some patching, since the physical registers are only set late
545 -- in the code generation.
546 pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
548 = pprSizeOpOp (sLit "add") size (OpReg reg2) dst
550 pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
552 = pprSizeOpOp (sLit "add") size (OpReg reg1) dst
554 pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
556 = pprInstr (ADD size (OpImm displ) dst)
558 pprInstr (LEA size src dst) = pprSizeOpOp (sLit "lea") size src dst
560 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
561 = pprSizeOp (sLit "dec") size dst
562 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
563 = pprSizeOp (sLit "inc") size dst
564 pprInstr (ADD size src dst)
565 = pprSizeOpOp (sLit "add") size src dst
566 pprInstr (ADC size src dst)
567 = pprSizeOpOp (sLit "adc") size src dst
568 pprInstr (SUB size src dst) = pprSizeOpOp (sLit "sub") size src dst
569 pprInstr (IMUL size op1 op2) = pprSizeOpOp (sLit "imul") size op1 op2
571 {- A hack. The Intel documentation says that "The two and three
572 operand forms [of IMUL] may also be used with unsigned operands
573 because the lower half of the product is the same regardless if
574 (sic) the operands are signed or unsigned. The CF and OF flags,
575 however, cannot be used to determine if the upper half of the
576 result is non-zero." So there.
578 pprInstr (AND size src dst) = pprSizeOpOp (sLit "and") size src dst
579 pprInstr (OR size src dst) = pprSizeOpOp (sLit "or") size src dst
581 pprInstr (XOR FF32 src dst) = pprOpOp (sLit "xorps") FF32 src dst
582 pprInstr (XOR FF64 src dst) = pprOpOp (sLit "xorpd") FF64 src dst
583 pprInstr (XOR size src dst) = pprSizeOpOp (sLit "xor") size src dst
585 pprInstr (NOT size op) = pprSizeOp (sLit "not") size op
586 pprInstr (NEGI size op) = pprSizeOp (sLit "neg") size op
588 pprInstr (SHL size src dst) = pprShift (sLit "shl") size src dst
589 pprInstr (SAR size src dst) = pprShift (sLit "sar") size src dst
590 pprInstr (SHR size src dst) = pprShift (sLit "shr") size src dst
592 pprInstr (BT size imm src) = pprSizeImmOp (sLit "bt") size imm src
594 pprInstr (CMP size src dst)
595 | is_float size = pprSizeOpOp (sLit "ucomi") size src dst -- SSE2
596 | otherwise = pprSizeOpOp (sLit "cmp") size src dst
598 -- This predicate is needed here and nowhere else
604 pprInstr (TEST size src dst) = pprSizeOpOp (sLit "test") size src dst
605 pprInstr (PUSH size op) = pprSizeOp (sLit "push") size op
606 pprInstr (POP size op) = pprSizeOp (sLit "pop") size op
608 -- both unused (SDM):
609 -- pprInstr PUSHA = ptext (sLit "\tpushal")
610 -- pprInstr POPA = ptext (sLit "\tpopal")
612 pprInstr NOP = ptext (sLit "\tnop")
613 pprInstr (CLTD II32) = ptext (sLit "\tcltd")
614 pprInstr (CLTD II64) = ptext (sLit "\tcqto")
616 pprInstr (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand II8 op)
618 pprInstr (JXX cond (BlockId id))
619 = pprCondInstr (sLit "j") cond (pprCLabel_asm lab)
620 where lab = mkAsmTempLabel id
622 pprInstr (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm imm)
624 pprInstr (JMP (OpImm imm)) = (<>) (ptext (sLit "\tjmp ")) (pprImm imm)
625 pprInstr (JMP op) = (<>) (ptext (sLit "\tjmp *")) (pprOperand archWordSize op)
626 pprInstr (JMP_TBL op _) = pprInstr (JMP op)
627 pprInstr (CALL (Left imm) _) = (<>) (ptext (sLit "\tcall ")) (pprImm imm)
628 pprInstr (CALL (Right reg) _) = (<>) (ptext (sLit "\tcall *")) (pprReg archWordSize reg)
630 pprInstr (IDIV sz op) = pprSizeOp (sLit "idiv") sz op
631 pprInstr (DIV sz op) = pprSizeOp (sLit "div") sz op
632 pprInstr (IMUL2 sz op) = pprSizeOp (sLit "imul") sz op
635 pprInstr (MUL size op1 op2) = pprSizeOpOp (sLit "mul") size op1 op2
637 pprInstr (FDIV size op1 op2) = pprSizeOpOp (sLit "div") size op1 op2
639 pprInstr (CVTSS2SD from to) = pprRegReg (sLit "cvtss2sd") from to
640 pprInstr (CVTSD2SS from to) = pprRegReg (sLit "cvtsd2ss") from to
641 pprInstr (CVTTSS2SIQ from to) = pprOpReg (sLit "cvttss2siq") from to
642 pprInstr (CVTTSD2SIQ from to) = pprOpReg (sLit "cvttsd2siq") from to
643 pprInstr (CVTSI2SS from to) = pprOpReg (sLit "cvtsi2ssq") from to
644 pprInstr (CVTSI2SD from to) = pprOpReg (sLit "cvtsi2sdq") from to
646 -- FETCHGOT for PIC on ELF platforms
647 pprInstr (FETCHGOT reg)
648 = vcat [ ptext (sLit "\tcall 1f"),
649 hcat [ ptext (sLit "1:\tpopl\t"), pprReg II32 reg ],
650 hcat [ ptext (sLit "\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
654 -- FETCHPC for PIC on Darwin/x86
655 -- get the instruction pointer into a register
656 -- (Terminology note: the IP is called Program Counter on PPC,
657 -- and it's a good thing to use the same name on both platforms)
658 pprInstr (FETCHPC reg)
659 = vcat [ ptext (sLit "\tcall 1f"),
660 hcat [ ptext (sLit "1:\tpopl\t"), pprReg II32 reg ]
664 -- -----------------------------------------------------------------------------
665 -- i386 floating-point
667 -- Simulating a flat register set on the x86 FP stack is tricky.
668 -- you have to free %st(7) before pushing anything on the FP reg stack
669 -- so as to preclude the possibility of a FP stack overflow exception.
670 pprInstr g@(GMOV src dst)
674 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
676 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
677 pprInstr g@(GLD sz addr dst)
678 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
679 pprAddr addr, gsemi, gpop dst 1])
681 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
682 pprInstr g@(GST sz src addr)
683 = pprG g (hcat [gtab, gpush src 0, gsemi,
684 text "fstp", pprSize sz, gsp, pprAddr addr])
686 pprInstr g@(GLDZ dst)
687 = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
688 pprInstr g@(GLD1 dst)
689 = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
691 pprInstr (GFTOI src dst)
692 = pprInstr (GDTOI src dst)
694 pprInstr g@(GDTOI src dst)
696 hcat [gtab, text "subl $8, %esp ; fnstcw 4(%esp)"],
697 hcat [gtab, gpush src 0],
698 hcat [gtab, text "movzwl 4(%esp), ", reg,
699 text " ; orl $0xC00, ", reg],
700 hcat [gtab, text "movl ", reg, text ", 0(%esp) ; fldcw 0(%esp)"],
701 hcat [gtab, text "fistpl 0(%esp)"],
702 hcat [gtab, text "fldcw 4(%esp) ; movl 0(%esp), ", reg],
703 hcat [gtab, text "addl $8, %esp"]
706 reg = pprReg II32 dst
708 pprInstr (GITOF src dst)
709 = pprInstr (GITOD src dst)
711 pprInstr g@(GITOD src dst)
712 = pprG g (hcat [gtab, text "pushl ", pprReg II32 src,
713 text " ; ffree %st(7); fildl (%esp) ; ",
714 gpop dst 1, text " ; addl $4,%esp"])
716 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
717 this far into the jungle AND you give a Rat's Ass (tm) what's going
718 on, here's the deal. Generate code to do a floating point comparison
719 of src1 and src2, of kind cond, and set the Zero flag if true.
721 The complications are to do with handling NaNs correctly. We want the
722 property that if either argument is NaN, then the result of the
723 comparison is False ... except if we're comparing for inequality,
724 in which case the answer is True.
726 Here's how the general (non-inequality) case works. As an
727 example, consider generating the an equality test:
729 pushl %eax -- we need to mess with this
730 <get src1 to top of FPU stack>
731 fcomp <src2 location in FPU stack> and pop pushed src1
732 -- Result of comparison is in FPU Status Register bits
734 fstsw %ax -- Move FPU Status Reg to %ax
735 sahf -- move C3 C2 C0 from %ax to integer flag reg
736 -- now the serious magic begins
737 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
738 sete %al -- %al = if arg1 == arg2 then 1 else 0
739 andb %ah,%al -- %al &= %ah
740 -- so %al == 1 iff (comparable && same); else it holds 0
741 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
742 else %al == 0xFF, ZeroFlag=0
743 -- the zero flag is now set as we desire.
746 The special case of inequality differs thusly:
748 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
749 setne %al -- %al = if arg1 /= arg2 then 1 else 0
750 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
751 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
752 else (%al == 0xFF, ZF=0)
754 pprInstr g@(GCMP cond src1 src2)
755 | case cond of { NE -> True; _ -> False }
757 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
758 hcat [gtab, text "fcomp ", greg src2 1,
759 text "; fstsw %ax ; sahf ; setpe %ah"],
760 hcat [gtab, text "setne %al ; ",
761 text "orb %ah,%al ; decb %al ; popl %eax"]
765 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
766 hcat [gtab, text "fcomp ", greg src2 1,
767 text "; fstsw %ax ; sahf ; setpo %ah"],
768 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
769 text "andb %ah,%al ; decb %al ; popl %eax"]
772 {- On the 486, the flags set by FP compare are the unsigned ones!
773 (This looks like a HACK to me. WDP 96/03)
775 fix_FP_cond :: Cond -> Cond
780 fix_FP_cond EQQ = EQQ
782 fix_FP_cond _ = panic "X86.Ppr.fix_FP_cond: no match"
783 -- there should be no others
786 pprInstr g@(GABS _ src dst)
787 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
789 pprInstr g@(GNEG _ src dst)
790 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
792 pprInstr g@(GSQRT sz src dst)
793 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
794 hcat [gtab, gcoerceto sz, gpop dst 1])
796 pprInstr g@(GSIN sz l1 l2 src dst)
797 = pprG g (pprTrigOp "fsin" False l1 l2 src dst sz)
799 pprInstr g@(GCOS sz l1 l2 src dst)
800 = pprG g (pprTrigOp "fcos" False l1 l2 src dst sz)
802 pprInstr g@(GTAN sz l1 l2 src dst)
803 = pprG g (pprTrigOp "fptan" True l1 l2 src dst sz)
805 -- In the translations for GADD, GMUL, GSUB and GDIV,
806 -- the first two cases are mere optimisations. The otherwise clause
807 -- generates correct code under all circumstances.
809 pprInstr g@(GADD _ src1 src2 dst)
811 = pprG g (text "\t#GADD-xxxcase1" $$
812 hcat [gtab, gpush src2 0,
813 text " ; faddp %st(0),", greg src1 1])
815 = pprG g (text "\t#GADD-xxxcase2" $$
816 hcat [gtab, gpush src1 0,
817 text " ; faddp %st(0),", greg src2 1])
819 = pprG g (hcat [gtab, gpush src1 0,
820 text " ; fadd ", greg src2 1, text ",%st(0)",
824 pprInstr g@(GMUL _ src1 src2 dst)
826 = pprG g (text "\t#GMUL-xxxcase1" $$
827 hcat [gtab, gpush src2 0,
828 text " ; fmulp %st(0),", greg src1 1])
830 = pprG g (text "\t#GMUL-xxxcase2" $$
831 hcat [gtab, gpush src1 0,
832 text " ; fmulp %st(0),", greg src2 1])
834 = pprG g (hcat [gtab, gpush src1 0,
835 text " ; fmul ", greg src2 1, text ",%st(0)",
839 pprInstr g@(GSUB _ src1 src2 dst)
841 = pprG g (text "\t#GSUB-xxxcase1" $$
842 hcat [gtab, gpush src2 0,
843 text " ; fsubrp %st(0),", greg src1 1])
845 = pprG g (text "\t#GSUB-xxxcase2" $$
846 hcat [gtab, gpush src1 0,
847 text " ; fsubp %st(0),", greg src2 1])
849 = pprG g (hcat [gtab, gpush src1 0,
850 text " ; fsub ", greg src2 1, text ",%st(0)",
854 pprInstr g@(GDIV _ src1 src2 dst)
856 = pprG g (text "\t#GDIV-xxxcase1" $$
857 hcat [gtab, gpush src2 0,
858 text " ; fdivrp %st(0),", greg src1 1])
860 = pprG g (text "\t#GDIV-xxxcase2" $$
861 hcat [gtab, gpush src1 0,
862 text " ; fdivp %st(0),", greg src2 1])
864 = pprG g (hcat [gtab, gpush src1 0,
865 text " ; fdiv ", greg src2 1, text ",%st(0)",
870 = vcat [ ptext (sLit "\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
871 ptext (sLit "\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
875 = panic "X86.Ppr.pprInstr: no match"
878 pprTrigOp :: String -> Bool -> CLabel -> CLabel -> Reg -> Reg -> Size -> Doc
879 pprTrigOp op -- fsin, fcos or fptan
880 isTan -- we need a couple of extra steps if we're doing tan
881 l1 l2 -- internal labels for us to use
883 = -- We'll be needing %eax later on
884 hcat [gtab, text "pushl %eax;"] $$
885 -- tan is going to use an extra space on the FP stack
886 (if isTan then hcat [gtab, text "ffree %st(6)"] else empty) $$
887 -- First put the value in %st(0) and try to apply the op to it
888 hcat [gpush src 0, text ("; " ++ op)] $$
889 -- Now look to see if C2 was set (overflow, |value| >= 2^63)
890 hcat [gtab, text "fnstsw %ax"] $$
891 hcat [gtab, text "test $0x400,%eax"] $$
892 -- If we were in bounds then jump to the end
893 hcat [gtab, text "je " <> pprCLabel_asm l1] $$
894 -- Otherwise we need to shrink the value. Start by
895 -- loading pi, doubleing it (by adding it to itself),
896 -- and then swapping pi with the value, so the value we
897 -- want to apply op to is in %st(0) again
898 hcat [gtab, text "ffree %st(7); fldpi"] $$
899 hcat [gtab, text "fadd %st(0),%st"] $$
900 hcat [gtab, text "fxch %st(1)"] $$
901 -- Now we have a loop in which we make the value smaller,
902 -- see if it's small enough, and loop if not
903 (pprCLabel_asm l2 <> char ':') $$
904 hcat [gtab, text "fprem1"] $$
905 -- My Debian libc uses fstsw here for the tan code, but I can't
906 -- see any reason why it should need to be different for tan.
907 hcat [gtab, text "fnstsw %ax"] $$
908 hcat [gtab, text "test $0x400,%eax"] $$
909 hcat [gtab, text "jne " <> pprCLabel_asm l2] $$
910 hcat [gtab, text "fstp %st(1)"] $$
911 hcat [gtab, text op] $$
912 (pprCLabel_asm l1 <> char ':') $$
913 -- Pop the 1.0 tan gave us
914 (if isTan then hcat [gtab, text "fstp %st(0)"] else empty) $$
916 hcat [gtab, text "popl %eax;"] $$
917 -- And finally make the result the right size
918 hcat [gtab, gcoerceto sz, gpop dst 1]
920 --------------------------
922 -- coerce %st(0) to the specified size
923 gcoerceto :: Size -> Doc
924 gcoerceto FF64 = empty
925 gcoerceto FF32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
926 gcoerceto _ = panic "X86.Ppr.gcoerceto: no match"
928 gpush :: Reg -> RegNo -> Doc
930 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
933 gpop :: Reg -> RegNo -> Doc
935 = hcat [text "fstp ", greg reg offset]
937 greg :: Reg -> RegNo -> Doc
938 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
949 gregno :: Reg -> RegNo
950 gregno (RegReal (RealRegSingle i)) = i
951 gregno _ = --pprPanic "gregno" (ppr other)
952 999 -- bogus; only needed for debug printing
954 pprG :: Instr -> Doc -> Doc
956 = (char '#' <> pprGInstr fake) $$ actual
959 pprGInstr :: Instr -> Doc
960 pprGInstr (GMOV src dst) = pprSizeRegReg (sLit "gmov") FF64 src dst
961 pprGInstr (GLD sz src dst) = pprSizeAddrReg (sLit "gld") sz src dst
962 pprGInstr (GST sz src dst) = pprSizeRegAddr (sLit "gst") sz src dst
964 pprGInstr (GLDZ dst) = pprSizeReg (sLit "gldz") FF64 dst
965 pprGInstr (GLD1 dst) = pprSizeReg (sLit "gld1") FF64 dst
967 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg (sLit "gftoi") FF32 II32 src dst
968 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg (sLit "gdtoi") FF64 II32 src dst
970 pprGInstr (GITOF src dst) = pprSizeSizeRegReg (sLit "gitof") II32 FF32 src dst
971 pprGInstr (GITOD src dst) = pprSizeSizeRegReg (sLit "gitod") II32 FF64 src dst
973 pprGInstr (GCMP co src dst) = pprCondRegReg (sLit "gcmp_") FF64 co src dst
974 pprGInstr (GABS sz src dst) = pprSizeRegReg (sLit "gabs") sz src dst
975 pprGInstr (GNEG sz src dst) = pprSizeRegReg (sLit "gneg") sz src dst
976 pprGInstr (GSQRT sz src dst) = pprSizeRegReg (sLit "gsqrt") sz src dst
977 pprGInstr (GSIN sz _ _ src dst) = pprSizeRegReg (sLit "gsin") sz src dst
978 pprGInstr (GCOS sz _ _ src dst) = pprSizeRegReg (sLit "gcos") sz src dst
979 pprGInstr (GTAN sz _ _ src dst) = pprSizeRegReg (sLit "gtan") sz src dst
981 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg (sLit "gadd") sz src1 src2 dst
982 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg (sLit "gsub") sz src1 src2 dst
983 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg (sLit "gmul") sz src1 src2 dst
984 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg (sLit "gdiv") sz src1 src2 dst
986 pprGInstr _ = panic "X86.Ppr.pprGInstr: no match"
988 pprDollImm :: Imm -> Doc
989 pprDollImm i = ptext (sLit "$") <> pprImm i
992 pprOperand :: Size -> Operand -> Doc
993 pprOperand s (OpReg r) = pprReg s r
994 pprOperand _ (OpImm i) = pprDollImm i
995 pprOperand _ (OpAddr ea) = pprAddr ea
998 pprMnemonic_ :: LitString -> Doc
1000 char '\t' <> ptext name <> space
1003 pprMnemonic :: LitString -> Size -> Doc
1004 pprMnemonic name size =
1005 char '\t' <> ptext name <> pprSize size <> space
1008 pprSizeImmOp :: LitString -> Size -> Imm -> Operand -> Doc
1009 pprSizeImmOp name size imm op1
1011 pprMnemonic name size,
1019 pprSizeOp :: LitString -> Size -> Operand -> Doc
1020 pprSizeOp name size op1
1022 pprMnemonic name size,
1027 pprSizeOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1028 pprSizeOpOp name size op1 op2
1030 pprMnemonic name size,
1031 pprOperand size op1,
1037 pprOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1038 pprOpOp name size op1 op2
1041 pprOperand size op1,
1047 pprSizeReg :: LitString -> Size -> Reg -> Doc
1048 pprSizeReg name size reg1
1050 pprMnemonic name size,
1055 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
1056 pprSizeRegReg name size reg1 reg2
1058 pprMnemonic name size,
1065 pprRegReg :: LitString -> Reg -> Reg -> Doc
1066 pprRegReg name reg1 reg2
1069 pprReg archWordSize reg1,
1071 pprReg archWordSize reg2
1075 pprOpReg :: LitString -> Operand -> Reg -> Doc
1076 pprOpReg name op1 reg2
1079 pprOperand archWordSize op1,
1081 pprReg archWordSize reg2
1085 pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> Doc
1086 pprCondRegReg name size cond reg1 reg2
1097 pprSizeSizeRegReg :: LitString -> Size -> Size -> Reg -> Reg -> Doc
1098 pprSizeSizeRegReg name size1 size2 reg1 reg2
1112 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1113 pprSizeRegRegReg name size reg1 reg2 reg3
1115 pprMnemonic name size,
1124 pprSizeAddrReg :: LitString -> Size -> AddrMode -> Reg -> Doc
1125 pprSizeAddrReg name size op dst
1127 pprMnemonic name size,
1134 pprSizeRegAddr :: LitString -> Size -> Reg -> AddrMode -> Doc
1135 pprSizeRegAddr name size src op
1137 pprMnemonic name size,
1144 pprShift :: LitString -> Size -> Operand -> Operand -> Doc
1145 pprShift name size src dest
1147 pprMnemonic name size,
1148 pprOperand II8 src, -- src is 8-bit sized
1150 pprOperand size dest
1154 pprSizeOpOpCoerce :: LitString -> Size -> Size -> Operand -> Operand -> Doc
1155 pprSizeOpOpCoerce name size1 size2 op1 op2
1156 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1157 pprOperand size1 op1,
1159 pprOperand size2 op2
1163 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1164 pprCondInstr name cond arg
1165 = hcat [ char '\t', ptext name, pprCond cond, space, arg]