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