7809ae1df93a15af86b393bf5bf7f64f62258d46
[ghc.git] / compiler / nativeGen / X86 / Ppr.hs
1 {-# LANGUAGE CPP #-}
2
3 -----------------------------------------------------------------------------
4 --
5 -- Pretty-printing assembly language
6 --
7 -- (c) The University of Glasgow 1993-2005
8 --
9 -----------------------------------------------------------------------------
10
11 {-# OPTIONS_GHC -fno-warn-orphans #-}
12 module X86.Ppr (
13 pprNatCmmDecl,
14 pprData,
15 pprInstr,
16 pprFormat,
17 pprImm,
18 pprDataItem,
19 )
20
21 where
22
23 #include "HsVersions.h"
24 #include "nativeGen/NCG.h"
25
26 import X86.Regs
27 import X86.Instr
28 import X86.Cond
29 import Instruction
30 import Format
31 import Reg
32 import PprBase
33
34
35 import BlockId
36 import BasicTypes (Alignment)
37 import DynFlags
38 import Cmm hiding (topInfoTable)
39 import CLabel
40 import Unique ( pprUnique, Uniquable(..) )
41 import Platform
42 import FastString
43 import Outputable
44
45 import Data.Word
46
47 import Data.Bits
48
49 -- -----------------------------------------------------------------------------
50 -- Printing this stuff out
51
52 pprNatCmmDecl :: NatCmmDecl (Alignment, CmmStatics) Instr -> SDoc
53 pprNatCmmDecl (CmmData section dats) =
54 pprSectionAlign section $$ pprDatas dats
55
56 pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
57 sdocWithDynFlags $ \dflags ->
58 case topInfoTable proc of
59 Nothing ->
60 case blocks of
61 [] -> -- special case for split markers:
62 pprLabel lbl
63 blocks -> -- special case for code without info table:
64 pprSectionAlign (Section Text lbl) $$
65 pprLabel lbl $$ -- blocks guaranteed not null, so label needed
66 vcat (map (pprBasicBlock top_info) blocks) $$
67 (if debugLevel dflags > 0
68 then ppr (mkAsmTempEndLabel lbl) <> char ':' else empty) $$
69 pprSizeDecl lbl
70
71 Just (Statics info_lbl _) ->
72 sdocWithPlatform $ \platform ->
73 pprSectionAlign (Section Text info_lbl) $$
74 (if platformHasSubsectionsViaSymbols platform
75 then ppr (mkDeadStripPreventer info_lbl) <> char ':'
76 else empty) $$
77 vcat (map (pprBasicBlock top_info) blocks) $$
78 -- above: Even the first block gets a label, because with branch-chain
79 -- elimination, it might be the target of a goto.
80 (if platformHasSubsectionsViaSymbols platform
81 then -- See Note [Subsections Via Symbols]
82 text "\t.long "
83 <+> ppr info_lbl
84 <+> char '-'
85 <+> ppr (mkDeadStripPreventer info_lbl)
86 else empty) $$
87 (if debugLevel dflags > 0
88 then ppr (mkAsmTempEndLabel info_lbl) <> char ':' else empty) $$
89 pprSizeDecl info_lbl
90
91 -- | Output the ELF .size directive.
92 pprSizeDecl :: CLabel -> SDoc
93 pprSizeDecl lbl
94 = sdocWithPlatform $ \platform ->
95 if osElfTarget (platformOS platform)
96 then text "\t.size" <+> ppr lbl <> ptext (sLit ", .-") <> ppr lbl
97 else empty
98
99 pprBasicBlock :: BlockEnv CmmStatics -> NatBasicBlock Instr -> SDoc
100 pprBasicBlock info_env (BasicBlock blockid instrs)
101 = sdocWithDynFlags $ \dflags ->
102 maybe_infotable $$
103 pprLabel asmLbl $$
104 vcat (map pprInstr instrs) $$
105 (if debugLevel dflags > 0
106 then ppr (mkAsmTempEndLabel asmLbl) <> char ':' else empty)
107 where
108 asmLbl = mkAsmTempLabel (getUnique blockid)
109 maybe_infotable = case mapLookup blockid info_env of
110 Nothing -> empty
111 Just (Statics info_lbl info) ->
112 pprAlignForSection Text $$
113 infoTableLoc $$
114 vcat (map pprData info) $$
115 pprLabel info_lbl
116 -- Make sure the info table has the right .loc for the block
117 -- coming right after it. See [Note: Info Offset]
118 infoTableLoc = case instrs of
119 (l@LOCATION{} : _) -> pprInstr l
120 _other -> empty
121
122 pprDatas :: (Alignment, CmmStatics) -> SDoc
123 pprDatas (align, (Statics lbl dats))
124 = vcat (pprAlign align : pprLabel lbl : map pprData dats)
125 -- TODO: could remove if align == 1
126
127 pprData :: CmmStatic -> SDoc
128 pprData (CmmString str) = pprASCII str
129
130 pprData (CmmUninitialised bytes)
131 = sdocWithPlatform $ \platform ->
132 if platformOS platform == OSDarwin then text ".space " <> int bytes
133 else text ".skip " <> int bytes
134
135 pprData (CmmStaticLit lit) = pprDataItem lit
136
137 pprGloblDecl :: CLabel -> SDoc
138 pprGloblDecl lbl
139 | not (externallyVisibleCLabel lbl) = empty
140 | otherwise = text ".globl " <> ppr lbl
141
142 pprTypeAndSizeDecl :: CLabel -> SDoc
143 pprTypeAndSizeDecl lbl
144 = sdocWithPlatform $ \platform ->
145 if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl
146 then text ".type " <> ppr lbl <> ptext (sLit ", @object")
147 else empty
148
149 pprLabel :: CLabel -> SDoc
150 pprLabel lbl = pprGloblDecl lbl
151 $$ pprTypeAndSizeDecl lbl
152 $$ (ppr lbl <> char ':')
153
154
155 pprASCII :: [Word8] -> SDoc
156 pprASCII str
157 = vcat (map do1 str) $$ do1 0
158 where
159 do1 :: Word8 -> SDoc
160 do1 w = text "\t.byte\t" <> int (fromIntegral w)
161
162 pprAlign :: Int -> SDoc
163 pprAlign bytes
164 = sdocWithPlatform $ \platform ->
165 text ".align " <> int (alignment platform)
166 where
167 alignment platform = if platformOS platform == OSDarwin
168 then log2 bytes
169 else bytes
170
171 log2 :: Int -> Int -- cache the common ones
172 log2 1 = 0
173 log2 2 = 1
174 log2 4 = 2
175 log2 8 = 3
176 log2 n = 1 + log2 (n `quot` 2)
177
178 -- -----------------------------------------------------------------------------
179 -- pprInstr: print an 'Instr'
180
181 instance Outputable Instr where
182 ppr instr = pprInstr instr
183
184
185 pprReg :: Format -> Reg -> SDoc
186 pprReg f r
187 = case r of
188 RegReal (RealRegSingle i) ->
189 sdocWithPlatform $ \platform ->
190 if target32Bit platform then ppr32_reg_no f i
191 else ppr64_reg_no f i
192 RegReal (RealRegPair _ _) -> panic "X86.Ppr: no reg pairs on this arch"
193 RegVirtual (VirtualRegI u) -> text "%vI_" <> pprUnique u
194 RegVirtual (VirtualRegHi u) -> text "%vHi_" <> pprUnique u
195 RegVirtual (VirtualRegF u) -> text "%vF_" <> pprUnique u
196 RegVirtual (VirtualRegD u) -> text "%vD_" <> pprUnique u
197 RegVirtual (VirtualRegSSE u) -> text "%vSSE_" <> pprUnique u
198 where
199 ppr32_reg_no :: Format -> Int -> SDoc
200 ppr32_reg_no II8 = ppr32_reg_byte
201 ppr32_reg_no II16 = ppr32_reg_word
202 ppr32_reg_no _ = ppr32_reg_long
203
204 ppr32_reg_byte i = ptext
205 (case i of {
206 0 -> sLit "%al"; 1 -> sLit "%bl";
207 2 -> sLit "%cl"; 3 -> sLit "%dl";
208 _ -> sLit "very naughty I386 byte register"
209 })
210
211 ppr32_reg_word i = ptext
212 (case i of {
213 0 -> sLit "%ax"; 1 -> sLit "%bx";
214 2 -> sLit "%cx"; 3 -> sLit "%dx";
215 4 -> sLit "%si"; 5 -> sLit "%di";
216 6 -> sLit "%bp"; 7 -> sLit "%sp";
217 _ -> sLit "very naughty I386 word register"
218 })
219
220 ppr32_reg_long i = ptext
221 (case i of {
222 0 -> sLit "%eax"; 1 -> sLit "%ebx";
223 2 -> sLit "%ecx"; 3 -> sLit "%edx";
224 4 -> sLit "%esi"; 5 -> sLit "%edi";
225 6 -> sLit "%ebp"; 7 -> sLit "%esp";
226 _ -> ppr_reg_float i
227 })
228
229 ppr64_reg_no :: Format -> Int -> SDoc
230 ppr64_reg_no II8 = ppr64_reg_byte
231 ppr64_reg_no II16 = ppr64_reg_word
232 ppr64_reg_no II32 = ppr64_reg_long
233 ppr64_reg_no _ = ppr64_reg_quad
234
235 ppr64_reg_byte i = ptext
236 (case i of {
237 0 -> sLit "%al"; 1 -> sLit "%bl";
238 2 -> sLit "%cl"; 3 -> sLit "%dl";
239 4 -> sLit "%sil"; 5 -> sLit "%dil"; -- new 8-bit regs!
240 6 -> sLit "%bpl"; 7 -> sLit "%spl";
241 8 -> sLit "%r8b"; 9 -> sLit "%r9b";
242 10 -> sLit "%r10b"; 11 -> sLit "%r11b";
243 12 -> sLit "%r12b"; 13 -> sLit "%r13b";
244 14 -> sLit "%r14b"; 15 -> sLit "%r15b";
245 _ -> sLit "very naughty x86_64 byte register"
246 })
247
248 ppr64_reg_word i = ptext
249 (case i of {
250 0 -> sLit "%ax"; 1 -> sLit "%bx";
251 2 -> sLit "%cx"; 3 -> sLit "%dx";
252 4 -> sLit "%si"; 5 -> sLit "%di";
253 6 -> sLit "%bp"; 7 -> sLit "%sp";
254 8 -> sLit "%r8w"; 9 -> sLit "%r9w";
255 10 -> sLit "%r10w"; 11 -> sLit "%r11w";
256 12 -> sLit "%r12w"; 13 -> sLit "%r13w";
257 14 -> sLit "%r14w"; 15 -> sLit "%r15w";
258 _ -> sLit "very naughty x86_64 word register"
259 })
260
261 ppr64_reg_long i = ptext
262 (case i of {
263 0 -> sLit "%eax"; 1 -> sLit "%ebx";
264 2 -> sLit "%ecx"; 3 -> sLit "%edx";
265 4 -> sLit "%esi"; 5 -> sLit "%edi";
266 6 -> sLit "%ebp"; 7 -> sLit "%esp";
267 8 -> sLit "%r8d"; 9 -> sLit "%r9d";
268 10 -> sLit "%r10d"; 11 -> sLit "%r11d";
269 12 -> sLit "%r12d"; 13 -> sLit "%r13d";
270 14 -> sLit "%r14d"; 15 -> sLit "%r15d";
271 _ -> sLit "very naughty x86_64 register"
272 })
273
274 ppr64_reg_quad i = ptext
275 (case i of {
276 0 -> sLit "%rax"; 1 -> sLit "%rbx";
277 2 -> sLit "%rcx"; 3 -> sLit "%rdx";
278 4 -> sLit "%rsi"; 5 -> sLit "%rdi";
279 6 -> sLit "%rbp"; 7 -> sLit "%rsp";
280 8 -> sLit "%r8"; 9 -> sLit "%r9";
281 10 -> sLit "%r10"; 11 -> sLit "%r11";
282 12 -> sLit "%r12"; 13 -> sLit "%r13";
283 14 -> sLit "%r14"; 15 -> sLit "%r15";
284 _ -> ppr_reg_float i
285 })
286
287 ppr_reg_float :: Int -> LitString
288 ppr_reg_float i = case i of
289 16 -> sLit "%fake0"; 17 -> sLit "%fake1"
290 18 -> sLit "%fake2"; 19 -> sLit "%fake3"
291 20 -> sLit "%fake4"; 21 -> sLit "%fake5"
292 24 -> sLit "%xmm0"; 25 -> sLit "%xmm1"
293 26 -> sLit "%xmm2"; 27 -> sLit "%xmm3"
294 28 -> sLit "%xmm4"; 29 -> sLit "%xmm5"
295 30 -> sLit "%xmm6"; 31 -> sLit "%xmm7"
296 32 -> sLit "%xmm8"; 33 -> sLit "%xmm9"
297 34 -> sLit "%xmm10"; 35 -> sLit "%xmm11"
298 36 -> sLit "%xmm12"; 37 -> sLit "%xmm13"
299 38 -> sLit "%xmm14"; 39 -> sLit "%xmm15"
300 _ -> sLit "very naughty x86 register"
301
302 pprFormat :: Format -> SDoc
303 pprFormat x
304 = ptext (case x of
305 II8 -> sLit "b"
306 II16 -> sLit "w"
307 II32 -> sLit "l"
308 II64 -> sLit "q"
309 FF32 -> sLit "ss" -- "scalar single-precision float" (SSE2)
310 FF64 -> sLit "sd" -- "scalar double-precision float" (SSE2)
311 FF80 -> sLit "t"
312 )
313
314 pprFormat_x87 :: Format -> SDoc
315 pprFormat_x87 x
316 = ptext $ case x of
317 FF32 -> sLit "s"
318 FF64 -> sLit "l"
319 FF80 -> sLit "t"
320 _ -> panic "X86.Ppr.pprFormat_x87"
321
322 pprCond :: Cond -> SDoc
323 pprCond c
324 = ptext (case c of {
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"})
334
335
336 pprImm :: Imm -> SDoc
337 pprImm (ImmInt i) = int i
338 pprImm (ImmInteger i) = integer i
339 pprImm (ImmCLbl l) = ppr l
340 pprImm (ImmIndex l i) = ppr l <> char '+' <> int i
341 pprImm (ImmLit s) = s
342
343 pprImm (ImmFloat _) = text "naughty float immediate"
344 pprImm (ImmDouble _) = text "naughty double immediate"
345
346 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
347 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
348 <> lparen <> pprImm b <> rparen
349
350
351
352 pprAddr :: AddrMode -> SDoc
353 pprAddr (ImmAddr imm off)
354 = let pp_imm = pprImm imm
355 in
356 if (off == 0) then
357 pp_imm
358 else if (off < 0) then
359 pp_imm <> int off
360 else
361 pp_imm <> char '+' <> int off
362
363 pprAddr (AddrBaseIndex base index displacement)
364 = sdocWithPlatform $ \platform ->
365 let
366 pp_disp = ppr_disp displacement
367 pp_off p = pp_disp <> char '(' <> p <> char ')'
368 pp_reg r = pprReg (archWordFormat (target32Bit platform)) r
369 in
370 case (base, index) of
371 (EABaseNone, EAIndexNone) -> pp_disp
372 (EABaseReg b, EAIndexNone) -> pp_off (pp_reg b)
373 (EABaseRip, EAIndexNone) -> pp_off (text "%rip")
374 (EABaseNone, EAIndex r i) -> pp_off (comma <> pp_reg r <> comma <> int i)
375 (EABaseReg b, EAIndex r i) -> pp_off (pp_reg b <> comma <> pp_reg r
376 <> comma <> int i)
377 _ -> panic "X86.Ppr.pprAddr: no match"
378
379 where
380 ppr_disp (ImmInt 0) = empty
381 ppr_disp imm = pprImm imm
382
383 -- | Print section header and appropriate alignment for that section.
384 pprSectionAlign :: Section -> SDoc
385 pprSectionAlign (Section (OtherSection _) _) =
386 panic "X86.Ppr.pprSectionAlign: unknown section"
387 pprSectionAlign sec@(Section seg _) =
388 sdocWithPlatform $ \platform ->
389 pprSectionHeader platform sec $$
390 pprAlignForSection seg
391
392 -- | Print appropriate alignment for the given section type.
393 pprAlignForSection :: SectionType -> SDoc
394 pprAlignForSection seg =
395 sdocWithPlatform $ \platform ->
396 text ".align " <>
397 case platformOS platform of
398 -- Darwin: alignments are given as shifts.
399 OSDarwin
400 | target32Bit platform ->
401 case seg of
402 ReadOnlyData16 -> int 4
403 _ -> int 2
404 | otherwise ->
405 case seg of
406 ReadOnlyData16 -> int 4
407 _ -> int 3
408 -- Other: alignments are given as bytes.
409 _
410 | target32Bit platform ->
411 case seg of
412 Text -> text "4,0x90"
413 ReadOnlyData16 -> int 16
414 _ -> int 4
415 | otherwise ->
416 case seg of
417 ReadOnlyData16 -> int 16
418 _ -> int 8
419
420 pprDataItem :: CmmLit -> SDoc
421 pprDataItem lit = sdocWithDynFlags $ \dflags -> pprDataItem' dflags lit
422
423 pprDataItem' :: DynFlags -> CmmLit -> SDoc
424 pprDataItem' dflags lit
425 = vcat (ppr_item (cmmTypeFormat $ cmmLitType dflags lit) lit)
426 where
427 platform = targetPlatform dflags
428 imm = litToImm lit
429
430 -- These seem to be common:
431 ppr_item II8 _ = [text "\t.byte\t" <> pprImm imm]
432 ppr_item II16 _ = [text "\t.word\t" <> pprImm imm]
433 ppr_item II32 _ = [text "\t.long\t" <> pprImm imm]
434
435 ppr_item FF32 (CmmFloat r _)
436 = let bs = floatToBytes (fromRational r)
437 in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
438
439 ppr_item FF64 (CmmFloat r _)
440 = let bs = doubleToBytes (fromRational r)
441 in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
442
443 ppr_item II64 _
444 = case platformOS platform of
445 OSDarwin
446 | target32Bit platform ->
447 case lit of
448 CmmInt x _ ->
449 [text "\t.long\t"
450 <> int (fromIntegral (fromIntegral x :: Word32)),
451 text "\t.long\t"
452 <> int (fromIntegral
453 (fromIntegral (x `shiftR` 32) :: Word32))]
454 _ -> panic "X86.Ppr.ppr_item: no match for II64"
455 | otherwise ->
456 [text "\t.quad\t" <> pprImm imm]
457 _
458 | target32Bit platform ->
459 [text "\t.quad\t" <> pprImm imm]
460 | otherwise ->
461 -- x86_64: binutils can't handle the R_X86_64_PC64
462 -- relocation type, which means we can't do
463 -- pc-relative 64-bit addresses. Fortunately we're
464 -- assuming the small memory model, in which all such
465 -- offsets will fit into 32 bits, so we have to stick
466 -- to 32-bit offset fields and modify the RTS
467 -- appropriately
468 --
469 -- See Note [x86-64-relative] in includes/rts/storage/InfoTables.h
470 --
471 case lit of
472 -- A relative relocation:
473 CmmLabelDiffOff _ _ _ ->
474 [text "\t.long\t" <> pprImm imm,
475 text "\t.long\t0"]
476 _ ->
477 [text "\t.quad\t" <> pprImm imm]
478
479 ppr_item _ _
480 = panic "X86.Ppr.ppr_item: no match"
481
482
483
484 pprInstr :: Instr -> SDoc
485
486 pprInstr (COMMENT _) = empty -- nuke 'em
487 {-
488 pprInstr (COMMENT s) = text "# " <> ftext s
489 -}
490
491 pprInstr (LOCATION file line col _name)
492 = text "\t.loc " <> ppr file <+> ppr line <+> ppr col
493
494 pprInstr (DELTA d)
495 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
496
497 pprInstr (NEWBLOCK _)
498 = panic "PprMach.pprInstr: NEWBLOCK"
499
500 pprInstr (LDATA _ _)
501 = panic "PprMach.pprInstr: LDATA"
502
503 {-
504 pprInstr (SPILL reg slot)
505 = hcat [
506 text "\tSPILL",
507 char ' ',
508 pprUserReg reg,
509 comma,
510 text "SLOT" <> parens (int slot)]
511
512 pprInstr (RELOAD slot reg)
513 = hcat [
514 text "\tRELOAD",
515 char ' ',
516 text "SLOT" <> parens (int slot),
517 comma,
518 pprUserReg reg]
519 -}
520
521 -- Replace 'mov $0x0,%reg' by 'xor %reg,%reg', which is smaller and cheaper.
522 -- The code generator catches most of these already, but not all.
523 pprInstr (MOV format (OpImm (ImmInt 0)) dst@(OpReg _))
524 = pprInstr (XOR format' dst dst)
525 where format' = case format of
526 II64 -> II32 -- 32-bit version is equivalent, and smaller
527 _ -> format
528 pprInstr (MOV format src dst)
529 = pprFormatOpOp (sLit "mov") format src dst
530
531 pprInstr (CMOV cc format src dst)
532 = pprCondOpReg (sLit "cmov") format cc src dst
533
534 pprInstr (MOVZxL II32 src dst) = pprFormatOpOp (sLit "mov") II32 src dst
535 -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
536 -- movl. But we represent it as a MOVZxL instruction, because
537 -- the reg alloc would tend to throw away a plain reg-to-reg
538 -- move, and we still want it to do that.
539
540 pprInstr (MOVZxL formats src dst)
541 = pprFormatOpOpCoerce (sLit "movz") formats II32 src dst
542 -- zero-extension only needs to extend to 32 bits: on x86_64,
543 -- the remaining zero-extension to 64 bits is automatic, and the 32-bit
544 -- instruction is shorter.
545
546 pprInstr (MOVSxL formats src dst)
547 = sdocWithPlatform $ \platform ->
548 pprFormatOpOpCoerce (sLit "movs") formats (archWordFormat (target32Bit platform)) src dst
549
550 -- here we do some patching, since the physical registers are only set late
551 -- in the code generation.
552 pprInstr (LEA format (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
553 | reg1 == reg3
554 = pprFormatOpOp (sLit "add") format (OpReg reg2) dst
555
556 pprInstr (LEA format (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
557 | reg2 == reg3
558 = pprFormatOpOp (sLit "add") format (OpReg reg1) dst
559
560 pprInstr (LEA format (OpAddr (AddrBaseIndex (EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
561 | reg1 == reg3
562 = pprInstr (ADD format (OpImm displ) dst)
563
564 pprInstr (LEA format src dst) = pprFormatOpOp (sLit "lea") format src dst
565
566 pprInstr (ADD format (OpImm (ImmInt (-1))) dst)
567 = pprFormatOp (sLit "dec") format dst
568 pprInstr (ADD format (OpImm (ImmInt 1)) dst)
569 = pprFormatOp (sLit "inc") format dst
570 pprInstr (ADD format src dst) = pprFormatOpOp (sLit "add") format src dst
571 pprInstr (ADC format src dst) = pprFormatOpOp (sLit "adc") format src dst
572 pprInstr (SUB format src dst) = pprFormatOpOp (sLit "sub") format src dst
573 pprInstr (SBB format src dst) = pprFormatOpOp (sLit "sbb") format src dst
574 pprInstr (IMUL format op1 op2) = pprFormatOpOp (sLit "imul") format op1 op2
575
576 pprInstr (ADD_CC format src dst)
577 = pprFormatOpOp (sLit "add") format src dst
578 pprInstr (SUB_CC format src dst)
579 = pprFormatOpOp (sLit "sub") format src dst
580
581 {- A hack. The Intel documentation says that "The two and three
582 operand forms [of IMUL] may also be used with unsigned operands
583 because the lower half of the product is the same regardless if
584 (sic) the operands are signed or unsigned. The CF and OF flags,
585 however, cannot be used to determine if the upper half of the
586 result is non-zero." So there.
587 -}
588
589 -- Use a 32-bit instruction when possible as it saves a byte.
590 -- Notably, extracting the tag bits of a pointer has this form.
591 -- TODO: we could save a byte in a subsequent CMP instruction too,
592 -- but need something like a peephole pass for this
593 pprInstr (AND II64 src@(OpImm (ImmInteger mask)) dst)
594 | 0 <= mask && mask < 0xffffffff
595 = pprInstr (AND II32 src dst)
596 pprInstr (AND format src dst) = pprFormatOpOp (sLit "and") format src dst
597 pprInstr (OR format src dst) = pprFormatOpOp (sLit "or") format src dst
598
599 pprInstr (XOR FF32 src dst) = pprOpOp (sLit "xorps") FF32 src dst
600 pprInstr (XOR FF64 src dst) = pprOpOp (sLit "xorpd") FF64 src dst
601 pprInstr (XOR format src dst) = pprFormatOpOp (sLit "xor") format src dst
602
603 pprInstr (POPCNT format src dst) = pprOpOp (sLit "popcnt") format src (OpReg dst)
604 pprInstr (BSF format src dst) = pprOpOp (sLit "bsf") format src (OpReg dst)
605 pprInstr (BSR format src dst) = pprOpOp (sLit "bsr") format src (OpReg dst)
606
607 pprInstr (PREFETCH NTA format src ) = pprFormatOp_ (sLit "prefetchnta") format src
608 pprInstr (PREFETCH Lvl0 format src) = pprFormatOp_ (sLit "prefetcht0") format src
609 pprInstr (PREFETCH Lvl1 format src) = pprFormatOp_ (sLit "prefetcht1") format src
610 pprInstr (PREFETCH Lvl2 format src) = pprFormatOp_ (sLit "prefetcht2") format src
611
612 pprInstr (NOT format op) = pprFormatOp (sLit "not") format op
613 pprInstr (BSWAP format op) = pprFormatOp (sLit "bswap") format (OpReg op)
614 pprInstr (NEGI format op) = pprFormatOp (sLit "neg") format op
615
616 pprInstr (SHL format src dst) = pprShift (sLit "shl") format src dst
617 pprInstr (SAR format src dst) = pprShift (sLit "sar") format src dst
618 pprInstr (SHR format src dst) = pprShift (sLit "shr") format src dst
619
620 pprInstr (BT format imm src) = pprFormatImmOp (sLit "bt") format imm src
621
622 pprInstr (CMP format src dst)
623 | isFloatFormat format = pprFormatOpOp (sLit "ucomi") format src dst -- SSE2
624 | otherwise = pprFormatOpOp (sLit "cmp") format src dst
625
626 pprInstr (TEST format src dst) = sdocWithPlatform $ \platform ->
627 let format' = case (src,dst) of
628 -- Match instructions like 'test $0x3,%esi' or 'test $0x7,%rbx'.
629 -- We can replace them by equivalent, but smaller instructions
630 -- by reducing the size of the immediate operand as far as possible.
631 -- (We could handle masks larger than a single byte too,
632 -- but it would complicate the code considerably
633 -- and tag checks are by far the most common case.)
634 (OpImm (ImmInteger mask), OpReg dstReg)
635 | 0 <= mask && mask < 256 -> minSizeOfReg platform dstReg
636 _ -> format
637 in pprFormatOpOp (sLit "test") format' src dst
638 where
639 minSizeOfReg platform (RegReal (RealRegSingle i))
640 | target32Bit platform && i <= 3 = II8 -- al, bl, cl, dl
641 | target32Bit platform && i <= 7 = II16 -- si, di, bp, sp
642 | not (target32Bit platform) && i <= 15 = II8 -- al .. r15b
643 minSizeOfReg _ _ = format -- other
644
645 pprInstr (PUSH format op) = pprFormatOp (sLit "push") format op
646 pprInstr (POP format op) = pprFormatOp (sLit "pop") format op
647
648 -- both unused (SDM):
649 -- pprInstr PUSHA = text "\tpushal"
650 -- pprInstr POPA = text "\tpopal"
651
652 pprInstr NOP = text "\tnop"
653 pprInstr (CLTD II32) = text "\tcltd"
654 pprInstr (CLTD II64) = text "\tcqto"
655
656 pprInstr (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand II8 op)
657
658 pprInstr (JXX cond blockid)
659 = pprCondInstr (sLit "j") cond (ppr lab)
660 where lab = mkAsmTempLabel (getUnique blockid)
661
662 pprInstr (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm imm)
663
664 pprInstr (JMP (OpImm imm) _) = text "\tjmp " <> pprImm imm
665 pprInstr (JMP op _) = sdocWithPlatform $ \platform ->
666 text "\tjmp *"
667 <> pprOperand (archWordFormat (target32Bit platform)) op
668 pprInstr (JMP_TBL op _ _ _) = pprInstr (JMP op [])
669 pprInstr (CALL (Left imm) _) = text "\tcall " <> pprImm imm
670 pprInstr (CALL (Right reg) _) = sdocWithPlatform $ \platform ->
671 text "\tcall *"
672 <> pprReg (archWordFormat (target32Bit platform)) reg
673
674 pprInstr (IDIV fmt op) = pprFormatOp (sLit "idiv") fmt op
675 pprInstr (DIV fmt op) = pprFormatOp (sLit "div") fmt op
676 pprInstr (IMUL2 fmt op) = pprFormatOp (sLit "imul") fmt op
677
678 -- x86_64 only
679 pprInstr (MUL format op1 op2) = pprFormatOpOp (sLit "mul") format op1 op2
680 pprInstr (MUL2 format op) = pprFormatOp (sLit "mul") format op
681
682 pprInstr (FDIV format op1 op2) = pprFormatOpOp (sLit "div") format op1 op2
683
684 pprInstr (CVTSS2SD from to) = pprRegReg (sLit "cvtss2sd") from to
685 pprInstr (CVTSD2SS from to) = pprRegReg (sLit "cvtsd2ss") from to
686 pprInstr (CVTTSS2SIQ fmt from to) = pprFormatFormatOpReg (sLit "cvttss2si") FF32 fmt from to
687 pprInstr (CVTTSD2SIQ fmt from to) = pprFormatFormatOpReg (sLit "cvttsd2si") FF64 fmt from to
688 pprInstr (CVTSI2SS fmt from to) = pprFormatOpReg (sLit "cvtsi2ss") fmt from to
689 pprInstr (CVTSI2SD fmt from to) = pprFormatOpReg (sLit "cvtsi2sd") fmt from to
690
691 -- FETCHGOT for PIC on ELF platforms
692 pprInstr (FETCHGOT reg)
693 = vcat [ text "\tcall 1f",
694 hcat [ text "1:\tpopl\t", pprReg II32 reg ],
695 hcat [ text "\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), ",
696 pprReg II32 reg ]
697 ]
698
699 -- FETCHPC for PIC on Darwin/x86
700 -- get the instruction pointer into a register
701 -- (Terminology note: the IP is called Program Counter on PPC,
702 -- and it's a good thing to use the same name on both platforms)
703 pprInstr (FETCHPC reg)
704 = vcat [ text "\tcall 1f",
705 hcat [ text "1:\tpopl\t", pprReg II32 reg ]
706 ]
707
708
709 -- -----------------------------------------------------------------------------
710 -- i386 floating-point
711
712 -- Simulating a flat register set on the x86 FP stack is tricky.
713 -- you have to free %st(7) before pushing anything on the FP reg stack
714 -- so as to preclude the possibility of a FP stack overflow exception.
715 pprInstr g@(GMOV src dst)
716 | src == dst
717 = empty
718 | otherwise
719 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
720
721 -- GLD fmt addr dst ==> FLDsz addr ; FSTP (dst+1)
722 pprInstr g@(GLD fmt addr dst)
723 = pprG g (hcat [gtab, text "fld", pprFormat_x87 fmt, gsp,
724 pprAddr addr, gsemi, gpop dst 1])
725
726 -- GST fmt src addr ==> FLD dst ; FSTPsz addr
727 pprInstr g@(GST fmt src addr)
728 | src == fake0 && fmt /= FF80 -- fstt instruction doesn't exist
729 = pprG g (hcat [gtab,
730 text "fst", pprFormat_x87 fmt, gsp, pprAddr addr])
731 | otherwise
732 = pprG g (hcat [gtab, gpush src 0, gsemi,
733 text "fstp", pprFormat_x87 fmt, gsp, pprAddr addr])
734
735 pprInstr g@(GLDZ dst)
736 = pprG g (hcat [gtab, text "fldz ; ", gpop dst 1])
737 pprInstr g@(GLD1 dst)
738 = pprG g (hcat [gtab, text "fld1 ; ", gpop dst 1])
739
740 pprInstr (GFTOI src dst)
741 = pprInstr (GDTOI src dst)
742
743 pprInstr g@(GDTOI src dst)
744 = pprG g (vcat [
745 hcat [gtab, text "subl $8, %esp ; fnstcw 4(%esp)"],
746 hcat [gtab, gpush src 0],
747 hcat [gtab, text "movzwl 4(%esp), ", reg,
748 text " ; orl $0xC00, ", reg],
749 hcat [gtab, text "movl ", reg, text ", 0(%esp) ; fldcw 0(%esp)"],
750 hcat [gtab, text "fistpl 0(%esp)"],
751 hcat [gtab, text "fldcw 4(%esp) ; movl 0(%esp), ", reg],
752 hcat [gtab, text "addl $8, %esp"]
753 ])
754 where
755 reg = pprReg II32 dst
756
757 pprInstr (GITOF src dst)
758 = pprInstr (GITOD src dst)
759
760 pprInstr g@(GITOD src dst)
761 = pprG g (hcat [gtab, text "pushl ", pprReg II32 src,
762 text " ; fildl (%esp) ; ",
763 gpop dst 1, text " ; addl $4,%esp"])
764
765 pprInstr g@(GDTOF src dst)
766 = pprG g (vcat [gtab <> gpush src 0,
767 gtab <> text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ;",
768 gtab <> gpop dst 1])
769
770 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
771 this far into the jungle AND you give a Rat's Ass (tm) what's going
772 on, here's the deal. Generate code to do a floating point comparison
773 of src1 and src2, of kind cond, and set the Zero flag if true.
774
775 The complications are to do with handling NaNs correctly. We want the
776 property that if either argument is NaN, then the result of the
777 comparison is False ... except if we're comparing for inequality,
778 in which case the answer is True.
779
780 Here's how the general (non-inequality) case works. As an
781 example, consider generating the an equality test:
782
783 pushl %eax -- we need to mess with this
784 <get src1 to top of FPU stack>
785 fcomp <src2 location in FPU stack> and pop pushed src1
786 -- Result of comparison is in FPU Status Register bits
787 -- C3 C2 and C0
788 fstsw %ax -- Move FPU Status Reg to %ax
789 sahf -- move C3 C2 C0 from %ax to integer flag reg
790 -- now the serious magic begins
791 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
792 sete %al -- %al = if arg1 == arg2 then 1 else 0
793 andb %ah,%al -- %al &= %ah
794 -- so %al == 1 iff (comparable && same); else it holds 0
795 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
796 else %al == 0xFF, ZeroFlag=0
797 -- the zero flag is now set as we desire.
798 popl %eax
799
800 The special case of inequality differs thusly:
801
802 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
803 setne %al -- %al = if arg1 /= arg2 then 1 else 0
804 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
805 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
806 else (%al == 0xFF, ZF=0)
807 -}
808 pprInstr g@(GCMP cond src1 src2)
809 | case cond of { NE -> True; _ -> False }
810 = pprG g (vcat [
811 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
812 hcat [gtab, text "fcomp ", greg src2 1,
813 text "; fstsw %ax ; sahf ; setpe %ah"],
814 hcat [gtab, text "setne %al ; ",
815 text "orb %ah,%al ; decb %al ; popl %eax"]
816 ])
817 | otherwise
818 = pprG g (vcat [
819 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
820 hcat [gtab, text "fcomp ", greg src2 1,
821 text "; fstsw %ax ; sahf ; setpo %ah"],
822 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
823 text "andb %ah,%al ; decb %al ; popl %eax"]
824 ])
825 where
826 {- On the 486, the flags set by FP compare are the unsigned ones!
827 (This looks like a HACK to me. WDP 96/03)
828 -}
829 fix_FP_cond :: Cond -> Cond
830 fix_FP_cond GE = GEU
831 fix_FP_cond GTT = GU
832 fix_FP_cond LTT = LU
833 fix_FP_cond LE = LEU
834 fix_FP_cond EQQ = EQQ
835 fix_FP_cond NE = NE
836 fix_FP_cond _ = panic "X86.Ppr.fix_FP_cond: no match"
837 -- there should be no others
838
839
840 pprInstr g@(GABS _ src dst)
841 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
842
843 pprInstr g@(GNEG _ src dst)
844 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
845
846 pprInstr g@(GSQRT fmt src dst)
847 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
848 hcat [gtab, gcoerceto fmt, gpop dst 1])
849
850 pprInstr g@(GSIN fmt l1 l2 src dst)
851 = pprG g (pprTrigOp "fsin" False l1 l2 src dst fmt)
852
853 pprInstr g@(GCOS fmt l1 l2 src dst)
854 = pprG g (pprTrigOp "fcos" False l1 l2 src dst fmt)
855
856 pprInstr g@(GTAN fmt l1 l2 src dst)
857 = pprG g (pprTrigOp "fptan" True l1 l2 src dst fmt)
858
859 -- In the translations for GADD, GMUL, GSUB and GDIV,
860 -- the first two cases are mere optimisations. The otherwise clause
861 -- generates correct code under all circumstances.
862
863 pprInstr g@(GADD _ src1 src2 dst)
864 | src1 == dst
865 = pprG g (text "\t#GADD-xxxcase1" $$
866 hcat [gtab, gpush src2 0,
867 text " ; faddp %st(0),", greg src1 1])
868 | src2 == dst
869 = pprG g (text "\t#GADD-xxxcase2" $$
870 hcat [gtab, gpush src1 0,
871 text " ; faddp %st(0),", greg src2 1])
872 | otherwise
873 = pprG g (hcat [gtab, gpush src1 0,
874 text " ; fadd ", greg src2 1, text ",%st(0)",
875 gsemi, gpop dst 1])
876
877
878 pprInstr g@(GMUL _ src1 src2 dst)
879 | src1 == dst
880 = pprG g (text "\t#GMUL-xxxcase1" $$
881 hcat [gtab, gpush src2 0,
882 text " ; fmulp %st(0),", greg src1 1])
883 | src2 == dst
884 = pprG g (text "\t#GMUL-xxxcase2" $$
885 hcat [gtab, gpush src1 0,
886 text " ; fmulp %st(0),", greg src2 1])
887 | otherwise
888 = pprG g (hcat [gtab, gpush src1 0,
889 text " ; fmul ", greg src2 1, text ",%st(0)",
890 gsemi, gpop dst 1])
891
892
893 pprInstr g@(GSUB _ src1 src2 dst)
894 | src1 == dst
895 = pprG g (text "\t#GSUB-xxxcase1" $$
896 hcat [gtab, gpush src2 0,
897 text " ; fsubrp %st(0),", greg src1 1])
898 | src2 == dst
899 = pprG g (text "\t#GSUB-xxxcase2" $$
900 hcat [gtab, gpush src1 0,
901 text " ; fsubp %st(0),", greg src2 1])
902 | otherwise
903 = pprG g (hcat [gtab, gpush src1 0,
904 text " ; fsub ", greg src2 1, text ",%st(0)",
905 gsemi, gpop dst 1])
906
907
908 pprInstr g@(GDIV _ src1 src2 dst)
909 | src1 == dst
910 = pprG g (text "\t#GDIV-xxxcase1" $$
911 hcat [gtab, gpush src2 0,
912 text " ; fdivrp %st(0),", greg src1 1])
913 | src2 == dst
914 = pprG g (text "\t#GDIV-xxxcase2" $$
915 hcat [gtab, gpush src1 0,
916 text " ; fdivp %st(0),", greg src2 1])
917 | otherwise
918 = pprG g (hcat [gtab, gpush src1 0,
919 text " ; fdiv ", greg src2 1, text ",%st(0)",
920 gsemi, gpop dst 1])
921
922
923 pprInstr GFREE
924 = vcat [ text "\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)",
925 text "\tffree %st(4) ;ffree %st(5)"
926 ]
927
928 -- Atomics
929
930 pprInstr (LOCK i) = text "\tlock" $$ pprInstr i
931
932 pprInstr MFENCE = text "\tmfence"
933
934 pprInstr (XADD format src dst) = pprFormatOpOp (sLit "xadd") format src dst
935
936 pprInstr (CMPXCHG format src dst)
937 = pprFormatOpOp (sLit "cmpxchg") format src dst
938
939 pprInstr _
940 = panic "X86.Ppr.pprInstr: no match"
941
942
943 pprTrigOp :: String -> Bool -> CLabel -> CLabel
944 -> Reg -> Reg -> Format -> SDoc
945 pprTrigOp op -- fsin, fcos or fptan
946 isTan -- we need a couple of extra steps if we're doing tan
947 l1 l2 -- internal labels for us to use
948 src dst fmt
949 = -- We'll be needing %eax later on
950 hcat [gtab, text "pushl %eax;"] $$
951 -- tan is going to use an extra space on the FP stack
952 (if isTan then hcat [gtab, text "ffree %st(6)"] else empty) $$
953 -- First put the value in %st(0) and try to apply the op to it
954 hcat [gpush src 0, text ("; " ++ op)] $$
955 -- Now look to see if C2 was set (overflow, |value| >= 2^63)
956 hcat [gtab, text "fnstsw %ax"] $$
957 hcat [gtab, text "test $0x400,%eax"] $$
958 -- If we were in bounds then jump to the end
959 hcat [gtab, text "je " <> ppr l1] $$
960 -- Otherwise we need to shrink the value. Start by
961 -- loading pi, doubleing it (by adding it to itself),
962 -- and then swapping pi with the value, so the value we
963 -- want to apply op to is in %st(0) again
964 hcat [gtab, text "ffree %st(7); fldpi"] $$
965 hcat [gtab, text "fadd %st(0),%st"] $$
966 hcat [gtab, text "fxch %st(1)"] $$
967 -- Now we have a loop in which we make the value smaller,
968 -- see if it's small enough, and loop if not
969 (ppr l2 <> char ':') $$
970 hcat [gtab, text "fprem1"] $$
971 -- My Debian libc uses fstsw here for the tan code, but I can't
972 -- see any reason why it should need to be different for tan.
973 hcat [gtab, text "fnstsw %ax"] $$
974 hcat [gtab, text "test $0x400,%eax"] $$
975 hcat [gtab, text "jne " <> ppr l2] $$
976 hcat [gtab, text "fstp %st(1)"] $$
977 hcat [gtab, text op] $$
978 (ppr l1 <> char ':') $$
979 -- Pop the 1.0 tan gave us
980 (if isTan then hcat [gtab, text "fstp %st(0)"] else empty) $$
981 -- Restore %eax
982 hcat [gtab, text "popl %eax;"] $$
983 -- And finally make the result the right size
984 hcat [gtab, gcoerceto fmt, gpop dst 1]
985
986 --------------------------
987
988 -- coerce %st(0) to the specified size
989 gcoerceto :: Format -> SDoc
990 gcoerceto FF64 = empty
991 gcoerceto FF32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
992 gcoerceto _ = panic "X86.Ppr.gcoerceto: no match"
993
994 gpush :: Reg -> RegNo -> SDoc
995 gpush reg offset
996 = hcat [text "fld ", greg reg offset]
997
998 gpop :: Reg -> RegNo -> SDoc
999 gpop reg offset
1000 = hcat [text "fstp ", greg reg offset]
1001
1002 greg :: Reg -> RegNo -> SDoc
1003 greg reg offset = text "%st(" <> int (gregno reg - firstfake+offset) <> char ')'
1004
1005 gsemi :: SDoc
1006 gsemi = text " ; "
1007
1008 gtab :: SDoc
1009 gtab = char '\t'
1010
1011 gsp :: SDoc
1012 gsp = char ' '
1013
1014 gregno :: Reg -> RegNo
1015 gregno (RegReal (RealRegSingle i)) = i
1016 gregno _ = --pprPanic "gregno" (ppr other)
1017 999 -- bogus; only needed for debug printing
1018
1019 pprG :: Instr -> SDoc -> SDoc
1020 pprG fake actual
1021 = (char '#' <> pprGInstr fake) $$ actual
1022
1023
1024 pprGInstr :: Instr -> SDoc
1025 pprGInstr (GMOV src dst) = pprFormatRegReg (sLit "gmov") FF64 src dst
1026 pprGInstr (GLD fmt src dst) = pprFormatAddrReg (sLit "gld") fmt src dst
1027 pprGInstr (GST fmt src dst) = pprFormatRegAddr (sLit "gst") fmt src dst
1028
1029 pprGInstr (GLDZ dst) = pprFormatReg (sLit "gldz") FF64 dst
1030 pprGInstr (GLD1 dst) = pprFormatReg (sLit "gld1") FF64 dst
1031
1032 pprGInstr (GFTOI src dst) = pprFormatFormatRegReg (sLit "gftoi") FF32 II32 src dst
1033 pprGInstr (GDTOI src dst) = pprFormatFormatRegReg (sLit "gdtoi") FF64 II32 src dst
1034
1035 pprGInstr (GITOF src dst) = pprFormatFormatRegReg (sLit "gitof") II32 FF32 src dst
1036 pprGInstr (GITOD src dst) = pprFormatFormatRegReg (sLit "gitod") II32 FF64 src dst
1037 pprGInstr (GDTOF src dst) = pprFormatFormatRegReg (sLit "gdtof") FF64 FF32 src dst
1038
1039 pprGInstr (GCMP co src dst) = pprCondRegReg (sLit "gcmp_") FF64 co src dst
1040 pprGInstr (GABS fmt src dst) = pprFormatRegReg (sLit "gabs") fmt src dst
1041 pprGInstr (GNEG fmt src dst) = pprFormatRegReg (sLit "gneg") fmt src dst
1042 pprGInstr (GSQRT fmt src dst) = pprFormatRegReg (sLit "gsqrt") fmt src dst
1043 pprGInstr (GSIN fmt _ _ src dst) = pprFormatRegReg (sLit "gsin") fmt src dst
1044 pprGInstr (GCOS fmt _ _ src dst) = pprFormatRegReg (sLit "gcos") fmt src dst
1045 pprGInstr (GTAN fmt _ _ src dst) = pprFormatRegReg (sLit "gtan") fmt src dst
1046
1047 pprGInstr (GADD fmt src1 src2 dst) = pprFormatRegRegReg (sLit "gadd") fmt src1 src2 dst
1048 pprGInstr (GSUB fmt src1 src2 dst) = pprFormatRegRegReg (sLit "gsub") fmt src1 src2 dst
1049 pprGInstr (GMUL fmt src1 src2 dst) = pprFormatRegRegReg (sLit "gmul") fmt src1 src2 dst
1050 pprGInstr (GDIV fmt src1 src2 dst) = pprFormatRegRegReg (sLit "gdiv") fmt src1 src2 dst
1051
1052 pprGInstr _ = panic "X86.Ppr.pprGInstr: no match"
1053
1054 pprDollImm :: Imm -> SDoc
1055 pprDollImm i = text "$" <> pprImm i
1056
1057
1058 pprOperand :: Format -> Operand -> SDoc
1059 pprOperand f (OpReg r) = pprReg f r
1060 pprOperand _ (OpImm i) = pprDollImm i
1061 pprOperand _ (OpAddr ea) = pprAddr ea
1062
1063
1064 pprMnemonic_ :: LitString -> SDoc
1065 pprMnemonic_ name =
1066 char '\t' <> ptext name <> space
1067
1068
1069 pprMnemonic :: LitString -> Format -> SDoc
1070 pprMnemonic name format =
1071 char '\t' <> ptext name <> pprFormat format <> space
1072
1073
1074 pprFormatImmOp :: LitString -> Format -> Imm -> Operand -> SDoc
1075 pprFormatImmOp name format imm op1
1076 = hcat [
1077 pprMnemonic name format,
1078 char '$',
1079 pprImm imm,
1080 comma,
1081 pprOperand format op1
1082 ]
1083
1084
1085 pprFormatOp_ :: LitString -> Format -> Operand -> SDoc
1086 pprFormatOp_ name format op1
1087 = hcat [
1088 pprMnemonic_ name ,
1089 pprOperand format op1
1090 ]
1091
1092 pprFormatOp :: LitString -> Format -> Operand -> SDoc
1093 pprFormatOp name format op1
1094 = hcat [
1095 pprMnemonic name format,
1096 pprOperand format op1
1097 ]
1098
1099
1100 pprFormatOpOp :: LitString -> Format -> Operand -> Operand -> SDoc
1101 pprFormatOpOp name format op1 op2
1102 = hcat [
1103 pprMnemonic name format,
1104 pprOperand format op1,
1105 comma,
1106 pprOperand format op2
1107 ]
1108
1109
1110 pprOpOp :: LitString -> Format -> Operand -> Operand -> SDoc
1111 pprOpOp name format op1 op2
1112 = hcat [
1113 pprMnemonic_ name,
1114 pprOperand format op1,
1115 comma,
1116 pprOperand format op2
1117 ]
1118
1119
1120 pprFormatReg :: LitString -> Format -> Reg -> SDoc
1121 pprFormatReg name format reg1
1122 = hcat [
1123 pprMnemonic name format,
1124 pprReg format reg1
1125 ]
1126
1127
1128 pprFormatRegReg :: LitString -> Format -> Reg -> Reg -> SDoc
1129 pprFormatRegReg name format reg1 reg2
1130 = hcat [
1131 pprMnemonic name format,
1132 pprReg format reg1,
1133 comma,
1134 pprReg format reg2
1135 ]
1136
1137
1138 pprRegReg :: LitString -> Reg -> Reg -> SDoc
1139 pprRegReg name reg1 reg2
1140 = sdocWithPlatform $ \platform ->
1141 hcat [
1142 pprMnemonic_ name,
1143 pprReg (archWordFormat (target32Bit platform)) reg1,
1144 comma,
1145 pprReg (archWordFormat (target32Bit platform)) reg2
1146 ]
1147
1148
1149 pprFormatOpReg :: LitString -> Format -> Operand -> Reg -> SDoc
1150 pprFormatOpReg name format op1 reg2
1151 = sdocWithPlatform $ \platform ->
1152 hcat [
1153 pprMnemonic name format,
1154 pprOperand format op1,
1155 comma,
1156 pprReg (archWordFormat (target32Bit platform)) reg2
1157 ]
1158
1159 pprCondOpReg :: LitString -> Format -> Cond -> Operand -> Reg -> SDoc
1160 pprCondOpReg name format cond op1 reg2
1161 = hcat [
1162 char '\t',
1163 ptext name,
1164 pprCond cond,
1165 space,
1166 pprOperand format op1,
1167 comma,
1168 pprReg format reg2
1169 ]
1170
1171 pprCondRegReg :: LitString -> Format -> Cond -> Reg -> Reg -> SDoc
1172 pprCondRegReg name format cond reg1 reg2
1173 = hcat [
1174 char '\t',
1175 ptext name,
1176 pprCond cond,
1177 space,
1178 pprReg format reg1,
1179 comma,
1180 pprReg format reg2
1181 ]
1182
1183 pprFormatFormatRegReg :: LitString -> Format -> Format -> Reg -> Reg -> SDoc
1184 pprFormatFormatRegReg name format1 format2 reg1 reg2
1185 = hcat [
1186 char '\t',
1187 ptext name,
1188 pprFormat format1,
1189 pprFormat format2,
1190 space,
1191 pprReg format1 reg1,
1192 comma,
1193 pprReg format2 reg2
1194 ]
1195
1196 pprFormatFormatOpReg :: LitString -> Format -> Format -> Operand -> Reg -> SDoc
1197 pprFormatFormatOpReg name format1 format2 op1 reg2
1198 = hcat [
1199 pprMnemonic name format2,
1200 pprOperand format1 op1,
1201 comma,
1202 pprReg format2 reg2
1203 ]
1204
1205 pprFormatRegRegReg :: LitString -> Format -> Reg -> Reg -> Reg -> SDoc
1206 pprFormatRegRegReg name format reg1 reg2 reg3
1207 = hcat [
1208 pprMnemonic name format,
1209 pprReg format reg1,
1210 comma,
1211 pprReg format reg2,
1212 comma,
1213 pprReg format reg3
1214 ]
1215
1216
1217 pprFormatAddrReg :: LitString -> Format -> AddrMode -> Reg -> SDoc
1218 pprFormatAddrReg name format op dst
1219 = hcat [
1220 pprMnemonic name format,
1221 pprAddr op,
1222 comma,
1223 pprReg format dst
1224 ]
1225
1226
1227 pprFormatRegAddr :: LitString -> Format -> Reg -> AddrMode -> SDoc
1228 pprFormatRegAddr name format src op
1229 = hcat [
1230 pprMnemonic name format,
1231 pprReg format src,
1232 comma,
1233 pprAddr op
1234 ]
1235
1236
1237 pprShift :: LitString -> Format -> Operand -> Operand -> SDoc
1238 pprShift name format src dest
1239 = hcat [
1240 pprMnemonic name format,
1241 pprOperand II8 src, -- src is 8-bit sized
1242 comma,
1243 pprOperand format dest
1244 ]
1245
1246
1247 pprFormatOpOpCoerce :: LitString -> Format -> Format -> Operand -> Operand -> SDoc
1248 pprFormatOpOpCoerce name format1 format2 op1 op2
1249 = hcat [ char '\t', ptext name, pprFormat format1, pprFormat format2, space,
1250 pprOperand format1 op1,
1251 comma,
1252 pprOperand format2 op2
1253 ]
1254
1255
1256 pprCondInstr :: LitString -> Cond -> SDoc -> SDoc
1257 pprCondInstr name cond arg
1258 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1259