1 -----------------------------------------------------------------------------
3 -- Pretty-printing assembly language
5 -- (c) The University of Glasgow 1993-2005
7 -----------------------------------------------------------------------------
9 -- We start with the @pprXXX@s with some cross-platform commonality
10 -- (e.g., 'pprReg'); we conclude with the no-commonality monster,
13 {-# OPTIONS_GHC -w #-}
14 -- The above warning supression flag is a temporary kludge.
15 -- While working on this module you are encouraged to remove it and fix
16 -- any warnings in the module. See
17 -- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
20 #include "nativeGen/NCG.h"
23 pprNatCmmTop, pprBasicBlock, pprSectionHeader, pprData,
24 pprInstr, pprSize, pprUserReg
28 #include "HsVersions.h"
31 import MachOp ( MachRep(..), wordRep, isFloatingRep )
32 import MachRegs -- may differ per-platform
35 import CLabel ( CLabel, pprCLabel, externallyVisibleCLabel,
36 labelDynamic, mkAsmTempLabel, entryLblToInfoLbl )
37 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
38 import CLabel ( mkDeadStripPreventer )
41 import Panic ( panic )
42 import Unique ( pprUnique )
45 import qualified Outputable
46 import Outputable ( Outputable )
49 import Data.Word ( Word8 )
50 import Control.Monad.ST
51 import Data.Char ( chr, ord )
52 import Data.Maybe ( isJust )
54 #if powerpc_TARGET_ARCH || darwin_TARGET_OS
55 import Data.Word(Word32)
59 -- -----------------------------------------------------------------------------
60 -- Printing this stuff out
62 asmSDoc d = Outputable.withPprStyleDoc (
63 Outputable.mkCodeStyle Outputable.AsmStyle) d
64 pprCLabel_asm l = asmSDoc (pprCLabel l)
66 pprNatCmmTop :: NatCmmTop -> Doc
67 pprNatCmmTop (CmmData section dats) =
68 pprSectionHeader section $$ vcat (map pprData dats)
70 -- special case for split markers:
71 pprNatCmmTop (CmmProc [] lbl _ []) = pprLabel lbl
73 pprNatCmmTop (CmmProc info lbl params blocks) =
74 pprSectionHeader Text $$
77 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
78 pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
81 vcat (map pprData info) $$
82 pprLabel (entryLblToInfoLbl lbl)
86 (BasicBlock _ instrs : rest) ->
87 (if null info then pprLabel lbl else empty) $$
88 -- the first block doesn't get a label:
89 vcat (map pprInstr instrs) $$
90 vcat (map pprBasicBlock rest)
92 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
93 -- If we are using the .subsections_via_symbols directive
94 -- (available on recent versions of Darwin),
95 -- we have to make sure that there is some kind of reference
96 -- from the entry code to a label on the _top_ of of the info table,
97 -- so that the linker will not think it is unreferenced and dead-strip
98 -- it. That's why the label is called a DeadStripPreventer (_dsp).
101 <+> pprCLabel_asm (entryLblToInfoLbl lbl)
103 <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
108 pprBasicBlock :: NatBasicBlock -> Doc
109 pprBasicBlock (BasicBlock (BlockId id) instrs) =
110 pprLabel (mkAsmTempLabel id) $$
111 vcat (map pprInstr instrs)
113 -- -----------------------------------------------------------------------------
114 -- pprReg: print a 'Reg'
116 -- For x86, the way we print a register name depends
117 -- on which bit of it we care about. Yurgh.
119 pprUserReg :: Reg -> Doc
120 pprUserReg = pprReg IF_ARCH_i386(I32,) IF_ARCH_x86_64(I64,)
122 pprReg :: IF_ARCH_i386(MachRep ->,) IF_ARCH_x86_64(MachRep ->,) Reg -> Doc
124 pprReg IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) r
126 RealReg i -> ppr_reg_no IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) i
127 VirtualRegI u -> text "%vI_" <> asmSDoc (pprUnique u)
128 VirtualRegHi u -> text "%vHi_" <> asmSDoc (pprUnique u)
129 VirtualRegF u -> text "%vF_" <> asmSDoc (pprUnique u)
130 VirtualRegD u -> text "%vD_" <> asmSDoc (pprUnique u)
132 #if alpha_TARGET_ARCH
133 ppr_reg_no :: Int -> Doc
136 0 -> SLIT("$0"); 1 -> SLIT("$1");
137 2 -> SLIT("$2"); 3 -> SLIT("$3");
138 4 -> SLIT("$4"); 5 -> SLIT("$5");
139 6 -> SLIT("$6"); 7 -> SLIT("$7");
140 8 -> SLIT("$8"); 9 -> SLIT("$9");
141 10 -> SLIT("$10"); 11 -> SLIT("$11");
142 12 -> SLIT("$12"); 13 -> SLIT("$13");
143 14 -> SLIT("$14"); 15 -> SLIT("$15");
144 16 -> SLIT("$16"); 17 -> SLIT("$17");
145 18 -> SLIT("$18"); 19 -> SLIT("$19");
146 20 -> SLIT("$20"); 21 -> SLIT("$21");
147 22 -> SLIT("$22"); 23 -> SLIT("$23");
148 24 -> SLIT("$24"); 25 -> SLIT("$25");
149 26 -> SLIT("$26"); 27 -> SLIT("$27");
150 28 -> SLIT("$28"); 29 -> SLIT("$29");
151 30 -> SLIT("$30"); 31 -> SLIT("$31");
152 32 -> SLIT("$f0"); 33 -> SLIT("$f1");
153 34 -> SLIT("$f2"); 35 -> SLIT("$f3");
154 36 -> SLIT("$f4"); 37 -> SLIT("$f5");
155 38 -> SLIT("$f6"); 39 -> SLIT("$f7");
156 40 -> SLIT("$f8"); 41 -> SLIT("$f9");
157 42 -> SLIT("$f10"); 43 -> SLIT("$f11");
158 44 -> SLIT("$f12"); 45 -> SLIT("$f13");
159 46 -> SLIT("$f14"); 47 -> SLIT("$f15");
160 48 -> SLIT("$f16"); 49 -> SLIT("$f17");
161 50 -> SLIT("$f18"); 51 -> SLIT("$f19");
162 52 -> SLIT("$f20"); 53 -> SLIT("$f21");
163 54 -> SLIT("$f22"); 55 -> SLIT("$f23");
164 56 -> SLIT("$f24"); 57 -> SLIT("$f25");
165 58 -> SLIT("$f26"); 59 -> SLIT("$f27");
166 60 -> SLIT("$f28"); 61 -> SLIT("$f29");
167 62 -> SLIT("$f30"); 63 -> SLIT("$f31");
168 _ -> SLIT("very naughty alpha register")
172 ppr_reg_no :: MachRep -> Int -> Doc
173 ppr_reg_no I8 = ppr_reg_byte
174 ppr_reg_no I16 = ppr_reg_word
175 ppr_reg_no _ = ppr_reg_long
177 ppr_reg_byte i = ptext
179 0 -> SLIT("%al"); 1 -> SLIT("%bl");
180 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
181 _ -> SLIT("very naughty I386 byte register")
184 ppr_reg_word i = ptext
186 0 -> SLIT("%ax"); 1 -> SLIT("%bx");
187 2 -> SLIT("%cx"); 3 -> SLIT("%dx");
188 4 -> SLIT("%si"); 5 -> SLIT("%di");
189 6 -> SLIT("%bp"); 7 -> SLIT("%sp");
190 _ -> SLIT("very naughty I386 word register")
193 ppr_reg_long i = ptext
195 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
196 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
197 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
198 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
199 8 -> SLIT("%fake0"); 9 -> SLIT("%fake1");
200 10 -> SLIT("%fake2"); 11 -> SLIT("%fake3");
201 12 -> SLIT("%fake4"); 13 -> SLIT("%fake5");
202 _ -> SLIT("very naughty I386 register")
206 #if x86_64_TARGET_ARCH
207 ppr_reg_no :: MachRep -> Int -> Doc
208 ppr_reg_no I8 = ppr_reg_byte
209 ppr_reg_no I16 = ppr_reg_word
210 ppr_reg_no I32 = ppr_reg_long
211 ppr_reg_no _ = ppr_reg_quad
213 ppr_reg_byte i = ptext
215 0 -> SLIT("%al"); 1 -> SLIT("%bl");
216 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
217 4 -> SLIT("%sil"); 5 -> SLIT("%dil"); -- new 8-bit regs!
218 6 -> SLIT("%bpl"); 7 -> SLIT("%spl");
219 8 -> SLIT("%r8b"); 9 -> SLIT("%r9b");
220 10 -> SLIT("%r10b"); 11 -> SLIT("%r11b");
221 12 -> SLIT("%r12b"); 13 -> SLIT("%r13b");
222 14 -> SLIT("%r14b"); 15 -> SLIT("%r15b");
223 _ -> SLIT("very naughty x86_64 byte register")
226 ppr_reg_word i = ptext
228 0 -> SLIT("%ax"); 1 -> SLIT("%bx");
229 2 -> SLIT("%cx"); 3 -> SLIT("%dx");
230 4 -> SLIT("%si"); 5 -> SLIT("%di");
231 6 -> SLIT("%bp"); 7 -> SLIT("%sp");
232 8 -> SLIT("%r8w"); 9 -> SLIT("%r9w");
233 10 -> SLIT("%r10w"); 11 -> SLIT("%r11w");
234 12 -> SLIT("%r12w"); 13 -> SLIT("%r13w");
235 14 -> SLIT("%r14w"); 15 -> SLIT("%r15w");
236 _ -> SLIT("very naughty x86_64 word register")
239 ppr_reg_long i = ptext
241 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
242 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
243 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
244 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
245 8 -> SLIT("%r8d"); 9 -> SLIT("%r9d");
246 10 -> SLIT("%r10d"); 11 -> SLIT("%r11d");
247 12 -> SLIT("%r12d"); 13 -> SLIT("%r13d");
248 14 -> SLIT("%r14d"); 15 -> SLIT("%r15d");
249 _ -> SLIT("very naughty x86_64 register")
252 ppr_reg_quad i = ptext
254 0 -> SLIT("%rax"); 1 -> SLIT("%rbx");
255 2 -> SLIT("%rcx"); 3 -> SLIT("%rdx");
256 4 -> SLIT("%rsi"); 5 -> SLIT("%rdi");
257 6 -> SLIT("%rbp"); 7 -> SLIT("%rsp");
258 8 -> SLIT("%r8"); 9 -> SLIT("%r9");
259 10 -> SLIT("%r10"); 11 -> SLIT("%r11");
260 12 -> SLIT("%r12"); 13 -> SLIT("%r13");
261 14 -> SLIT("%r14"); 15 -> SLIT("%r15");
262 16 -> SLIT("%xmm0"); 17 -> SLIT("%xmm1");
263 18 -> SLIT("%xmm2"); 19 -> SLIT("%xmm3");
264 20 -> SLIT("%xmm4"); 21 -> SLIT("%xmm5");
265 22 -> SLIT("%xmm6"); 23 -> SLIT("%xmm7");
266 24 -> SLIT("%xmm8"); 25 -> SLIT("%xmm9");
267 26 -> SLIT("%xmm10"); 27 -> SLIT("%xmm11");
268 28 -> SLIT("%xmm12"); 29 -> SLIT("%xmm13");
269 30 -> SLIT("%xmm14"); 31 -> SLIT("%xmm15");
270 _ -> SLIT("very naughty x86_64 register")
274 #if sparc_TARGET_ARCH
275 ppr_reg_no :: Int -> Doc
278 0 -> SLIT("%g0"); 1 -> SLIT("%g1");
279 2 -> SLIT("%g2"); 3 -> SLIT("%g3");
280 4 -> SLIT("%g4"); 5 -> SLIT("%g5");
281 6 -> SLIT("%g6"); 7 -> SLIT("%g7");
282 8 -> SLIT("%o0"); 9 -> SLIT("%o1");
283 10 -> SLIT("%o2"); 11 -> SLIT("%o3");
284 12 -> SLIT("%o4"); 13 -> SLIT("%o5");
285 14 -> SLIT("%o6"); 15 -> SLIT("%o7");
286 16 -> SLIT("%l0"); 17 -> SLIT("%l1");
287 18 -> SLIT("%l2"); 19 -> SLIT("%l3");
288 20 -> SLIT("%l4"); 21 -> SLIT("%l5");
289 22 -> SLIT("%l6"); 23 -> SLIT("%l7");
290 24 -> SLIT("%i0"); 25 -> SLIT("%i1");
291 26 -> SLIT("%i2"); 27 -> SLIT("%i3");
292 28 -> SLIT("%i4"); 29 -> SLIT("%i5");
293 30 -> SLIT("%i6"); 31 -> SLIT("%i7");
294 32 -> SLIT("%f0"); 33 -> SLIT("%f1");
295 34 -> SLIT("%f2"); 35 -> SLIT("%f3");
296 36 -> SLIT("%f4"); 37 -> SLIT("%f5");
297 38 -> SLIT("%f6"); 39 -> SLIT("%f7");
298 40 -> SLIT("%f8"); 41 -> SLIT("%f9");
299 42 -> SLIT("%f10"); 43 -> SLIT("%f11");
300 44 -> SLIT("%f12"); 45 -> SLIT("%f13");
301 46 -> SLIT("%f14"); 47 -> SLIT("%f15");
302 48 -> SLIT("%f16"); 49 -> SLIT("%f17");
303 50 -> SLIT("%f18"); 51 -> SLIT("%f19");
304 52 -> SLIT("%f20"); 53 -> SLIT("%f21");
305 54 -> SLIT("%f22"); 55 -> SLIT("%f23");
306 56 -> SLIT("%f24"); 57 -> SLIT("%f25");
307 58 -> SLIT("%f26"); 59 -> SLIT("%f27");
308 60 -> SLIT("%f28"); 61 -> SLIT("%f29");
309 62 -> SLIT("%f30"); 63 -> SLIT("%f31");
310 _ -> SLIT("very naughty sparc register")
313 #if powerpc_TARGET_ARCH
315 ppr_reg_no :: Int -> Doc
318 0 -> SLIT("r0"); 1 -> SLIT("r1");
319 2 -> SLIT("r2"); 3 -> SLIT("r3");
320 4 -> SLIT("r4"); 5 -> SLIT("r5");
321 6 -> SLIT("r6"); 7 -> SLIT("r7");
322 8 -> SLIT("r8"); 9 -> SLIT("r9");
323 10 -> SLIT("r10"); 11 -> SLIT("r11");
324 12 -> SLIT("r12"); 13 -> SLIT("r13");
325 14 -> SLIT("r14"); 15 -> SLIT("r15");
326 16 -> SLIT("r16"); 17 -> SLIT("r17");
327 18 -> SLIT("r18"); 19 -> SLIT("r19");
328 20 -> SLIT("r20"); 21 -> SLIT("r21");
329 22 -> SLIT("r22"); 23 -> SLIT("r23");
330 24 -> SLIT("r24"); 25 -> SLIT("r25");
331 26 -> SLIT("r26"); 27 -> SLIT("r27");
332 28 -> SLIT("r28"); 29 -> SLIT("r29");
333 30 -> SLIT("r30"); 31 -> SLIT("r31");
334 32 -> SLIT("f0"); 33 -> SLIT("f1");
335 34 -> SLIT("f2"); 35 -> SLIT("f3");
336 36 -> SLIT("f4"); 37 -> SLIT("f5");
337 38 -> SLIT("f6"); 39 -> SLIT("f7");
338 40 -> SLIT("f8"); 41 -> SLIT("f9");
339 42 -> SLIT("f10"); 43 -> SLIT("f11");
340 44 -> SLIT("f12"); 45 -> SLIT("f13");
341 46 -> SLIT("f14"); 47 -> SLIT("f15");
342 48 -> SLIT("f16"); 49 -> SLIT("f17");
343 50 -> SLIT("f18"); 51 -> SLIT("f19");
344 52 -> SLIT("f20"); 53 -> SLIT("f21");
345 54 -> SLIT("f22"); 55 -> SLIT("f23");
346 56 -> SLIT("f24"); 57 -> SLIT("f25");
347 58 -> SLIT("f26"); 59 -> SLIT("f27");
348 60 -> SLIT("f28"); 61 -> SLIT("f29");
349 62 -> SLIT("f30"); 63 -> SLIT("f31");
350 _ -> SLIT("very naughty powerpc register")
353 ppr_reg_no :: Int -> Doc
354 ppr_reg_no i | i <= 31 = int i -- GPRs
355 | i <= 63 = int (i-32) -- FPRs
356 | otherwise = ptext SLIT("very naughty powerpc register")
361 -- -----------------------------------------------------------------------------
362 -- pprSize: print a 'Size'
364 #if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH || sparc_TARGET_ARCH
365 pprSize :: MachRep -> Doc
367 pprSize :: Size -> Doc
370 pprSize x = ptext (case x of
371 #if alpha_TARGET_ARCH
374 -- W -> SLIT("w") UNUSED
375 -- Wu -> SLIT("wu") UNUSED
378 -- FF -> SLIT("f") UNUSED
379 -- DF -> SLIT("d") UNUSED
380 -- GF -> SLIT("g") UNUSED
381 -- SF -> SLIT("s") UNUSED
384 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
395 #if x86_64_TARGET_ARCH
396 F32 -> SLIT("ss") -- "scalar single-precision float" (SSE2)
397 F64 -> SLIT("sd") -- "scalar double-precision float" (SSE2)
399 #if sparc_TARGET_ARCH
406 pprStSize :: MachRep -> Doc
407 pprStSize x = ptext (case x of
414 #if powerpc_TARGET_ARCH
423 -- -----------------------------------------------------------------------------
424 -- pprCond: print a 'Cond'
426 pprCond :: Cond -> Doc
428 pprCond c = ptext (case c of {
429 #if alpha_TARGET_ARCH
439 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
440 GEU -> SLIT("ae"); LU -> SLIT("b");
441 EQQ -> SLIT("e"); GTT -> SLIT("g");
442 GE -> SLIT("ge"); GU -> SLIT("a");
443 LTT -> SLIT("l"); LE -> SLIT("le");
444 LEU -> SLIT("be"); NE -> SLIT("ne");
445 NEG -> SLIT("s"); POS -> SLIT("ns");
446 CARRY -> SLIT("c"); OFLO -> SLIT("o");
447 PARITY -> SLIT("p"); NOTPARITY -> SLIT("np");
448 ALWAYS -> SLIT("mp") -- hack
450 #if sparc_TARGET_ARCH
451 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
452 GEU -> SLIT("geu"); LU -> SLIT("lu");
453 EQQ -> SLIT("e"); GTT -> SLIT("g");
454 GE -> SLIT("ge"); GU -> SLIT("gu");
455 LTT -> SLIT("l"); LE -> SLIT("le");
456 LEU -> SLIT("leu"); NE -> SLIT("ne");
457 NEG -> SLIT("neg"); POS -> SLIT("pos");
458 VC -> SLIT("vc"); VS -> SLIT("vs")
460 #if powerpc_TARGET_ARCH
462 EQQ -> SLIT("eq"); NE -> SLIT("ne");
463 LTT -> SLIT("lt"); GE -> SLIT("ge");
464 GTT -> SLIT("gt"); LE -> SLIT("le");
465 LU -> SLIT("lt"); GEU -> SLIT("ge");
466 GU -> SLIT("gt"); LEU -> SLIT("le");
471 -- -----------------------------------------------------------------------------
472 -- pprImm: print an 'Imm'
476 pprImm (ImmInt i) = int i
477 pprImm (ImmInteger i) = integer i
478 pprImm (ImmCLbl l) = pprCLabel_asm l
479 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
480 pprImm (ImmLit s) = s
482 pprImm (ImmFloat _) = ptext SLIT("naughty float immediate")
483 pprImm (ImmDouble _) = ptext SLIT("naughty double immediate")
485 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
486 #if sparc_TARGET_ARCH
487 -- ToDo: This should really be fixed in the PIC support, but only
489 pprImm (ImmConstantDiff a b) = pprImm a
491 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
492 <> lparen <> pprImm b <> rparen
495 #if sparc_TARGET_ARCH
497 = hcat [ pp_lo, pprImm i, rparen ]
502 = hcat [ pp_hi, pprImm i, rparen ]
506 #if powerpc_TARGET_ARCH
509 = hcat [ pp_lo, pprImm i, rparen ]
514 = hcat [ pp_hi, pprImm i, rparen ]
519 = hcat [ pp_ha, pprImm i, rparen ]
525 = pprImm i <> text "@l"
528 = pprImm i <> text "@h"
531 = pprImm i <> text "@ha"
536 -- -----------------------------------------------------------------------------
537 -- @pprAddr: print an 'AddrMode'
539 pprAddr :: AddrMode -> Doc
541 #if alpha_TARGET_ARCH
542 pprAddr (AddrReg r) = parens (pprReg r)
543 pprAddr (AddrImm i) = pprImm i
544 pprAddr (AddrRegImm r1 i)
545 = (<>) (pprImm i) (parens (pprReg r1))
550 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
551 pprAddr (ImmAddr imm off)
552 = let pp_imm = pprImm imm
556 else if (off < 0) then
559 pp_imm <> char '+' <> int off
561 pprAddr (AddrBaseIndex base index displacement)
563 pp_disp = ppr_disp displacement
564 pp_off p = pp_disp <> char '(' <> p <> char ')'
565 pp_reg r = pprReg wordRep r
568 (EABaseNone, EAIndexNone) -> pp_disp
569 (EABaseReg b, EAIndexNone) -> pp_off (pp_reg b)
570 (EABaseRip, EAIndexNone) -> pp_off (ptext SLIT("%rip"))
571 (EABaseNone, EAIndex r i) -> pp_off (comma <> pp_reg r <> comma <> int i)
572 (EABaseReg b, EAIndex r i) -> pp_off (pp_reg b <> comma <> pp_reg r
575 ppr_disp (ImmInt 0) = empty
576 ppr_disp imm = pprImm imm
581 #if sparc_TARGET_ARCH
582 pprAddr (AddrRegReg r1 (RealReg 0)) = pprReg r1
584 pprAddr (AddrRegReg r1 r2)
585 = hcat [ pprReg r1, char '+', pprReg r2 ]
587 pprAddr (AddrRegImm r1 (ImmInt i))
589 | not (fits13Bits i) = largeOffsetError i
590 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
592 pp_sign = if i > 0 then char '+' else empty
594 pprAddr (AddrRegImm r1 (ImmInteger i))
596 | not (fits13Bits i) = largeOffsetError i
597 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
599 pp_sign = if i > 0 then char '+' else empty
601 pprAddr (AddrRegImm r1 imm)
602 = hcat [ pprReg r1, char '+', pprImm imm ]
607 #if powerpc_TARGET_ARCH
608 pprAddr (AddrRegReg r1 r2)
609 = pprReg r1 <+> ptext SLIT(", ") <+> pprReg r2
611 pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
612 pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
613 pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
617 -- -----------------------------------------------------------------------------
618 -- pprData: print a 'CmmStatic'
620 pprSectionHeader Text
622 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
623 ,IF_ARCH_sparc(SLIT(".text\n\t.align 4") {-word boundary-}
624 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".text\n\t.align 2"),
625 SLIT(".text\n\t.align 4,0x90"))
626 {-needs per-OS variation!-}
627 ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".text\n.align 3"),
628 SLIT(".text\n\t.align 8"))
629 ,IF_ARCH_powerpc(SLIT(".text\n.align 2")
631 pprSectionHeader Data
633 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
634 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
635 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".data\n\t.align 2"),
636 SLIT(".data\n\t.align 4"))
637 ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".data\n.align 3"),
638 SLIT(".data\n\t.align 8"))
639 ,IF_ARCH_powerpc(SLIT(".data\n.align 2")
641 pprSectionHeader ReadOnlyData
643 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
644 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
645 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const\n.align 2"),
646 SLIT(".section .rodata\n\t.align 4"))
647 ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".const\n.align 3"),
648 SLIT(".section .rodata\n\t.align 8"))
649 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 2"),
650 SLIT(".section .rodata\n\t.align 2"))
652 pprSectionHeader RelocatableReadOnlyData
654 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
655 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
656 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const_data\n.align 2"),
657 SLIT(".section .data\n\t.align 4"))
658 ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".const_data\n.align 3"),
659 SLIT(".section .data\n\t.align 8"))
660 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
661 SLIT(".data\n\t.align 2"))
663 pprSectionHeader UninitialisedData
665 IF_ARCH_alpha(SLIT("\t.bss\n\t.align 3")
666 ,IF_ARCH_sparc(SLIT(".bss\n\t.align 8") {-<8 will break double constants -}
667 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".data\n\t.align 2"),
668 SLIT(".section .bss\n\t.align 4"))
669 ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".data\n\t.align 3"),
670 SLIT(".section .bss\n\t.align 8"))
671 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
672 SLIT(".section .bss\n\t.align 2"))
674 pprSectionHeader ReadOnlyData16
676 IF_ARCH_alpha(SLIT("\t.data\n\t.align 4")
677 ,IF_ARCH_sparc(SLIT(".data\n\t.align 16")
678 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const\n.align 4"),
679 SLIT(".section .rodata\n\t.align 16"))
680 ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".const\n.align 4"),
681 SLIT(".section .rodata.cst16\n\t.align 16"))
682 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 4"),
683 SLIT(".section .rodata\n\t.align 4"))
686 pprSectionHeader (OtherSection sec)
687 = panic "PprMach.pprSectionHeader: unknown section"
689 pprData :: CmmStatic -> Doc
690 pprData (CmmAlign bytes) = pprAlign bytes
691 pprData (CmmDataLabel lbl) = pprLabel lbl
692 pprData (CmmString str) = pprASCII str
693 pprData (CmmUninitialised bytes) = ptext SLIT(".space ") <> int bytes
694 pprData (CmmStaticLit lit) = pprDataItem lit
696 pprGloblDecl :: CLabel -> Doc
698 | not (externallyVisibleCLabel lbl) = empty
699 | otherwise = ptext IF_ARCH_sparc(SLIT(".global "),
703 pprTypeAndSizeDecl :: CLabel -> Doc
704 pprTypeAndSizeDecl lbl
706 | not (externallyVisibleCLabel lbl) = empty
707 | otherwise = ptext SLIT(".type ") <>
708 pprCLabel_asm lbl <> ptext SLIT(", @object")
713 pprLabel :: CLabel -> Doc
714 pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':')
718 = vcat (map do1 str) $$ do1 0
721 do1 w = ptext SLIT("\t.byte\t") <> int (fromIntegral w)
724 IF_ARCH_alpha(ptextSLIT(".align ") <> int pow2,
725 IF_ARCH_i386(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes),
726 IF_ARCH_x86_64(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes),
727 IF_ARCH_sparc(ptext SLIT(".align ") <> int bytes,
728 IF_ARCH_powerpc(ptext SLIT(".align ") <> int pow2,)))))
732 log2 :: Int -> Int -- cache the common ones
737 log2 n = 1 + log2 (n `quot` 2)
740 pprDataItem :: CmmLit -> Doc
742 = vcat (ppr_item (cmmLitRep lit) lit)
746 -- These seem to be common:
747 ppr_item I8 x = [ptext SLIT("\t.byte\t") <> pprImm imm]
748 ppr_item I32 x = [ptext SLIT("\t.long\t") <> pprImm imm]
749 ppr_item F32 (CmmFloat r _)
750 = let bs = floatToBytes (fromRational r)
751 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
752 ppr_item F64 (CmmFloat r _)
753 = let bs = doubleToBytes (fromRational r)
754 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
756 #if sparc_TARGET_ARCH
757 -- copy n paste of x86 version
758 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
759 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
761 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
762 ppr_item I16 x = [ptext SLIT("\t.word\t") <> pprImm imm]
764 #if i386_TARGET_ARCH && darwin_TARGET_OS
765 ppr_item I64 (CmmInt x _) =
766 [ptext SLIT("\t.long\t")
767 <> int (fromIntegral (fromIntegral x :: Word32)),
768 ptext SLIT("\t.long\t")
770 (fromIntegral (x `shiftR` 32) :: Word32))]
772 #if i386_TARGET_ARCH || (darwin_TARGET_OS && x86_64_TARGET_ARCH)
773 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
775 #if x86_64_TARGET_ARCH && !darwin_TARGET_OS
776 -- x86_64: binutils can't handle the R_X86_64_PC64 relocation
777 -- type, which means we can't do pc-relative 64-bit addresses.
778 -- Fortunately we're assuming the small memory model, in which
779 -- all such offsets will fit into 32 bits, so we have to stick
780 -- to 32-bit offset fields and modify the RTS appropriately
782 -- See Note [x86-64-relative] in includes/InfoTables.h
785 | isRelativeReloc x =
786 [ptext SLIT("\t.long\t") <> pprImm imm,
787 ptext SLIT("\t.long\t0")]
789 [ptext SLIT("\t.quad\t") <> pprImm imm]
791 isRelativeReloc (CmmLabelDiffOff _ _ _) = True
792 isRelativeReloc _ = False
794 #if powerpc_TARGET_ARCH
795 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
796 ppr_item I64 (CmmInt x _) =
797 [ptext SLIT("\t.long\t")
799 (fromIntegral (x `shiftR` 32) :: Word32)),
800 ptext SLIT("\t.long\t")
801 <> int (fromIntegral (fromIntegral x :: Word32))]
804 -- fall through to rest of (machine-specific) pprInstr...
806 -- -----------------------------------------------------------------------------
807 -- pprInstr: print an 'Instr'
809 instance Outputable Instr where
810 ppr instr = Outputable.docToSDoc $ pprInstr instr
812 pprInstr :: Instr -> Doc
814 --pprInstr (COMMENT s) = empty -- nuke 'em
816 = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
817 ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ftext s))
818 ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ftext s))
819 ,IF_ARCH_x86_64( ((<>) (ptext SLIT("# ")) (ftext s))
820 ,IF_ARCH_powerpc( IF_OS_linux(
821 ((<>) (ptext SLIT("# ")) (ftext s)),
822 ((<>) (ptext SLIT("; ")) (ftext s)))
826 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
828 pprInstr (NEWBLOCK _)
829 = panic "PprMach.pprInstr: NEWBLOCK"
832 = panic "PprMach.pprInstr: LDATA"
834 -- -----------------------------------------------------------------------------
835 -- pprInstr for an Alpha
837 #if alpha_TARGET_ARCH
839 pprInstr (SPILL reg slot)
841 ptext SLIT("\tSPILL"),
845 ptext SLIT("SLOT") <> parens (int slot)]
847 pprInstr (RELOAD slot reg)
849 ptext SLIT("\tRELOAD"),
851 ptext SLIT("SLOT") <> parens (int slot),
855 pprInstr (LD size reg addr)
865 pprInstr (LDA reg addr)
867 ptext SLIT("\tlda\t"),
873 pprInstr (LDAH reg addr)
875 ptext SLIT("\tldah\t"),
881 pprInstr (LDGP reg addr)
883 ptext SLIT("\tldgp\t"),
889 pprInstr (LDI size reg imm)
899 pprInstr (ST size reg addr)
911 ptext SLIT("\tclr\t"),
915 pprInstr (ABS size ri reg)
925 pprInstr (NEG size ov ri reg)
929 if ov then ptext SLIT("v\t") else char '\t',
935 pprInstr (ADD size ov reg1 ri reg2)
939 if ov then ptext SLIT("v\t") else char '\t',
947 pprInstr (SADD size scale reg1 ri reg2)
949 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
960 pprInstr (SUB size ov reg1 ri reg2)
964 if ov then ptext SLIT("v\t") else char '\t',
972 pprInstr (SSUB size scale reg1 ri reg2)
974 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
985 pprInstr (MUL size ov reg1 ri reg2)
989 if ov then ptext SLIT("v\t") else char '\t',
997 pprInstr (DIV size uns reg1 ri reg2)
1001 if uns then ptext SLIT("u\t") else char '\t',
1009 pprInstr (REM size uns reg1 ri reg2)
1011 ptext SLIT("\trem"),
1013 if uns then ptext SLIT("u\t") else char '\t',
1021 pprInstr (NOT ri reg)
1023 ptext SLIT("\tnot"),
1030 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
1031 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
1032 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
1033 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
1034 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
1035 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
1037 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
1038 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
1039 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
1041 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
1042 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
1044 pprInstr (NOP) = ptext SLIT("\tnop")
1046 pprInstr (CMP cond reg1 ri reg2)
1048 ptext SLIT("\tcmp"),
1060 ptext SLIT("\tfclr\t"),
1064 pprInstr (FABS reg1 reg2)
1066 ptext SLIT("\tfabs\t"),
1072 pprInstr (FNEG size reg1 reg2)
1074 ptext SLIT("\tneg"),
1082 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
1083 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
1084 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
1085 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
1087 pprInstr (CVTxy size1 size2 reg1 reg2)
1089 ptext SLIT("\tcvt"),
1091 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
1098 pprInstr (FCMP size cond reg1 reg2 reg3)
1100 ptext SLIT("\tcmp"),
1111 pprInstr (FMOV reg1 reg2)
1113 ptext SLIT("\tfmov\t"),
1119 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
1121 pprInstr (BI NEVER reg lab) = empty
1123 pprInstr (BI cond reg lab)
1133 pprInstr (BF cond reg lab)
1144 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
1146 pprInstr (JMP reg addr hint)
1148 ptext SLIT("\tjmp\t"),
1156 pprInstr (BSR imm n)
1157 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
1159 pprInstr (JSR reg addr n)
1161 ptext SLIT("\tjsr\t"),
1167 pprInstr (FUNBEGIN clab)
1169 if (externallyVisibleCLabel clab) then
1170 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
1173 ptext SLIT("\t.ent "),
1182 pp_lab = pprCLabel_asm clab
1184 -- NEVER use commas within those string literals, cpp will ruin your day
1185 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
1186 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
1187 ptext SLIT("4240"), char ',',
1188 ptext SLIT("$26"), char ',',
1189 ptext SLIT("0\n\t.prologue 1") ]
1191 pprInstr (FUNEND clab)
1192 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
1195 Continue with Alpha-only printing bits and bobs:
1199 pprRI (RIReg r) = pprReg r
1200 pprRI (RIImm r) = pprImm r
1202 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
1203 pprRegRIReg name reg1 ri reg2
1215 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1216 pprSizeRegRegReg name size reg1 reg2 reg3
1229 #endif /* alpha_TARGET_ARCH */
1232 -- -----------------------------------------------------------------------------
1233 -- pprInstr for an x86
1235 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1237 pprInstr (SPILL reg slot)
1239 ptext SLIT("\tSPILL"),
1243 ptext SLIT("SLOT") <> parens (int slot)]
1245 pprInstr (RELOAD slot reg)
1247 ptext SLIT("\tRELOAD"),
1249 ptext SLIT("SLOT") <> parens (int slot),
1253 pprInstr (MOV size src dst)
1254 = pprSizeOpOp SLIT("mov") size src dst
1256 pprInstr (MOVZxL I32 src dst) = pprSizeOpOp SLIT("mov") I32 src dst
1257 -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
1258 -- movl. But we represent it as a MOVZxL instruction, because
1259 -- the reg alloc would tend to throw away a plain reg-to-reg
1260 -- move, and we still want it to do that.
1262 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes I32 src dst
1263 -- zero-extension only needs to extend to 32 bits: on x86_64,
1264 -- the remaining zero-extension to 64 bits is automatic, and the 32-bit
1265 -- instruction is shorter.
1267 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes wordRep src dst
1269 -- here we do some patching, since the physical registers are only set late
1270 -- in the code generation.
1271 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1273 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
1274 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1276 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
1277 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
1279 = pprInstr (ADD size (OpImm displ) dst)
1280 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
1282 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
1283 = pprSizeOp SLIT("dec") size dst
1284 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
1285 = pprSizeOp SLIT("inc") size dst
1286 pprInstr (ADD size src dst)
1287 = pprSizeOpOp SLIT("add") size src dst
1288 pprInstr (ADC size src dst)
1289 = pprSizeOpOp SLIT("adc") size src dst
1290 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
1291 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1293 {- A hack. The Intel documentation says that "The two and three
1294 operand forms [of IMUL] may also be used with unsigned operands
1295 because the lower half of the product is the same regardless if
1296 (sic) the operands are signed or unsigned. The CF and OF flags,
1297 however, cannot be used to determine if the upper half of the
1298 result is non-zero." So there.
1300 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
1301 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
1303 pprInstr (XOR F32 src dst) = pprOpOp SLIT("xorps") F32 src dst
1304 pprInstr (XOR F64 src dst) = pprOpOp SLIT("xorpd") F64 src dst
1305 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
1307 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
1308 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
1310 pprInstr (SHL size src dst) = pprShift SLIT("shl") size src dst
1311 pprInstr (SAR size src dst) = pprShift SLIT("sar") size src dst
1312 pprInstr (SHR size src dst) = pprShift SLIT("shr") size src dst
1314 pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src
1316 pprInstr (CMP size src dst)
1317 | isFloatingRep size = pprSizeOpOp SLIT("ucomi") size src dst -- SSE2
1318 | otherwise = pprSizeOpOp SLIT("cmp") size src dst
1320 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
1321 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
1322 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
1324 -- both unused (SDM):
1325 -- pprInstr PUSHA = ptext SLIT("\tpushal")
1326 -- pprInstr POPA = ptext SLIT("\tpopal")
1328 pprInstr NOP = ptext SLIT("\tnop")
1329 pprInstr (CLTD I32) = ptext SLIT("\tcltd")
1330 pprInstr (CLTD I64) = ptext SLIT("\tcqto")
1332 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand I8 op)
1334 pprInstr (JXX cond (BlockId id))
1335 = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
1336 where lab = mkAsmTempLabel id
1338 pprInstr (JXX_GBL cond imm) = pprCondInstr SLIT("j") cond (pprImm imm)
1340 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
1341 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep op)
1342 pprInstr (JMP_TBL op ids) = pprInstr (JMP op)
1343 pprInstr (CALL (Left imm) _) = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
1344 pprInstr (CALL (Right reg) _) = (<>) (ptext SLIT("\tcall *")) (pprReg wordRep reg)
1346 pprInstr (IDIV sz op) = pprSizeOp SLIT("idiv") sz op
1347 pprInstr (DIV sz op) = pprSizeOp SLIT("div") sz op
1348 pprInstr (IMUL2 sz op) = pprSizeOp SLIT("imul") sz op
1350 #if x86_64_TARGET_ARCH
1351 pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("mul") size op1 op2
1353 pprInstr (FDIV size op1 op2) = pprSizeOpOp SLIT("div") size op1 op2
1355 pprInstr (CVTSS2SD from to) = pprRegReg SLIT("cvtss2sd") from to
1356 pprInstr (CVTSD2SS from to) = pprRegReg SLIT("cvtsd2ss") from to
1357 pprInstr (CVTTSS2SIQ from to) = pprOpReg SLIT("cvttss2siq") from to
1358 pprInstr (CVTTSD2SIQ from to) = pprOpReg SLIT("cvttsd2siq") from to
1359 pprInstr (CVTSI2SS from to) = pprOpReg SLIT("cvtsi2ssq") from to
1360 pprInstr (CVTSI2SD from to) = pprOpReg SLIT("cvtsi2sdq") from to
1363 -- FETCHGOT for PIC on ELF platforms
1364 pprInstr (FETCHGOT reg)
1365 = vcat [ ptext SLIT("\tcall 1f"),
1366 hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ],
1367 hcat [ ptext SLIT("\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
1371 -- FETCHPC for PIC on Darwin/x86
1372 -- get the instruction pointer into a register
1373 -- (Terminology note: the IP is called Program Counter on PPC,
1374 -- and it's a good thing to use the same name on both platforms)
1375 pprInstr (FETCHPC reg)
1376 = vcat [ ptext SLIT("\tcall 1f"),
1377 hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ]
1384 -- -----------------------------------------------------------------------------
1385 -- i386 floating-point
1387 #if i386_TARGET_ARCH
1388 -- Simulating a flat register set on the x86 FP stack is tricky.
1389 -- you have to free %st(7) before pushing anything on the FP reg stack
1390 -- so as to preclude the possibility of a FP stack overflow exception.
1391 pprInstr g@(GMOV src dst)
1395 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1397 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1398 pprInstr g@(GLD sz addr dst)
1399 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1400 pprAddr addr, gsemi, gpop dst 1])
1402 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1403 pprInstr g@(GST sz src addr)
1404 = pprG g (hcat [gtab, gpush src 0, gsemi,
1405 text "fstp", pprSize sz, gsp, pprAddr addr])
1407 pprInstr g@(GLDZ dst)
1408 = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
1409 pprInstr g@(GLD1 dst)
1410 = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
1412 pprInstr g@(GFTOI src dst)
1413 = pprInstr (GDTOI src dst)
1414 pprInstr g@(GDTOI src dst)
1415 = pprG g (hcat [gtab, text "subl $4, %esp ; ",
1416 gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ",
1419 pprInstr g@(GITOF src dst)
1420 = pprInstr (GITOD src dst)
1421 pprInstr g@(GITOD src dst)
1422 = pprG g (hcat [gtab, text "pushl ", pprReg I32 src,
1423 text " ; ffree %st(7); fildl (%esp) ; ",
1424 gpop dst 1, text " ; addl $4,%esp"])
1426 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
1427 this far into the jungle AND you give a Rat's Ass (tm) what's going
1428 on, here's the deal. Generate code to do a floating point comparison
1429 of src1 and src2, of kind cond, and set the Zero flag if true.
1431 The complications are to do with handling NaNs correctly. We want the
1432 property that if either argument is NaN, then the result of the
1433 comparison is False ... except if we're comparing for inequality,
1434 in which case the answer is True.
1436 Here's how the general (non-inequality) case works. As an
1437 example, consider generating the an equality test:
1439 pushl %eax -- we need to mess with this
1440 <get src1 to top of FPU stack>
1441 fcomp <src2 location in FPU stack> and pop pushed src1
1442 -- Result of comparison is in FPU Status Register bits
1444 fstsw %ax -- Move FPU Status Reg to %ax
1445 sahf -- move C3 C2 C0 from %ax to integer flag reg
1446 -- now the serious magic begins
1447 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
1448 sete %al -- %al = if arg1 == arg2 then 1 else 0
1449 andb %ah,%al -- %al &= %ah
1450 -- so %al == 1 iff (comparable && same); else it holds 0
1451 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
1452 else %al == 0xFF, ZeroFlag=0
1453 -- the zero flag is now set as we desire.
1456 The special case of inequality differs thusly:
1458 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
1459 setne %al -- %al = if arg1 /= arg2 then 1 else 0
1460 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
1461 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
1462 else (%al == 0xFF, ZF=0)
1464 pprInstr g@(GCMP cond src1 src2)
1465 | case cond of { NE -> True; other -> False }
1467 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1468 hcat [gtab, text "fcomp ", greg src2 1,
1469 text "; fstsw %ax ; sahf ; setpe %ah"],
1470 hcat [gtab, text "setne %al ; ",
1471 text "orb %ah,%al ; decb %al ; popl %eax"]
1475 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1476 hcat [gtab, text "fcomp ", greg src2 1,
1477 text "; fstsw %ax ; sahf ; setpo %ah"],
1478 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
1479 text "andb %ah,%al ; decb %al ; popl %eax"]
1482 {- On the 486, the flags set by FP compare are the unsigned ones!
1483 (This looks like a HACK to me. WDP 96/03)
1485 fix_FP_cond :: Cond -> Cond
1486 fix_FP_cond GE = GEU
1487 fix_FP_cond GTT = GU
1488 fix_FP_cond LTT = LU
1489 fix_FP_cond LE = LEU
1490 fix_FP_cond EQQ = EQQ
1492 -- there should be no others
1495 pprInstr g@(GABS sz src dst)
1496 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1497 pprInstr g@(GNEG sz src dst)
1498 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1500 pprInstr g@(GSQRT sz src dst)
1501 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1502 hcat [gtab, gcoerceto sz, gpop dst 1])
1503 pprInstr g@(GSIN sz src dst)
1504 = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1505 hcat [gtab, gcoerceto sz, gpop dst 1])
1506 pprInstr g@(GCOS sz src dst)
1507 = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1508 hcat [gtab, gcoerceto sz, gpop dst 1])
1509 pprInstr g@(GTAN sz src dst)
1510 = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1511 gpush src 0, text " ; fptan ; ",
1512 text " fstp %st(0)"] $$
1513 hcat [gtab, gcoerceto sz, gpop dst 1])
1515 -- In the translations for GADD, GMUL, GSUB and GDIV,
1516 -- the first two cases are mere optimisations. The otherwise clause
1517 -- generates correct code under all circumstances.
1519 pprInstr g@(GADD sz src1 src2 dst)
1521 = pprG g (text "\t#GADD-xxxcase1" $$
1522 hcat [gtab, gpush src2 0,
1523 text " ; faddp %st(0),", greg src1 1])
1525 = pprG g (text "\t#GADD-xxxcase2" $$
1526 hcat [gtab, gpush src1 0,
1527 text " ; faddp %st(0),", greg src2 1])
1529 = pprG g (hcat [gtab, gpush src1 0,
1530 text " ; fadd ", greg src2 1, text ",%st(0)",
1534 pprInstr g@(GMUL sz src1 src2 dst)
1536 = pprG g (text "\t#GMUL-xxxcase1" $$
1537 hcat [gtab, gpush src2 0,
1538 text " ; fmulp %st(0),", greg src1 1])
1540 = pprG g (text "\t#GMUL-xxxcase2" $$
1541 hcat [gtab, gpush src1 0,
1542 text " ; fmulp %st(0),", greg src2 1])
1544 = pprG g (hcat [gtab, gpush src1 0,
1545 text " ; fmul ", greg src2 1, text ",%st(0)",
1549 pprInstr g@(GSUB sz src1 src2 dst)
1551 = pprG g (text "\t#GSUB-xxxcase1" $$
1552 hcat [gtab, gpush src2 0,
1553 text " ; fsubrp %st(0),", greg src1 1])
1555 = pprG g (text "\t#GSUB-xxxcase2" $$
1556 hcat [gtab, gpush src1 0,
1557 text " ; fsubp %st(0),", greg src2 1])
1559 = pprG g (hcat [gtab, gpush src1 0,
1560 text " ; fsub ", greg src2 1, text ",%st(0)",
1564 pprInstr g@(GDIV sz src1 src2 dst)
1566 = pprG g (text "\t#GDIV-xxxcase1" $$
1567 hcat [gtab, gpush src2 0,
1568 text " ; fdivrp %st(0),", greg src1 1])
1570 = pprG g (text "\t#GDIV-xxxcase2" $$
1571 hcat [gtab, gpush src1 0,
1572 text " ; fdivp %st(0),", greg src2 1])
1574 = pprG g (hcat [gtab, gpush src1 0,
1575 text " ; fdiv ", greg src2 1, text ",%st(0)",
1580 = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1581 ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1584 --------------------------
1586 -- coerce %st(0) to the specified size
1587 gcoerceto F64 = empty
1588 gcoerceto F32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1591 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1593 = hcat [text "fstp ", greg reg offset]
1595 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1600 gregno (RealReg i) = i
1601 gregno other = --pprPanic "gregno" (ppr other)
1602 999 -- bogus; only needed for debug printing
1604 pprG :: Instr -> Doc -> Doc
1606 = (char '#' <> pprGInstr fake) $$ actual
1608 pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") F64 src dst
1609 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1610 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1612 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") F64 dst
1613 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") F64 dst
1615 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F32 I32 src dst
1616 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") F64 I32 src dst
1618 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") I32 F32 src dst
1619 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") I32 F64 src dst
1621 pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") F64 co src dst
1622 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1623 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1624 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1625 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1626 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1627 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1629 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1630 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1631 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1632 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1635 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1637 -- Continue with I386-only printing bits and bobs:
1639 pprDollImm :: Imm -> Doc
1641 pprDollImm i = ptext SLIT("$") <> pprImm i
1643 pprOperand :: MachRep -> Operand -> Doc
1644 pprOperand s (OpReg r) = pprReg s r
1645 pprOperand s (OpImm i) = pprDollImm i
1646 pprOperand s (OpAddr ea) = pprAddr ea
1648 pprMnemonic_ :: LitString -> Doc
1650 char '\t' <> ptext name <> space
1652 pprMnemonic :: LitString -> MachRep -> Doc
1653 pprMnemonic name size =
1654 char '\t' <> ptext name <> pprSize size <> space
1656 pprSizeImmOp :: LitString -> MachRep -> Imm -> Operand -> Doc
1657 pprSizeImmOp name size imm op1
1659 pprMnemonic name size,
1666 pprSizeOp :: LitString -> MachRep -> Operand -> Doc
1667 pprSizeOp name size op1
1669 pprMnemonic name size,
1673 pprSizeOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1674 pprSizeOpOp name size op1 op2
1676 pprMnemonic name size,
1677 pprOperand size op1,
1682 pprOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1683 pprOpOp name size op1 op2
1686 pprOperand size op1,
1691 pprSizeReg :: LitString -> MachRep -> Reg -> Doc
1692 pprSizeReg name size reg1
1694 pprMnemonic name size,
1698 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1699 pprSizeRegReg name size reg1 reg2
1701 pprMnemonic name size,
1707 pprRegReg :: LitString -> Reg -> Reg -> Doc
1708 pprRegReg name reg1 reg2
1711 pprReg wordRep reg1,
1716 pprOpReg :: LitString -> Operand -> Reg -> Doc
1717 pprOpReg name op1 reg2
1720 pprOperand wordRep op1,
1725 pprCondRegReg :: LitString -> MachRep -> Cond -> Reg -> Reg -> Doc
1726 pprCondRegReg name size cond reg1 reg2
1737 pprSizeSizeRegReg :: LitString -> MachRep -> MachRep -> Reg -> Reg -> Doc
1738 pprSizeSizeRegReg name size1 size2 reg1 reg2
1751 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
1752 pprSizeRegRegReg name size reg1 reg2 reg3
1754 pprMnemonic name size,
1762 pprSizeAddrReg :: LitString -> MachRep -> AddrMode -> Reg -> Doc
1763 pprSizeAddrReg name size op dst
1765 pprMnemonic name size,
1771 pprSizeRegAddr :: LitString -> MachRep -> Reg -> AddrMode -> Doc
1772 pprSizeRegAddr name size src op
1774 pprMnemonic name size,
1780 pprShift :: LitString -> MachRep -> Operand -> Operand -> Doc
1781 pprShift name size src dest
1783 pprMnemonic name size,
1784 pprOperand I8 src, -- src is 8-bit sized
1786 pprOperand size dest
1789 pprSizeOpOpCoerce :: LitString -> MachRep -> MachRep -> Operand -> Operand -> Doc
1790 pprSizeOpOpCoerce name size1 size2 op1 op2
1791 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1792 pprOperand size1 op1,
1794 pprOperand size2 op2
1797 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1798 pprCondInstr name cond arg
1799 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1801 #endif /* i386_TARGET_ARCH */
1804 -- ------------------------------------------------------------------------------- pprInstr for a SPARC
1806 #if sparc_TARGET_ARCH
1808 -- a clumsy hack for now, to handle possible double alignment problems
1810 -- even clumsier, to allow for RegReg regs that show when doing indexed
1811 -- reads (bytearrays).
1814 pprInstr (SPILL reg slot)
1816 ptext SLIT("\tSPILL"),
1820 ptext SLIT("SLOT") <> parens (int slot)]
1822 pprInstr (RELOAD slot reg)
1824 ptext SLIT("\tRELOAD"),
1826 ptext SLIT("SLOT") <> parens (int slot),
1830 -- Translate to the following:
1833 -- ld [g1+4],%f(n+1)
1834 -- sub g1,g2,g1 -- to restore g1
1836 pprInstr (LD F64 (AddrRegReg g1 g2) reg)
1838 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1839 hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1840 hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1841 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1846 -- ld [addr+4],%f(n+1)
1847 pprInstr (LD F64 addr reg) | isJust off_addr
1849 hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1850 hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1853 off_addr = addrOffset addr 4
1854 addr2 = case off_addr of Just x -> x
1857 pprInstr (LD size addr reg)
1868 -- The same clumsy hack as above
1870 -- Translate to the following:
1873 -- st %f(n+1),[g1+4]
1874 -- sub g1,g2,g1 -- to restore g1
1875 pprInstr (ST F64 reg (AddrRegReg g1 g2))
1877 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1878 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1880 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1881 pprReg g1, ptext SLIT("+4]")],
1882 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1887 -- st %f(n+1),[addr+4]
1888 pprInstr (ST F64 reg addr) | isJust off_addr
1890 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1891 pprAddr addr, rbrack],
1892 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1893 pprAddr addr2, rbrack]
1896 off_addr = addrOffset addr 4
1897 addr2 = case off_addr of Just x -> x
1899 -- no distinction is made between signed and unsigned bytes on stores for the
1900 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1901 -- so we call a special-purpose pprSize for ST..
1903 pprInstr (ST size reg addr)
1914 pprInstr (ADD x cc reg1 ri reg2)
1915 | not x && not cc && riZero ri
1916 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1918 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1920 pprInstr (SUB x cc reg1 ri reg2)
1921 | not x && cc && reg2 == g0
1922 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1923 | not x && not cc && riZero ri
1924 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1926 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1928 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1929 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1931 pprInstr (OR b reg1 ri reg2)
1932 | not b && reg1 == g0
1933 = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1935 RIReg rrr | rrr == reg2 -> empty
1938 = pprRegRIReg SLIT("or") b reg1 ri reg2
1940 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1942 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1943 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1945 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1946 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1947 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1949 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1950 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul") b reg1 ri reg2
1951 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul") b reg1 ri reg2
1953 pprInstr (SETHI imm reg)
1955 ptext SLIT("\tsethi\t"),
1961 pprInstr NOP = ptext SLIT("\tnop")
1963 pprInstr (FABS F32 reg1 reg2) = pprSizeRegReg SLIT("fabs") F32 reg1 reg2
1964 pprInstr (FABS F64 reg1 reg2)
1965 = (<>) (pprSizeRegReg SLIT("fabs") F32 reg1 reg2)
1966 (if (reg1 == reg2) then empty
1967 else (<>) (char '\n')
1968 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1970 pprInstr (FADD size reg1 reg2 reg3)
1971 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1972 pprInstr (FCMP e size reg1 reg2)
1973 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1974 pprInstr (FDIV size reg1 reg2 reg3)
1975 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1977 pprInstr (FMOV F32 reg1 reg2) = pprSizeRegReg SLIT("fmov") F32 reg1 reg2
1978 pprInstr (FMOV F64 reg1 reg2)
1979 = (<>) (pprSizeRegReg SLIT("fmov") F32 reg1 reg2)
1980 (if (reg1 == reg2) then empty
1981 else (<>) (char '\n')
1982 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1984 pprInstr (FMUL size reg1 reg2 reg3)
1985 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1987 pprInstr (FNEG F32 reg1 reg2) = pprSizeRegReg SLIT("fneg") F32 reg1 reg2
1988 pprInstr (FNEG F64 reg1 reg2)
1989 = (<>) (pprSizeRegReg SLIT("fneg") F32 reg1 reg2)
1990 (if (reg1 == reg2) then empty
1991 else (<>) (char '\n')
1992 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1994 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1995 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1996 pprInstr (FxTOy size1 size2 reg1 reg2)
2003 F64 -> SLIT("dto")),
2008 F64 -> SLIT("d\t")),
2009 pprReg reg1, comma, pprReg reg2
2013 pprInstr (BI cond b lab)
2015 ptext SLIT("\tb"), pprCond cond,
2016 if b then pp_comma_a else empty,
2021 pprInstr (BF cond b lab)
2023 ptext SLIT("\tfb"), pprCond cond,
2024 if b then pp_comma_a else empty,
2029 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
2031 pprInstr (CALL (Left imm) n _)
2032 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
2033 pprInstr (CALL (Right reg) n _)
2034 = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
2037 pprRI (RIReg r) = pprReg r
2038 pprRI (RIImm r) = pprImm r
2040 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
2041 pprSizeRegReg name size reg1 reg2
2046 F32 -> ptext SLIT("s\t")
2047 F64 -> ptext SLIT("d\t")),
2053 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
2054 pprSizeRegRegReg name size reg1 reg2 reg3
2059 F32 -> ptext SLIT("s\t")
2060 F64 -> ptext SLIT("d\t")),
2068 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
2069 pprRegRIReg name b reg1 ri reg2
2073 if b then ptext SLIT("cc\t") else char '\t',
2081 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
2082 pprRIReg name b ri reg1
2086 if b then ptext SLIT("cc\t") else char '\t',
2092 pp_ld_lbracket = ptext SLIT("\tld\t[")
2093 pp_rbracket_comma = text "],"
2094 pp_comma_lbracket = text ",["
2095 pp_comma_a = text ",a"
2097 #endif /* sparc_TARGET_ARCH */
2100 -- -----------------------------------------------------------------------------
2101 -- pprInstr for PowerPC
2103 #if powerpc_TARGET_ARCH
2105 pprInstr (SPILL reg slot)
2107 ptext SLIT("\tSPILL"),
2111 ptext SLIT("SLOT") <> parens (int slot)]
2113 pprInstr (RELOAD slot reg)
2115 ptext SLIT("\tRELOAD"),
2117 ptext SLIT("SLOT") <> parens (int slot),
2121 pprInstr (LD sz reg addr) = hcat [
2130 case addr of AddrRegImm _ _ -> empty
2131 AddrRegReg _ _ -> char 'x',
2137 pprInstr (LA sz reg addr) = hcat [
2146 case addr of AddrRegImm _ _ -> empty
2147 AddrRegReg _ _ -> char 'x',
2153 pprInstr (ST sz reg addr) = hcat [
2157 case addr of AddrRegImm _ _ -> empty
2158 AddrRegReg _ _ -> char 'x',
2164 pprInstr (STU sz reg addr) = hcat [
2169 case addr of AddrRegImm _ _ -> empty
2170 AddrRegReg _ _ -> char 'x',
2175 pprInstr (LIS reg imm) = hcat [
2183 pprInstr (LI reg imm) = hcat [
2191 pprInstr (MR reg1 reg2)
2192 | reg1 == reg2 = empty
2193 | otherwise = hcat [
2195 case regClass reg1 of
2196 RcInteger -> ptext SLIT("mr")
2197 _ -> ptext SLIT("fmr"),
2203 pprInstr (CMP sz reg ri) = hcat [
2219 pprInstr (CMPL sz reg ri) = hcat [
2235 pprInstr (BCC cond (BlockId id)) = hcat [
2242 where lbl = mkAsmTempLabel id
2244 pprInstr (BCCFAR cond (BlockId id)) = vcat [
2247 pprCond (condNegate cond),
2251 ptext SLIT("\tb\t"),
2255 where lbl = mkAsmTempLabel id
2257 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
2264 pprInstr (MTCTR reg) = hcat [
2266 ptext SLIT("mtctr"),
2270 pprInstr (BCTR _) = hcat [
2274 pprInstr (BL lbl _) = hcat [
2275 ptext SLIT("\tbl\t"),
2278 pprInstr (BCTRL _) = hcat [
2282 pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
2283 pprInstr (ADDIS reg1 reg2 imm) = hcat [
2285 ptext SLIT("addis"),
2294 pprInstr (ADDC reg1 reg2 reg3) = pprLogic SLIT("addc") reg1 reg2 (RIReg reg3)
2295 pprInstr (ADDE reg1 reg2 reg3) = pprLogic SLIT("adde") reg1 reg2 (RIReg reg3)
2296 pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
2297 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
2298 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
2299 pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
2300 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3)
2302 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
2303 hcat [ ptext SLIT("\tmullwo\t"), pprReg reg1, ptext SLIT(", "),
2304 pprReg reg2, ptext SLIT(", "),
2306 hcat [ ptext SLIT("\tmfxer\t"), pprReg reg1 ],
2307 hcat [ ptext SLIT("\trlwinm\t"), pprReg reg1, ptext SLIT(", "),
2308 pprReg reg1, ptext SLIT(", "),
2309 ptext SLIT("2, 31, 31") ]
2312 -- for some reason, "andi" doesn't exist.
2313 -- we'll use "andi." instead.
2314 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
2316 ptext SLIT("andi."),
2324 pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 ri
2326 pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 ri
2327 pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 ri
2329 pprInstr (XORIS reg1 reg2 imm) = hcat [
2331 ptext SLIT("xoris"),
2340 pprInstr (EXTS sz reg1 reg2) = hcat [
2350 pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2
2351 pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2
2353 pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 (limitShiftRI ri)
2354 pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 (limitShiftRI ri)
2355 pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 (limitShiftRI ri)
2356 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
2357 ptext SLIT("\trlwinm\t"),
2369 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
2370 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
2371 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
2372 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
2373 pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
2375 pprInstr (FCMP reg1 reg2) = hcat [
2377 ptext SLIT("fcmpu\tcr0, "),
2378 -- Note: we're using fcmpu, not fcmpo
2379 -- The difference is with fcmpo, compare with NaN is an invalid operation.
2380 -- We don't handle invalid fp ops, so we don't care
2386 pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
2387 pprInstr (FRSP reg1 reg2) = pprUnary SLIT("frsp") reg1 reg2
2389 pprInstr (CRNOR dst src1 src2) = hcat [
2390 ptext SLIT("\tcrnor\t"),
2398 pprInstr (MFCR reg) = hcat [
2405 pprInstr (MFLR reg) = hcat [
2412 pprInstr (FETCHPC reg) = vcat [
2413 ptext SLIT("\tbcl\t20,31,1f"),
2414 hcat [ ptext SLIT("1:\tmflr\t"), pprReg reg ]
2417 pprInstr LWSYNC = ptext SLIT("\tlwsync")
2419 pprInstr _ = panic "pprInstr (ppc)"
2421 pprLogic op reg1 reg2 ri = hcat [
2426 RIImm _ -> char 'i',
2435 pprUnary op reg1 reg2 = hcat [
2444 pprBinaryF op sz reg1 reg2 reg3 = hcat [
2457 pprRI (RIReg r) = pprReg r
2458 pprRI (RIImm r) = pprImm r
2460 pprFSize F64 = empty
2461 pprFSize F32 = char 's'
2463 -- limit immediate argument for shift instruction to range 0..32
2464 -- (yes, the maximum is really 32, not 31)
2465 limitShiftRI :: RI -> RI
2466 limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
2469 #endif /* powerpc_TARGET_ARCH */
2472 -- -----------------------------------------------------------------------------
2473 -- Converting floating-point literals to integrals for printing
2475 castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)
2476 castFloatToWord8Array = castSTUArray
2478 castDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8)
2479 castDoubleToWord8Array = castSTUArray
2481 -- floatToBytes and doubleToBytes convert to the host's byte
2482 -- order. Providing that we're not cross-compiling for a
2483 -- target with the opposite endianness, this should work ok
2486 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
2487 -- could they be merged?
2489 floatToBytes :: Float -> [Int]
2492 arr <- newArray_ ((0::Int),3)
2494 arr <- castFloatToWord8Array arr
2495 i0 <- readArray arr 0
2496 i1 <- readArray arr 1
2497 i2 <- readArray arr 2
2498 i3 <- readArray arr 3
2499 return (map fromIntegral [i0,i1,i2,i3])
2502 doubleToBytes :: Double -> [Int]
2505 arr <- newArray_ ((0::Int),7)
2507 arr <- castDoubleToWord8Array arr
2508 i0 <- readArray arr 0
2509 i1 <- readArray arr 1
2510 i2 <- readArray arr 2
2511 i3 <- readArray arr 3
2512 i4 <- readArray arr 4
2513 i5 <- readArray arr 5
2514 i6 <- readArray arr 6
2515 i7 <- readArray arr 7
2516 return (map fromIntegral [i0,i1,i2,i3,i4,i5,i6,i7])