2 -- The above warning supression flag is a temporary kludge.
3 -- While working on this module you are encouraged to remove it and fix
4 -- any warnings in the module. See
5 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
8 -----------------------------------------------------------------------------
10 -- Pretty-printing assembly language
12 -- (c) The University of Glasgow 1993-2005
14 -----------------------------------------------------------------------------
16 -- We start with the @pprXXX@s with some cross-platform commonality
17 -- (e.g., 'pprReg'); we conclude with the no-commonality monster,
20 #include "nativeGen/NCG.h"
23 pprNatCmmTop, pprBasicBlock, pprSectionHeader, pprData,
24 pprInstr, pprSize, pprUserReg
28 import MachOp ( MachRep(..), wordRep, isFloatingRep )
29 import MachRegs -- may differ per-platform
32 import CLabel ( CLabel, pprCLabel, externallyVisibleCLabel,
33 labelDynamic, mkAsmTempLabel, entryLblToInfoLbl )
34 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
35 import CLabel ( mkDeadStripPreventer )
38 import Panic ( panic )
39 import Unique ( pprUnique )
42 import qualified Outputable
43 import Outputable ( Outputable )
46 import Data.Word ( Word8 )
47 import Control.Monad.ST
48 import Data.Char ( chr, ord )
49 import Data.Maybe ( isJust )
51 #if powerpc_TARGET_ARCH || darwin_TARGET_OS
52 import Data.Word(Word32)
56 -- -----------------------------------------------------------------------------
57 -- Printing this stuff out
59 asmSDoc d = Outputable.withPprStyleDoc (
60 Outputable.mkCodeStyle Outputable.AsmStyle) d
61 pprCLabel_asm l = asmSDoc (pprCLabel l)
63 pprNatCmmTop :: NatCmmTop -> Doc
64 pprNatCmmTop (CmmData section dats) =
65 pprSectionHeader section $$ vcat (map pprData dats)
67 -- special case for split markers:
68 pprNatCmmTop (CmmProc [] lbl _ (ListGraph [])) = pprLabel lbl
70 pprNatCmmTop (CmmProc info lbl params (ListGraph blocks)) =
71 pprSectionHeader Text $$
72 (if null info then -- blocks guaranteed not null, so label needed
75 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
76 pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
79 vcat (map pprData info) $$
80 pprLabel (entryLblToInfoLbl lbl)
82 vcat (map pprBasicBlock blocks)
83 -- ^ Even the first block gets a label, because with branch-chain
84 -- elimination, it might be the target of a goto.
85 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
86 -- If we are using the .subsections_via_symbols directive
87 -- (available on recent versions of Darwin),
88 -- we have to make sure that there is some kind of reference
89 -- from the entry code to a label on the _top_ of of the info table,
90 -- so that the linker will not think it is unreferenced and dead-strip
91 -- it. That's why the label is called a DeadStripPreventer (_dsp).
94 <+> pprCLabel_asm (entryLblToInfoLbl lbl)
96 <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
101 pprBasicBlock :: NatBasicBlock -> Doc
102 pprBasicBlock (BasicBlock (BlockId id) instrs) =
103 pprLabel (mkAsmTempLabel id) $$
104 vcat (map pprInstr instrs)
106 -- -----------------------------------------------------------------------------
107 -- pprReg: print a 'Reg'
109 -- For x86, the way we print a register name depends
110 -- on which bit of it we care about. Yurgh.
112 pprUserReg :: Reg -> Doc
113 pprUserReg = pprReg IF_ARCH_i386(I32,) IF_ARCH_x86_64(I64,)
115 pprReg :: IF_ARCH_i386(MachRep ->,) IF_ARCH_x86_64(MachRep ->,) Reg -> Doc
117 pprReg IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) r
119 RealReg i -> ppr_reg_no IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) i
120 VirtualRegI u -> text "%vI_" <> asmSDoc (pprUnique u)
121 VirtualRegHi u -> text "%vHi_" <> asmSDoc (pprUnique u)
122 VirtualRegF u -> text "%vF_" <> asmSDoc (pprUnique u)
123 VirtualRegD u -> text "%vD_" <> asmSDoc (pprUnique u)
125 #if alpha_TARGET_ARCH
126 ppr_reg_no :: Int -> Doc
129 0 -> sLit "$0"; 1 -> sLit "$1";
130 2 -> sLit "$2"; 3 -> sLit "$3";
131 4 -> sLit "$4"; 5 -> sLit "$5";
132 6 -> sLit "$6"; 7 -> sLit "$7";
133 8 -> sLit "$8"; 9 -> sLit "$9";
134 10 -> sLit "$10"; 11 -> sLit "$11";
135 12 -> sLit "$12"; 13 -> sLit "$13";
136 14 -> sLit "$14"; 15 -> sLit "$15";
137 16 -> sLit "$16"; 17 -> sLit "$17";
138 18 -> sLit "$18"; 19 -> sLit "$19";
139 20 -> sLit "$20"; 21 -> sLit "$21";
140 22 -> sLit "$22"; 23 -> sLit "$23";
141 24 -> sLit "$24"; 25 -> sLit "$25";
142 26 -> sLit "$26"; 27 -> sLit "$27";
143 28 -> sLit "$28"; 29 -> sLit "$29";
144 30 -> sLit "$30"; 31 -> sLit "$31";
145 32 -> sLit "$f0"; 33 -> sLit "$f1";
146 34 -> sLit "$f2"; 35 -> sLit "$f3";
147 36 -> sLit "$f4"; 37 -> sLit "$f5";
148 38 -> sLit "$f6"; 39 -> sLit "$f7";
149 40 -> sLit "$f8"; 41 -> sLit "$f9";
150 42 -> sLit "$f10"; 43 -> sLit "$f11";
151 44 -> sLit "$f12"; 45 -> sLit "$f13";
152 46 -> sLit "$f14"; 47 -> sLit "$f15";
153 48 -> sLit "$f16"; 49 -> sLit "$f17";
154 50 -> sLit "$f18"; 51 -> sLit "$f19";
155 52 -> sLit "$f20"; 53 -> sLit "$f21";
156 54 -> sLit "$f22"; 55 -> sLit "$f23";
157 56 -> sLit "$f24"; 57 -> sLit "$f25";
158 58 -> sLit "$f26"; 59 -> sLit "$f27";
159 60 -> sLit "$f28"; 61 -> sLit "$f29";
160 62 -> sLit "$f30"; 63 -> sLit "$f31";
161 _ -> sLit "very naughty alpha register"
165 ppr_reg_no :: MachRep -> Int -> Doc
166 ppr_reg_no I8 = ppr_reg_byte
167 ppr_reg_no I16 = ppr_reg_word
168 ppr_reg_no _ = ppr_reg_long
170 ppr_reg_byte i = ptext
172 0 -> sLit "%al"; 1 -> sLit "%bl";
173 2 -> sLit "%cl"; 3 -> sLit "%dl";
174 _ -> sLit "very naughty I386 byte register"
177 ppr_reg_word i = ptext
179 0 -> sLit "%ax"; 1 -> sLit "%bx";
180 2 -> sLit "%cx"; 3 -> sLit "%dx";
181 4 -> sLit "%si"; 5 -> sLit "%di";
182 6 -> sLit "%bp"; 7 -> sLit "%sp";
183 _ -> sLit "very naughty I386 word register"
186 ppr_reg_long i = ptext
188 0 -> sLit "%eax"; 1 -> sLit "%ebx";
189 2 -> sLit "%ecx"; 3 -> sLit "%edx";
190 4 -> sLit "%esi"; 5 -> sLit "%edi";
191 6 -> sLit "%ebp"; 7 -> sLit "%esp";
192 8 -> sLit "%fake0"; 9 -> sLit "%fake1";
193 10 -> sLit "%fake2"; 11 -> sLit "%fake3";
194 12 -> sLit "%fake4"; 13 -> sLit "%fake5";
195 _ -> sLit "very naughty I386 register"
199 #if x86_64_TARGET_ARCH
200 ppr_reg_no :: MachRep -> Int -> Doc
201 ppr_reg_no I8 = ppr_reg_byte
202 ppr_reg_no I16 = ppr_reg_word
203 ppr_reg_no I32 = ppr_reg_long
204 ppr_reg_no _ = ppr_reg_quad
206 ppr_reg_byte i = ptext
208 0 -> sLit "%al"; 1 -> sLit "%bl";
209 2 -> sLit "%cl"; 3 -> sLit "%dl";
210 4 -> sLit "%sil"; 5 -> sLit "%dil"; -- new 8-bit regs!
211 6 -> sLit "%bpl"; 7 -> sLit "%spl";
212 8 -> sLit "%r8b"; 9 -> sLit "%r9b";
213 10 -> sLit "%r10b"; 11 -> sLit "%r11b";
214 12 -> sLit "%r12b"; 13 -> sLit "%r13b";
215 14 -> sLit "%r14b"; 15 -> sLit "%r15b";
216 _ -> sLit "very naughty x86_64 byte register"
219 ppr_reg_word i = ptext
221 0 -> sLit "%ax"; 1 -> sLit "%bx";
222 2 -> sLit "%cx"; 3 -> sLit "%dx";
223 4 -> sLit "%si"; 5 -> sLit "%di";
224 6 -> sLit "%bp"; 7 -> sLit "%sp";
225 8 -> sLit "%r8w"; 9 -> sLit "%r9w";
226 10 -> sLit "%r10w"; 11 -> sLit "%r11w";
227 12 -> sLit "%r12w"; 13 -> sLit "%r13w";
228 14 -> sLit "%r14w"; 15 -> sLit "%r15w";
229 _ -> sLit "very naughty x86_64 word register"
232 ppr_reg_long i = ptext
234 0 -> sLit "%eax"; 1 -> sLit "%ebx";
235 2 -> sLit "%ecx"; 3 -> sLit "%edx";
236 4 -> sLit "%esi"; 5 -> sLit "%edi";
237 6 -> sLit "%ebp"; 7 -> sLit "%esp";
238 8 -> sLit "%r8d"; 9 -> sLit "%r9d";
239 10 -> sLit "%r10d"; 11 -> sLit "%r11d";
240 12 -> sLit "%r12d"; 13 -> sLit "%r13d";
241 14 -> sLit "%r14d"; 15 -> sLit "%r15d";
242 _ -> sLit "very naughty x86_64 register"
245 ppr_reg_quad i = ptext
247 0 -> sLit "%rax"; 1 -> sLit "%rbx";
248 2 -> sLit "%rcx"; 3 -> sLit "%rdx";
249 4 -> sLit "%rsi"; 5 -> sLit "%rdi";
250 6 -> sLit "%rbp"; 7 -> sLit "%rsp";
251 8 -> sLit "%r8"; 9 -> sLit "%r9";
252 10 -> sLit "%r10"; 11 -> sLit "%r11";
253 12 -> sLit "%r12"; 13 -> sLit "%r13";
254 14 -> sLit "%r14"; 15 -> sLit "%r15";
255 16 -> sLit "%xmm0"; 17 -> sLit "%xmm1";
256 18 -> sLit "%xmm2"; 19 -> sLit "%xmm3";
257 20 -> sLit "%xmm4"; 21 -> sLit "%xmm5";
258 22 -> sLit "%xmm6"; 23 -> sLit "%xmm7";
259 24 -> sLit "%xmm8"; 25 -> sLit "%xmm9";
260 26 -> sLit "%xmm10"; 27 -> sLit "%xmm11";
261 28 -> sLit "%xmm12"; 29 -> sLit "%xmm13";
262 30 -> sLit "%xmm14"; 31 -> sLit "%xmm15";
263 _ -> sLit "very naughty x86_64 register"
267 #if sparc_TARGET_ARCH
268 ppr_reg_no :: Int -> Doc
271 0 -> sLit "%g0"; 1 -> sLit "%g1";
272 2 -> sLit "%g2"; 3 -> sLit "%g3";
273 4 -> sLit "%g4"; 5 -> sLit "%g5";
274 6 -> sLit "%g6"; 7 -> sLit "%g7";
275 8 -> sLit "%o0"; 9 -> sLit "%o1";
276 10 -> sLit "%o2"; 11 -> sLit "%o3";
277 12 -> sLit "%o4"; 13 -> sLit "%o5";
278 14 -> sLit "%o6"; 15 -> sLit "%o7";
279 16 -> sLit "%l0"; 17 -> sLit "%l1";
280 18 -> sLit "%l2"; 19 -> sLit "%l3";
281 20 -> sLit "%l4"; 21 -> sLit "%l5";
282 22 -> sLit "%l6"; 23 -> sLit "%l7";
283 24 -> sLit "%i0"; 25 -> sLit "%i1";
284 26 -> sLit "%i2"; 27 -> sLit "%i3";
285 28 -> sLit "%i4"; 29 -> sLit "%i5";
286 30 -> sLit "%i6"; 31 -> sLit "%i7";
287 32 -> sLit "%f0"; 33 -> sLit "%f1";
288 34 -> sLit "%f2"; 35 -> sLit "%f3";
289 36 -> sLit "%f4"; 37 -> sLit "%f5";
290 38 -> sLit "%f6"; 39 -> sLit "%f7";
291 40 -> sLit "%f8"; 41 -> sLit "%f9";
292 42 -> sLit "%f10"; 43 -> sLit "%f11";
293 44 -> sLit "%f12"; 45 -> sLit "%f13";
294 46 -> sLit "%f14"; 47 -> sLit "%f15";
295 48 -> sLit "%f16"; 49 -> sLit "%f17";
296 50 -> sLit "%f18"; 51 -> sLit "%f19";
297 52 -> sLit "%f20"; 53 -> sLit "%f21";
298 54 -> sLit "%f22"; 55 -> sLit "%f23";
299 56 -> sLit "%f24"; 57 -> sLit "%f25";
300 58 -> sLit "%f26"; 59 -> sLit "%f27";
301 60 -> sLit "%f28"; 61 -> sLit "%f29";
302 62 -> sLit "%f30"; 63 -> sLit "%f31";
303 _ -> sLit "very naughty sparc register"
306 #if powerpc_TARGET_ARCH
308 ppr_reg_no :: Int -> Doc
311 0 -> sLit "r0"; 1 -> sLit "r1";
312 2 -> sLit "r2"; 3 -> sLit "r3";
313 4 -> sLit "r4"; 5 -> sLit "r5";
314 6 -> sLit "r6"; 7 -> sLit "r7";
315 8 -> sLit "r8"; 9 -> sLit "r9";
316 10 -> sLit "r10"; 11 -> sLit "r11";
317 12 -> sLit "r12"; 13 -> sLit "r13";
318 14 -> sLit "r14"; 15 -> sLit "r15";
319 16 -> sLit "r16"; 17 -> sLit "r17";
320 18 -> sLit "r18"; 19 -> sLit "r19";
321 20 -> sLit "r20"; 21 -> sLit "r21";
322 22 -> sLit "r22"; 23 -> sLit "r23";
323 24 -> sLit "r24"; 25 -> sLit "r25";
324 26 -> sLit "r26"; 27 -> sLit "r27";
325 28 -> sLit "r28"; 29 -> sLit "r29";
326 30 -> sLit "r30"; 31 -> sLit "r31";
327 32 -> sLit "f0"; 33 -> sLit "f1";
328 34 -> sLit "f2"; 35 -> sLit "f3";
329 36 -> sLit "f4"; 37 -> sLit "f5";
330 38 -> sLit "f6"; 39 -> sLit "f7";
331 40 -> sLit "f8"; 41 -> sLit "f9";
332 42 -> sLit "f10"; 43 -> sLit "f11";
333 44 -> sLit "f12"; 45 -> sLit "f13";
334 46 -> sLit "f14"; 47 -> sLit "f15";
335 48 -> sLit "f16"; 49 -> sLit "f17";
336 50 -> sLit "f18"; 51 -> sLit "f19";
337 52 -> sLit "f20"; 53 -> sLit "f21";
338 54 -> sLit "f22"; 55 -> sLit "f23";
339 56 -> sLit "f24"; 57 -> sLit "f25";
340 58 -> sLit "f26"; 59 -> sLit "f27";
341 60 -> sLit "f28"; 61 -> sLit "f29";
342 62 -> sLit "f30"; 63 -> sLit "f31";
343 _ -> sLit "very naughty powerpc register"
346 ppr_reg_no :: Int -> Doc
347 ppr_reg_no i | i <= 31 = int i -- GPRs
348 | i <= 63 = int (i-32) -- FPRs
349 | otherwise = ptext sLit "very naughty powerpc register"
354 -- -----------------------------------------------------------------------------
355 -- pprSize: print a 'Size'
357 #if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH || sparc_TARGET_ARCH
358 pprSize :: MachRep -> Doc
360 pprSize :: Size -> Doc
363 pprSize x = ptext (case x of
364 #if alpha_TARGET_ARCH
367 -- W -> sLit "w" UNUSED
368 -- Wu -> sLit "wu" UNUSED
371 -- FF -> sLit "f" UNUSED
372 -- DF -> sLit "d" UNUSED
373 -- GF -> sLit "g" UNUSED
374 -- SF -> sLit "s" UNUSED
377 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
388 #if x86_64_TARGET_ARCH
389 F32 -> sLit "ss" -- "scalar single-precision float" (SSE2)
390 F64 -> sLit "sd" -- "scalar double-precision float" (SSE2)
392 #if sparc_TARGET_ARCH
399 pprStSize :: MachRep -> Doc
400 pprStSize x = ptext (case x of
407 #if powerpc_TARGET_ARCH
416 -- -----------------------------------------------------------------------------
417 -- pprCond: print a 'Cond'
419 pprCond :: Cond -> Doc
421 pprCond c = ptext (case c of {
422 #if alpha_TARGET_ARCH
432 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
433 GEU -> sLit "ae"; LU -> sLit "b";
434 EQQ -> sLit "e"; GTT -> sLit "g";
435 GE -> sLit "ge"; GU -> sLit "a";
436 LTT -> sLit "l"; LE -> sLit "le";
437 LEU -> sLit "be"; NE -> sLit "ne";
438 NEG -> sLit "s"; POS -> sLit "ns";
439 CARRY -> sLit "c"; OFLO -> sLit "o";
440 PARITY -> sLit "p"; NOTPARITY -> sLit "np";
441 ALWAYS -> sLit "mp" -- hack
443 #if sparc_TARGET_ARCH
444 ALWAYS -> sLit ""; NEVER -> sLit "n";
445 GEU -> sLit "geu"; LU -> sLit "lu";
446 EQQ -> sLit "e"; GTT -> sLit "g";
447 GE -> sLit "ge"; GU -> sLit "gu";
448 LTT -> sLit "l"; LE -> sLit "le";
449 LEU -> sLit "leu"; NE -> sLit "ne";
450 NEG -> sLit "neg"; POS -> sLit "pos";
451 VC -> sLit "vc"; VS -> sLit "vs"
453 #if powerpc_TARGET_ARCH
455 EQQ -> sLit "eq"; NE -> sLit "ne";
456 LTT -> sLit "lt"; GE -> sLit "ge";
457 GTT -> sLit "gt"; LE -> sLit "le";
458 LU -> sLit "lt"; GEU -> sLit "ge";
459 GU -> sLit "gt"; LEU -> sLit "le";
464 -- -----------------------------------------------------------------------------
465 -- pprImm: print an 'Imm'
469 pprImm (ImmInt i) = int i
470 pprImm (ImmInteger i) = integer i
471 pprImm (ImmCLbl l) = pprCLabel_asm l
472 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
473 pprImm (ImmLit s) = s
475 pprImm (ImmFloat _) = ptext (sLit "naughty float immediate")
476 pprImm (ImmDouble _) = ptext (sLit "naughty double immediate")
478 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
479 #if sparc_TARGET_ARCH
480 -- ToDo: This should really be fixed in the PIC support, but only
482 pprImm (ImmConstantDiff a b) = pprImm a
484 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
485 <> lparen <> pprImm b <> rparen
488 #if sparc_TARGET_ARCH
490 = hcat [ pp_lo, pprImm i, rparen ]
495 = hcat [ pp_hi, pprImm i, rparen ]
499 #if powerpc_TARGET_ARCH
502 = hcat [ pp_lo, pprImm i, rparen ]
507 = hcat [ pp_hi, pprImm i, rparen ]
512 = hcat [ pp_ha, pprImm i, rparen ]
518 = pprImm i <> text "@l"
521 = pprImm i <> text "@h"
524 = pprImm i <> text "@ha"
529 -- -----------------------------------------------------------------------------
530 -- @pprAddr: print an 'AddrMode'
532 pprAddr :: AddrMode -> Doc
534 #if alpha_TARGET_ARCH
535 pprAddr (AddrReg r) = parens (pprReg r)
536 pprAddr (AddrImm i) = pprImm i
537 pprAddr (AddrRegImm r1 i)
538 = (<>) (pprImm i) (parens (pprReg r1))
543 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
544 pprAddr (ImmAddr imm off)
545 = let pp_imm = pprImm imm
549 else if (off < 0) then
552 pp_imm <> char '+' <> int off
554 pprAddr (AddrBaseIndex base index displacement)
556 pp_disp = ppr_disp displacement
557 pp_off p = pp_disp <> char '(' <> p <> char ')'
558 pp_reg r = pprReg wordRep r
561 (EABaseNone, EAIndexNone) -> pp_disp
562 (EABaseReg b, EAIndexNone) -> pp_off (pp_reg b)
563 (EABaseRip, EAIndexNone) -> pp_off (ptext (sLit "%rip"))
564 (EABaseNone, EAIndex r i) -> pp_off (comma <> pp_reg r <> comma <> int i)
565 (EABaseReg b, EAIndex r i) -> pp_off (pp_reg b <> comma <> pp_reg r
568 ppr_disp (ImmInt 0) = empty
569 ppr_disp imm = pprImm imm
574 #if sparc_TARGET_ARCH
575 pprAddr (AddrRegReg r1 (RealReg 0)) = pprReg r1
577 pprAddr (AddrRegReg r1 r2)
578 = hcat [ pprReg r1, char '+', pprReg r2 ]
580 pprAddr (AddrRegImm r1 (ImmInt i))
582 | not (fits13Bits i) = largeOffsetError i
583 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
585 pp_sign = if i > 0 then char '+' else empty
587 pprAddr (AddrRegImm r1 (ImmInteger i))
589 | not (fits13Bits i) = largeOffsetError i
590 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
592 pp_sign = if i > 0 then char '+' else empty
594 pprAddr (AddrRegImm r1 imm)
595 = hcat [ pprReg r1, char '+', pprImm imm ]
600 #if powerpc_TARGET_ARCH
601 pprAddr (AddrRegReg r1 r2)
602 = pprReg r1 <+> ptext sLit ", " <+> pprReg r2
604 pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
605 pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
606 pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
610 -- -----------------------------------------------------------------------------
611 -- pprData: print a 'CmmStatic'
613 pprSectionHeader Text
615 (IF_ARCH_alpha(sLit "\t.text\n\t.align 3" {-word boundary-}
616 ,IF_ARCH_sparc(sLit ".text\n\t.align 4" {-word boundary-}
617 ,IF_ARCH_i386(IF_OS_darwin(sLit ".text\n\t.align 2",
618 sLit ".text\n\t.align 4,0x90")
619 {-needs per-OS variation!-}
620 ,IF_ARCH_x86_64(IF_OS_darwin(sLit ".text\n.align 3",
621 sLit ".text\n\t.align 8")
622 ,IF_ARCH_powerpc(sLit ".text\n.align 2"
624 pprSectionHeader Data
626 (IF_ARCH_alpha(sLit "\t.data\n\t.align 3"
627 ,IF_ARCH_sparc(sLit ".data\n\t.align 8" {-<8 will break double constants -}
628 ,IF_ARCH_i386(IF_OS_darwin(sLit ".data\n\t.align 2",
629 sLit ".data\n\t.align 4")
630 ,IF_ARCH_x86_64(IF_OS_darwin(sLit ".data\n.align 3",
631 sLit ".data\n\t.align 8")
632 ,IF_ARCH_powerpc(sLit ".data\n.align 2"
634 pprSectionHeader ReadOnlyData
636 (IF_ARCH_alpha(sLit "\t.data\n\t.align 3"
637 ,IF_ARCH_sparc(sLit ".data\n\t.align 8" {-<8 will break double constants -}
638 ,IF_ARCH_i386(IF_OS_darwin(sLit ".const\n.align 2",
639 sLit ".section .rodata\n\t.align 4")
640 ,IF_ARCH_x86_64(IF_OS_darwin(sLit ".const\n.align 3",
641 sLit ".section .rodata\n\t.align 8")
642 ,IF_ARCH_powerpc(IF_OS_darwin(sLit ".const\n.align 2",
643 sLit ".section .rodata\n\t.align 2")
645 pprSectionHeader RelocatableReadOnlyData
647 (IF_ARCH_alpha(sLit "\t.data\n\t.align 3"
648 ,IF_ARCH_sparc(sLit ".data\n\t.align 8" {-<8 will break double constants -}
649 ,IF_ARCH_i386(IF_OS_darwin(sLit ".const_data\n.align 2",
650 sLit ".section .data\n\t.align 4")
651 ,IF_ARCH_x86_64(IF_OS_darwin(sLit ".const_data\n.align 3",
652 sLit ".section .data\n\t.align 8")
653 ,IF_ARCH_powerpc(IF_OS_darwin(sLit ".const_data\n.align 2",
654 sLit ".data\n\t.align 2")
656 pprSectionHeader UninitialisedData
658 (IF_ARCH_alpha(sLit "\t.bss\n\t.align 3"
659 ,IF_ARCH_sparc(sLit ".bss\n\t.align 8" {-<8 will break double constants -}
660 ,IF_ARCH_i386(IF_OS_darwin(sLit ".data\n\t.align 2",
661 sLit ".section .bss\n\t.align 4")
662 ,IF_ARCH_x86_64(IF_OS_darwin(sLit ".data\n\t.align 3",
663 sLit ".section .bss\n\t.align 8")
664 ,IF_ARCH_powerpc(IF_OS_darwin(sLit ".const_data\n.align 2",
665 sLit ".section .bss\n\t.align 2")
667 pprSectionHeader ReadOnlyData16
669 (IF_ARCH_alpha(sLit "\t.data\n\t.align 4"
670 ,IF_ARCH_sparc(sLit ".data\n\t.align 16"
671 ,IF_ARCH_i386(IF_OS_darwin(sLit ".const\n.align 4",
672 sLit ".section .rodata\n\t.align 16")
673 ,IF_ARCH_x86_64(IF_OS_darwin(sLit ".const\n.align 4",
674 sLit ".section .rodata.cst16\n\t.align 16")
675 ,IF_ARCH_powerpc(IF_OS_darwin(sLit ".const\n.align 4",
676 sLit ".section .rodata\n\t.align 4")
679 pprSectionHeader (OtherSection sec)
680 = panic "PprMach.pprSectionHeader: unknown section"
682 pprData :: CmmStatic -> Doc
683 pprData (CmmAlign bytes) = pprAlign bytes
684 pprData (CmmDataLabel lbl) = pprLabel lbl
685 pprData (CmmString str) = pprASCII str
686 pprData (CmmUninitialised bytes) = ptext (sLit ".space ") <> int bytes
687 pprData (CmmStaticLit lit) = pprDataItem lit
689 pprGloblDecl :: CLabel -> Doc
691 | not (externallyVisibleCLabel lbl) = empty
692 | otherwise = ptext IF_ARCH_sparc((sLit ".global "),
696 pprTypeAndSizeDecl :: CLabel -> Doc
697 pprTypeAndSizeDecl lbl
699 | not (externallyVisibleCLabel lbl) = empty
700 | otherwise = ptext (sLit ".type ") <>
701 pprCLabel_asm lbl <> ptext (sLit ", @object")
706 pprLabel :: CLabel -> Doc
707 pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':')
711 = vcat (map do1 str) $$ do1 0
714 do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
717 IF_ARCH_alpha(ptext (sLit ".align ") <> int pow2,
718 IF_ARCH_i386(ptext (sLit ".align ") <> int IF_OS_darwin(pow2,bytes),
719 IF_ARCH_x86_64(ptext (sLit ".align ") <> int IF_OS_darwin(pow2,bytes),
720 IF_ARCH_sparc(ptext (sLit ".align ") <> int bytes,
721 IF_ARCH_powerpc(ptext (sLit ".align ") <> int pow2,)))))
725 log2 :: Int -> Int -- cache the common ones
730 log2 n = 1 + log2 (n `quot` 2)
733 pprDataItem :: CmmLit -> Doc
735 = vcat (ppr_item (cmmLitRep lit) lit)
739 -- These seem to be common:
740 ppr_item I8 x = [ptext (sLit "\t.byte\t") <> pprImm imm]
741 ppr_item I32 x = [ptext (sLit "\t.long\t") <> pprImm imm]
742 ppr_item F32 (CmmFloat r _)
743 = let bs = floatToBytes (fromRational r)
744 in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
745 ppr_item F64 (CmmFloat r _)
746 = let bs = doubleToBytes (fromRational r)
747 in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
749 #if sparc_TARGET_ARCH
750 -- copy n paste of x86 version
751 ppr_item I16 x = [ptext (sLit "\t.short\t") <> pprImm imm]
752 ppr_item I64 x = [ptext (sLit "\t.quad\t") <> pprImm imm]
754 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
755 ppr_item I16 x = [ptext (sLit "\t.word\t") <> pprImm imm]
757 #if i386_TARGET_ARCH && darwin_TARGET_OS
758 ppr_item I64 (CmmInt x _) =
759 [ptext (sLit "\t.long\t")
760 <> int (fromIntegral (fromIntegral x :: Word32)),
761 ptext (sLit "\t.long\t")
763 (fromIntegral (x `shiftR` 32) :: Word32))]
765 #if i386_TARGET_ARCH || (darwin_TARGET_OS && x86_64_TARGET_ARCH)
766 ppr_item I64 x = [ptext (sLit "\t.quad\t") <> pprImm imm]
768 #if x86_64_TARGET_ARCH && !darwin_TARGET_OS
769 -- x86_64: binutils can't handle the R_X86_64_PC64 relocation
770 -- type, which means we can't do pc-relative 64-bit addresses.
771 -- Fortunately we're assuming the small memory model, in which
772 -- all such offsets will fit into 32 bits, so we have to stick
773 -- to 32-bit offset fields and modify the RTS appropriately
775 -- See Note [x86-64-relative] in includes/InfoTables.h
778 | isRelativeReloc x =
779 [ptext (sLit "\t.long\t") <> pprImm imm,
780 ptext (sLit "\t.long\t0")]
782 [ptext (sLit "\t.quad\t") <> pprImm imm]
784 isRelativeReloc (CmmLabelDiffOff _ _ _) = True
785 isRelativeReloc _ = False
787 #if powerpc_TARGET_ARCH
788 ppr_item I16 x = [ptext (sLit "\t.short\t") <> pprImm imm]
789 ppr_item I64 (CmmInt x _) =
790 [ptext (sLit "\t.long\t")
792 (fromIntegral (x `shiftR` 32) :: Word32)),
793 ptext (sLit "\t.long\t")
794 <> int (fromIntegral (fromIntegral x :: Word32))]
797 -- fall through to rest of (machine-specific) pprInstr...
799 -- -----------------------------------------------------------------------------
800 -- pprInstr: print an 'Instr'
802 instance Outputable Instr where
803 ppr instr = Outputable.docToSDoc $ pprInstr instr
805 pprInstr :: Instr -> Doc
807 --pprInstr (COMMENT s) = empty -- nuke 'em
809 = IF_ARCH_alpha( ((<>) (ptext (sLit "\t# ")) (ftext s))
810 ,IF_ARCH_sparc( ((<>) (ptext (sLit "! ")) (ftext s))
811 ,IF_ARCH_i386( ((<>) (ptext (sLit "# ")) (ftext s))
812 ,IF_ARCH_x86_64( ((<>) (ptext (sLit "# ")) (ftext s))
813 ,IF_ARCH_powerpc( IF_OS_linux(
814 ((<>) (ptext (sLit "# ")) (ftext s)),
815 ((<>) (ptext (sLit "; ")) (ftext s)))
819 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
821 pprInstr (NEWBLOCK _)
822 = panic "PprMach.pprInstr: NEWBLOCK"
825 = panic "PprMach.pprInstr: LDATA"
827 -- -----------------------------------------------------------------------------
828 -- pprInstr for an Alpha
830 #if alpha_TARGET_ARCH
832 pprInstr (SPILL reg slot)
834 ptext (sLit "\tSPILL"),
838 ptext (sLit "SLOT") <> parens (int slot)]
840 pprInstr (RELOAD slot reg)
842 ptext (sLit "\tRELOAD"),
844 ptext (sLit "SLOT") <> parens (int slot),
848 pprInstr (LD size reg addr)
858 pprInstr (LDA reg addr)
860 ptext (sLit "\tlda\t"),
866 pprInstr (LDAH reg addr)
868 ptext (sLit "\tldah\t"),
874 pprInstr (LDGP reg addr)
876 ptext (sLit "\tldgp\t"),
882 pprInstr (LDI size reg imm)
884 ptext (sLit "\tldi"),
892 pprInstr (ST size reg addr)
904 ptext (sLit "\tclr\t"),
908 pprInstr (ABS size ri reg)
910 ptext (sLit "\tabs"),
918 pprInstr (NEG size ov ri reg)
920 ptext (sLit "\tneg"),
922 if ov then ptext (sLit "v\t") else char '\t',
928 pprInstr (ADD size ov reg1 ri reg2)
930 ptext (sLit "\tadd"),
932 if ov then ptext (sLit "v\t") else char '\t',
940 pprInstr (SADD size scale reg1 ri reg2)
942 ptext (case scale of {{-UNUSED:L -> (sLit "\ts4");-} Q -> (sLit "\ts8")}),
953 pprInstr (SUB size ov reg1 ri reg2)
955 ptext (sLit "\tsub"),
957 if ov then ptext (sLit "v\t") else char '\t',
965 pprInstr (SSUB size scale reg1 ri reg2)
967 ptext (case scale of {{-UNUSED:L -> (sLit "\ts4");-} Q -> (sLit "\ts8")}),
978 pprInstr (MUL size ov reg1 ri reg2)
980 ptext (sLit "\tmul"),
982 if ov then ptext (sLit "v\t") else char '\t',
990 pprInstr (DIV size uns reg1 ri reg2)
992 ptext (sLit "\tdiv"),
994 if uns then ptext (sLit "u\t") else char '\t',
1002 pprInstr (REM size uns reg1 ri reg2)
1004 ptext (sLit "\trem"),
1006 if uns then ptext (sLit "u\t") else char '\t',
1014 pprInstr (NOT ri reg)
1016 ptext (sLit "\tnot"),
1023 pprInstr (AND reg1 ri reg2) = pprRegRIReg (sLit "and") reg1 ri reg2
1024 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg (sLit "andnot") reg1 ri reg2
1025 pprInstr (OR reg1 ri reg2) = pprRegRIReg (sLit "or") reg1 ri reg2
1026 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg (sLit "ornot") reg1 ri reg2
1027 pprInstr (XOR reg1 ri reg2) = pprRegRIReg (sLit "xor") reg1 ri reg2
1028 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg (sLit "xornot") reg1 ri reg2
1030 pprInstr (SLL reg1 ri reg2) = pprRegRIReg (sLit "sll") reg1 ri reg2
1031 pprInstr (SRL reg1 ri reg2) = pprRegRIReg (sLit "srl") reg1 ri reg2
1032 pprInstr (SRA reg1 ri reg2) = pprRegRIReg (sLit "sra") reg1 ri reg2
1034 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg (sLit "zap") reg1 ri reg2
1035 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg (sLit "zapnot") reg1 ri reg2
1037 pprInstr (NOP) = ptext (sLit "\tnop")
1039 pprInstr (CMP cond reg1 ri reg2)
1041 ptext (sLit "\tcmp"),
1053 ptext (sLit "\tfclr\t"),
1057 pprInstr (FABS reg1 reg2)
1059 ptext (sLit "\tfabs\t"),
1065 pprInstr (FNEG size reg1 reg2)
1067 ptext (sLit "\tneg"),
1075 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "add") size reg1 reg2 reg3
1076 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "div") size reg1 reg2 reg3
1077 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "mul") size reg1 reg2 reg3
1078 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "sub") size reg1 reg2 reg3
1080 pprInstr (CVTxy size1 size2 reg1 reg2)
1082 ptext (sLit "\tcvt"),
1084 case size2 of {Q -> ptext (sLit "qc"); _ -> pprSize size2},
1091 pprInstr (FCMP size cond reg1 reg2 reg3)
1093 ptext (sLit "\tcmp"),
1104 pprInstr (FMOV reg1 reg2)
1106 ptext (sLit "\tfmov\t"),
1112 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
1114 pprInstr (BI NEVER reg lab) = empty
1116 pprInstr (BI cond reg lab)
1126 pprInstr (BF cond reg lab)
1128 ptext (sLit "\tfb"),
1137 = (<>) (ptext (sLit "\tbr\t")) (pprImm lab)
1139 pprInstr (JMP reg addr hint)
1141 ptext (sLit "\tjmp\t"),
1149 pprInstr (BSR imm n)
1150 = (<>) (ptext (sLit "\tbsr\t")) (pprImm imm)
1152 pprInstr (JSR reg addr n)
1154 ptext (sLit "\tjsr\t"),
1160 pprInstr (FUNBEGIN clab)
1162 if (externallyVisibleCLabel clab) then
1163 hcat [ptext (sLit "\t.globl\t"), pp_lab, char '\n']
1166 ptext (sLit "\t.ent "),
1175 pp_lab = pprCLabel_asm clab
1177 -- NEVER use commas within those string literals, cpp will ruin your day
1178 pp_ldgp = hcat [ ptext (sLit ":\n\tldgp $29"), char ',', ptext (sLit "0($27)\n") ]
1179 pp_frame = hcat [ ptext (sLit "..ng:\n\t.frame $30"), char ',',
1180 ptext (sLit "4240"), char ',',
1181 ptext (sLit "$26"), char ',',
1182 ptext (sLit "0\n\t.prologue 1") ]
1184 pprInstr (FUNEND clab)
1185 = (<>) (ptext (sLit "\t.align 4\n\t.end ")) (pprCLabel_asm clab)
1188 Continue with Alpha-only printing bits and bobs:
1192 pprRI (RIReg r) = pprReg r
1193 pprRI (RIImm r) = pprImm r
1195 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
1196 pprRegRIReg name reg1 ri reg2
1208 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1209 pprSizeRegRegReg name size reg1 reg2 reg3
1222 #endif /* alpha_TARGET_ARCH */
1225 -- -----------------------------------------------------------------------------
1226 -- pprInstr for an x86
1228 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1230 pprInstr (SPILL reg slot)
1232 ptext (sLit "\tSPILL"),
1236 ptext (sLit "SLOT") <> parens (int slot)]
1238 pprInstr (RELOAD slot reg)
1240 ptext (sLit "\tRELOAD"),
1242 ptext (sLit "SLOT") <> parens (int slot),
1246 pprInstr (MOV size src dst)
1247 = pprSizeOpOp (sLit "mov") size src dst
1249 pprInstr (MOVZxL I32 src dst) = pprSizeOpOp (sLit "mov") I32 src dst
1250 -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
1251 -- movl. But we represent it as a MOVZxL instruction, because
1252 -- the reg alloc would tend to throw away a plain reg-to-reg
1253 -- move, and we still want it to do that.
1255 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce (sLit "movz") sizes I32 src dst
1256 -- zero-extension only needs to extend to 32 bits: on x86_64,
1257 -- the remaining zero-extension to 64 bits is automatic, and the 32-bit
1258 -- instruction is shorter.
1260 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce (sLit "movs") sizes wordRep src dst
1262 -- here we do some patching, since the physical registers are only set late
1263 -- in the code generation.
1264 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1266 = pprSizeOpOp (sLit "add") size (OpReg reg2) dst
1267 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1269 = pprSizeOpOp (sLit "add") size (OpReg reg1) dst
1270 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
1272 = pprInstr (ADD size (OpImm displ) dst)
1273 pprInstr (LEA size src dst) = pprSizeOpOp (sLit "lea") size src dst
1275 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
1276 = pprSizeOp (sLit "dec") size dst
1277 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
1278 = pprSizeOp (sLit "inc") size dst
1279 pprInstr (ADD size src dst)
1280 = pprSizeOpOp (sLit "add") size src dst
1281 pprInstr (ADC size src dst)
1282 = pprSizeOpOp (sLit "adc") size src dst
1283 pprInstr (SUB size src dst) = pprSizeOpOp (sLit "sub") size src dst
1284 pprInstr (IMUL size op1 op2) = pprSizeOpOp (sLit "imul") size op1 op2
1286 {- A hack. The Intel documentation says that "The two and three
1287 operand forms [of IMUL] may also be used with unsigned operands
1288 because the lower half of the product is the same regardless if
1289 (sic) the operands are signed or unsigned. The CF and OF flags,
1290 however, cannot be used to determine if the upper half of the
1291 result is non-zero." So there.
1293 pprInstr (AND size src dst) = pprSizeOpOp (sLit "and") size src dst
1294 pprInstr (OR size src dst) = pprSizeOpOp (sLit "or") size src dst
1296 pprInstr (XOR F32 src dst) = pprOpOp (sLit "xorps") F32 src dst
1297 pprInstr (XOR F64 src dst) = pprOpOp (sLit "xorpd") F64 src dst
1298 pprInstr (XOR size src dst) = pprSizeOpOp (sLit "xor") size src dst
1300 pprInstr (NOT size op) = pprSizeOp (sLit "not") size op
1301 pprInstr (NEGI size op) = pprSizeOp (sLit "neg") size op
1303 pprInstr (SHL size src dst) = pprShift (sLit "shl") size src dst
1304 pprInstr (SAR size src dst) = pprShift (sLit "sar") size src dst
1305 pprInstr (SHR size src dst) = pprShift (sLit "shr") size src dst
1307 pprInstr (BT size imm src) = pprSizeImmOp (sLit "bt") size imm src
1309 pprInstr (CMP size src dst)
1310 | isFloatingRep size = pprSizeOpOp (sLit "ucomi") size src dst -- SSE2
1311 | otherwise = pprSizeOpOp (sLit "cmp") size src dst
1313 pprInstr (TEST size src dst) = pprSizeOpOp (sLit "test") size src dst
1314 pprInstr (PUSH size op) = pprSizeOp (sLit "push") size op
1315 pprInstr (POP size op) = pprSizeOp (sLit "pop") size op
1317 -- both unused (SDM):
1318 -- pprInstr PUSHA = ptext (sLit "\tpushal")
1319 -- pprInstr POPA = ptext (sLit "\tpopal")
1321 pprInstr NOP = ptext (sLit "\tnop")
1322 pprInstr (CLTD I32) = ptext (sLit "\tcltd")
1323 pprInstr (CLTD I64) = ptext (sLit "\tcqto")
1325 pprInstr (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand I8 op)
1327 pprInstr (JXX cond (BlockId id))
1328 = pprCondInstr (sLit "j") cond (pprCLabel_asm lab)
1329 where lab = mkAsmTempLabel id
1331 pprInstr (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm imm)
1333 pprInstr (JMP (OpImm imm)) = (<>) (ptext (sLit "\tjmp ")) (pprImm imm)
1334 pprInstr (JMP op) = (<>) (ptext (sLit "\tjmp *")) (pprOperand wordRep op)
1335 pprInstr (JMP_TBL op ids) = pprInstr (JMP op)
1336 pprInstr (CALL (Left imm) _) = (<>) (ptext (sLit "\tcall ")) (pprImm imm)
1337 pprInstr (CALL (Right reg) _) = (<>) (ptext (sLit "\tcall *")) (pprReg wordRep reg)
1339 pprInstr (IDIV sz op) = pprSizeOp (sLit "idiv") sz op
1340 pprInstr (DIV sz op) = pprSizeOp (sLit "div") sz op
1341 pprInstr (IMUL2 sz op) = pprSizeOp (sLit "imul") sz op
1343 #if x86_64_TARGET_ARCH
1344 pprInstr (MUL size op1 op2) = pprSizeOpOp (sLit "mul") size op1 op2
1346 pprInstr (FDIV size op1 op2) = pprSizeOpOp (sLit "div") size op1 op2
1348 pprInstr (CVTSS2SD from to) = pprRegReg (sLit "cvtss2sd") from to
1349 pprInstr (CVTSD2SS from to) = pprRegReg (sLit "cvtsd2ss") from to
1350 pprInstr (CVTTSS2SIQ from to) = pprOpReg (sLit "cvttss2siq") from to
1351 pprInstr (CVTTSD2SIQ from to) = pprOpReg (sLit "cvttsd2siq") from to
1352 pprInstr (CVTSI2SS from to) = pprOpReg (sLit "cvtsi2ssq") from to
1353 pprInstr (CVTSI2SD from to) = pprOpReg (sLit "cvtsi2sdq") from to
1356 -- FETCHGOT for PIC on ELF platforms
1357 pprInstr (FETCHGOT reg)
1358 = vcat [ ptext (sLit "\tcall 1f"),
1359 hcat [ ptext (sLit "1:\tpopl\t"), pprReg I32 reg ],
1360 hcat [ ptext (sLit "\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
1364 -- FETCHPC for PIC on Darwin/x86
1365 -- get the instruction pointer into a register
1366 -- (Terminology note: the IP is called Program Counter on PPC,
1367 -- and it's a good thing to use the same name on both platforms)
1368 pprInstr (FETCHPC reg)
1369 = vcat [ ptext (sLit "\tcall 1f"),
1370 hcat [ ptext (sLit "1:\tpopl\t"), pprReg I32 reg ]
1377 -- -----------------------------------------------------------------------------
1378 -- i386 floating-point
1380 #if i386_TARGET_ARCH
1381 -- Simulating a flat register set on the x86 FP stack is tricky.
1382 -- you have to free %st(7) before pushing anything on the FP reg stack
1383 -- so as to preclude the possibility of a FP stack overflow exception.
1384 pprInstr g@(GMOV src dst)
1388 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1390 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1391 pprInstr g@(GLD sz addr dst)
1392 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1393 pprAddr addr, gsemi, gpop dst 1])
1395 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1396 pprInstr g@(GST sz src addr)
1397 = pprG g (hcat [gtab, gpush src 0, gsemi,
1398 text "fstp", pprSize sz, gsp, pprAddr addr])
1400 pprInstr g@(GLDZ dst)
1401 = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
1402 pprInstr g@(GLD1 dst)
1403 = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
1405 pprInstr g@(GFTOI src dst)
1406 = pprInstr (GDTOI src dst)
1407 pprInstr g@(GDTOI src dst)
1409 hcat [gtab, text "subl $8, %esp ; fnstcw 4(%esp)"],
1410 hcat [gtab, gpush src 0],
1411 hcat [gtab, text "movzwl 4(%esp), ", reg,
1412 text " ; orl $0xC00, ", reg],
1413 hcat [gtab, text "movl ", reg, text ", 0(%esp) ; fldcw 0(%esp)"],
1414 hcat [gtab, text "fistpl 0(%esp)"],
1415 hcat [gtab, text "fldcw 4(%esp) ; movl 0(%esp), ", reg],
1416 hcat [gtab, text "addl $8, %esp"]
1419 reg = pprReg I32 dst
1421 pprInstr g@(GITOF src dst)
1422 = pprInstr (GITOD src dst)
1423 pprInstr g@(GITOD src dst)
1424 = pprG g (hcat [gtab, text "pushl ", pprReg I32 src,
1425 text " ; ffree %st(7); fildl (%esp) ; ",
1426 gpop dst 1, text " ; addl $4,%esp"])
1428 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
1429 this far into the jungle AND you give a Rat's Ass (tm) what's going
1430 on, here's the deal. Generate code to do a floating point comparison
1431 of src1 and src2, of kind cond, and set the Zero flag if true.
1433 The complications are to do with handling NaNs correctly. We want the
1434 property that if either argument is NaN, then the result of the
1435 comparison is False ... except if we're comparing for inequality,
1436 in which case the answer is True.
1438 Here's how the general (non-inequality) case works. As an
1439 example, consider generating the an equality test:
1441 pushl %eax -- we need to mess with this
1442 <get src1 to top of FPU stack>
1443 fcomp <src2 location in FPU stack> and pop pushed src1
1444 -- Result of comparison is in FPU Status Register bits
1446 fstsw %ax -- Move FPU Status Reg to %ax
1447 sahf -- move C3 C2 C0 from %ax to integer flag reg
1448 -- now the serious magic begins
1449 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
1450 sete %al -- %al = if arg1 == arg2 then 1 else 0
1451 andb %ah,%al -- %al &= %ah
1452 -- so %al == 1 iff (comparable && same); else it holds 0
1453 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
1454 else %al == 0xFF, ZeroFlag=0
1455 -- the zero flag is now set as we desire.
1458 The special case of inequality differs thusly:
1460 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
1461 setne %al -- %al = if arg1 /= arg2 then 1 else 0
1462 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
1463 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
1464 else (%al == 0xFF, ZF=0)
1466 pprInstr g@(GCMP cond src1 src2)
1467 | case cond of { NE -> True; other -> False }
1469 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1470 hcat [gtab, text "fcomp ", greg src2 1,
1471 text "; fstsw %ax ; sahf ; setpe %ah"],
1472 hcat [gtab, text "setne %al ; ",
1473 text "orb %ah,%al ; decb %al ; popl %eax"]
1477 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1478 hcat [gtab, text "fcomp ", greg src2 1,
1479 text "; fstsw %ax ; sahf ; setpo %ah"],
1480 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
1481 text "andb %ah,%al ; decb %al ; popl %eax"]
1484 {- On the 486, the flags set by FP compare are the unsigned ones!
1485 (This looks like a HACK to me. WDP 96/03)
1487 fix_FP_cond :: Cond -> Cond
1488 fix_FP_cond GE = GEU
1489 fix_FP_cond GTT = GU
1490 fix_FP_cond LTT = LU
1491 fix_FP_cond LE = LEU
1492 fix_FP_cond EQQ = EQQ
1494 -- there should be no others
1497 pprInstr g@(GABS sz src dst)
1498 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1499 pprInstr g@(GNEG sz src dst)
1500 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1502 pprInstr g@(GSQRT sz src dst)
1503 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1504 hcat [gtab, gcoerceto sz, gpop dst 1])
1505 pprInstr g@(GSIN sz src dst)
1506 = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1507 hcat [gtab, gcoerceto sz, gpop dst 1])
1508 pprInstr g@(GCOS sz src dst)
1509 = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1510 hcat [gtab, gcoerceto sz, gpop dst 1])
1511 pprInstr g@(GTAN sz src dst)
1512 = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1513 gpush src 0, text " ; fptan ; ",
1514 text " fstp %st(0)"] $$
1515 hcat [gtab, gcoerceto sz, gpop dst 1])
1517 -- In the translations for GADD, GMUL, GSUB and GDIV,
1518 -- the first two cases are mere optimisations. The otherwise clause
1519 -- generates correct code under all circumstances.
1521 pprInstr g@(GADD sz src1 src2 dst)
1523 = pprG g (text "\t#GADD-xxxcase1" $$
1524 hcat [gtab, gpush src2 0,
1525 text " ; faddp %st(0),", greg src1 1])
1527 = pprG g (text "\t#GADD-xxxcase2" $$
1528 hcat [gtab, gpush src1 0,
1529 text " ; faddp %st(0),", greg src2 1])
1531 = pprG g (hcat [gtab, gpush src1 0,
1532 text " ; fadd ", greg src2 1, text ",%st(0)",
1536 pprInstr g@(GMUL sz src1 src2 dst)
1538 = pprG g (text "\t#GMUL-xxxcase1" $$
1539 hcat [gtab, gpush src2 0,
1540 text " ; fmulp %st(0),", greg src1 1])
1542 = pprG g (text "\t#GMUL-xxxcase2" $$
1543 hcat [gtab, gpush src1 0,
1544 text " ; fmulp %st(0),", greg src2 1])
1546 = pprG g (hcat [gtab, gpush src1 0,
1547 text " ; fmul ", greg src2 1, text ",%st(0)",
1551 pprInstr g@(GSUB sz src1 src2 dst)
1553 = pprG g (text "\t#GSUB-xxxcase1" $$
1554 hcat [gtab, gpush src2 0,
1555 text " ; fsubrp %st(0),", greg src1 1])
1557 = pprG g (text "\t#GSUB-xxxcase2" $$
1558 hcat [gtab, gpush src1 0,
1559 text " ; fsubp %st(0),", greg src2 1])
1561 = pprG g (hcat [gtab, gpush src1 0,
1562 text " ; fsub ", greg src2 1, text ",%st(0)",
1566 pprInstr g@(GDIV sz src1 src2 dst)
1568 = pprG g (text "\t#GDIV-xxxcase1" $$
1569 hcat [gtab, gpush src2 0,
1570 text " ; fdivrp %st(0),", greg src1 1])
1572 = pprG g (text "\t#GDIV-xxxcase2" $$
1573 hcat [gtab, gpush src1 0,
1574 text " ; fdivp %st(0),", greg src2 1])
1576 = pprG g (hcat [gtab, gpush src1 0,
1577 text " ; fdiv ", greg src2 1, text ",%st(0)",
1582 = vcat [ ptext (sLit "\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1583 ptext (sLit "\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1586 --------------------------
1588 -- coerce %st(0) to the specified size
1589 gcoerceto F64 = empty
1590 gcoerceto F32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1593 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1595 = hcat [text "fstp ", greg reg offset]
1597 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1602 gregno (RealReg i) = i
1603 gregno other = --pprPanic "gregno" (ppr other)
1604 999 -- bogus; only needed for debug printing
1606 pprG :: Instr -> Doc -> Doc
1608 = (char '#' <> pprGInstr fake) $$ actual
1610 pprGInstr (GMOV src dst) = pprSizeRegReg (sLit "gmov") F64 src dst
1611 pprGInstr (GLD sz src dst) = pprSizeAddrReg (sLit "gld") sz src dst
1612 pprGInstr (GST sz src dst) = pprSizeRegAddr (sLit "gst") sz src dst
1614 pprGInstr (GLDZ dst) = pprSizeReg (sLit "gldz") F64 dst
1615 pprGInstr (GLD1 dst) = pprSizeReg (sLit "gld1") F64 dst
1617 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg (sLit "gftoi") F32 I32 src dst
1618 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg (sLit "gdtoi") F64 I32 src dst
1620 pprGInstr (GITOF src dst) = pprSizeSizeRegReg (sLit "gitof") I32 F32 src dst
1621 pprGInstr (GITOD src dst) = pprSizeSizeRegReg (sLit "gitod") I32 F64 src dst
1623 pprGInstr (GCMP co src dst) = pprCondRegReg (sLit "gcmp_") F64 co src dst
1624 pprGInstr (GABS sz src dst) = pprSizeRegReg (sLit "gabs") sz src dst
1625 pprGInstr (GNEG sz src dst) = pprSizeRegReg (sLit "gneg") sz src dst
1626 pprGInstr (GSQRT sz src dst) = pprSizeRegReg (sLit "gsqrt") sz src dst
1627 pprGInstr (GSIN sz src dst) = pprSizeRegReg (sLit "gsin") sz src dst
1628 pprGInstr (GCOS sz src dst) = pprSizeRegReg (sLit "gcos") sz src dst
1629 pprGInstr (GTAN sz src dst) = pprSizeRegReg (sLit "gtan") sz src dst
1631 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg (sLit "gadd") sz src1 src2 dst
1632 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg (sLit "gsub") sz src1 src2 dst
1633 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg (sLit "gmul") sz src1 src2 dst
1634 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg (sLit "gdiv") sz src1 src2 dst
1637 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1639 -- Continue with I386-only printing bits and bobs:
1641 pprDollImm :: Imm -> Doc
1643 pprDollImm i = ptext (sLit "$") <> pprImm i
1645 pprOperand :: MachRep -> Operand -> Doc
1646 pprOperand s (OpReg r) = pprReg s r
1647 pprOperand s (OpImm i) = pprDollImm i
1648 pprOperand s (OpAddr ea) = pprAddr ea
1650 pprMnemonic_ :: LitString -> Doc
1652 char '\t' <> ptext name <> space
1654 pprMnemonic :: LitString -> MachRep -> Doc
1655 pprMnemonic name size =
1656 char '\t' <> ptext name <> pprSize size <> space
1658 pprSizeImmOp :: LitString -> MachRep -> Imm -> Operand -> Doc
1659 pprSizeImmOp name size imm op1
1661 pprMnemonic name size,
1668 pprSizeOp :: LitString -> MachRep -> Operand -> Doc
1669 pprSizeOp name size op1
1671 pprMnemonic name size,
1675 pprSizeOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1676 pprSizeOpOp name size op1 op2
1678 pprMnemonic name size,
1679 pprOperand size op1,
1684 pprOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1685 pprOpOp name size op1 op2
1688 pprOperand size op1,
1693 pprSizeReg :: LitString -> MachRep -> Reg -> Doc
1694 pprSizeReg name size reg1
1696 pprMnemonic name size,
1700 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1701 pprSizeRegReg name size reg1 reg2
1703 pprMnemonic name size,
1709 pprRegReg :: LitString -> Reg -> Reg -> Doc
1710 pprRegReg name reg1 reg2
1713 pprReg wordRep reg1,
1718 pprOpReg :: LitString -> Operand -> Reg -> Doc
1719 pprOpReg name op1 reg2
1722 pprOperand wordRep op1,
1727 pprCondRegReg :: LitString -> MachRep -> Cond -> Reg -> Reg -> Doc
1728 pprCondRegReg name size cond reg1 reg2
1739 pprSizeSizeRegReg :: LitString -> MachRep -> MachRep -> Reg -> Reg -> Doc
1740 pprSizeSizeRegReg name size1 size2 reg1 reg2
1753 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
1754 pprSizeRegRegReg name size reg1 reg2 reg3
1756 pprMnemonic name size,
1764 pprSizeAddrReg :: LitString -> MachRep -> AddrMode -> Reg -> Doc
1765 pprSizeAddrReg name size op dst
1767 pprMnemonic name size,
1773 pprSizeRegAddr :: LitString -> MachRep -> Reg -> AddrMode -> Doc
1774 pprSizeRegAddr name size src op
1776 pprMnemonic name size,
1782 pprShift :: LitString -> MachRep -> Operand -> Operand -> Doc
1783 pprShift name size src dest
1785 pprMnemonic name size,
1786 pprOperand I8 src, -- src is 8-bit sized
1788 pprOperand size dest
1791 pprSizeOpOpCoerce :: LitString -> MachRep -> MachRep -> Operand -> Operand -> Doc
1792 pprSizeOpOpCoerce name size1 size2 op1 op2
1793 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1794 pprOperand size1 op1,
1796 pprOperand size2 op2
1799 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1800 pprCondInstr name cond arg
1801 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1803 #endif /* i386_TARGET_ARCH */
1806 -- ------------------------------------------------------------------------------- pprInstr for a SPARC
1808 #if sparc_TARGET_ARCH
1810 -- a clumsy hack for now, to handle possible double alignment problems
1812 -- even clumsier, to allow for RegReg regs that show when doing indexed
1813 -- reads (bytearrays).
1816 pprInstr (SPILL reg slot)
1818 ptext (sLit "\tSPILL"),
1822 ptext (sLit "SLOT") <> parens (int slot)]
1824 pprInstr (RELOAD slot reg)
1826 ptext (sLit "\tRELOAD"),
1828 ptext (sLit "SLOT") <> parens (int slot),
1832 -- Translate to the following:
1835 -- ld [g1+4],%f(n+1)
1836 -- sub g1,g2,g1 -- to restore g1
1838 pprInstr (LD F64 (AddrRegReg g1 g2) reg)
1840 hcat [ptext (sLit "\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1841 hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1842 hcat [pp_ld_lbracket, pprReg g1, ptext (sLit "+4]"), comma, pprReg (fPair reg)],
1843 hcat [ptext (sLit "\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1848 -- ld [addr+4],%f(n+1)
1849 pprInstr (LD F64 addr reg) | isJust off_addr
1851 hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1852 hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1855 off_addr = addrOffset addr 4
1856 addr2 = case off_addr of Just x -> x
1859 pprInstr (LD size addr reg)
1861 ptext (sLit "\tld"),
1870 -- The same clumsy hack as above
1872 -- Translate to the following:
1875 -- st %f(n+1),[g1+4]
1876 -- sub g1,g2,g1 -- to restore g1
1877 pprInstr (ST F64 reg (AddrRegReg g1 g2))
1879 hcat [ptext (sLit "\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1880 hcat [ptext (sLit "\tst\t"), pprReg reg, pp_comma_lbracket,
1882 hcat [ptext (sLit "\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1883 pprReg g1, ptext (sLit "+4]")],
1884 hcat [ptext (sLit "\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1889 -- st %f(n+1),[addr+4]
1890 pprInstr (ST F64 reg addr) | isJust off_addr
1892 hcat [ptext (sLit "\tst\t"), pprReg reg, pp_comma_lbracket,
1893 pprAddr addr, rbrack],
1894 hcat [ptext (sLit "\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1895 pprAddr addr2, rbrack]
1898 off_addr = addrOffset addr 4
1899 addr2 = case off_addr of Just x -> x
1901 -- no distinction is made between signed and unsigned bytes on stores for the
1902 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1903 -- so we call a special-purpose pprSize for ST..
1905 pprInstr (ST size reg addr)
1907 ptext (sLit "\tst"),
1916 pprInstr (ADD x cc reg1 ri reg2)
1917 | not x && not cc && riZero ri
1918 = hcat [ ptext (sLit "\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1920 = pprRegRIReg (if x then sLit "addx" else sLit "add") cc reg1 ri reg2
1922 pprInstr (SUB x cc reg1 ri reg2)
1923 | not x && cc && reg2 == g0
1924 = hcat [ ptext (sLit "\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1925 | not x && not cc && riZero ri
1926 = hcat [ ptext (sLit "\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1928 = pprRegRIReg (if x then sLit "subx" else sLit "sub") cc reg1 ri reg2
1930 pprInstr (AND b reg1 ri reg2) = pprRegRIReg (sLit "and") b reg1 ri reg2
1931 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg (sLit "andn") b reg1 ri reg2
1933 pprInstr (OR b reg1 ri reg2)
1934 | not b && reg1 == g0
1935 = let doit = hcat [ ptext (sLit "\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1937 RIReg rrr | rrr == reg2 -> empty
1940 = pprRegRIReg (sLit "or") b reg1 ri reg2
1942 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg (sLit "orn") b reg1 ri reg2
1944 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg (sLit "xor") b reg1 ri reg2
1945 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg (sLit "xnor") b reg1 ri reg2
1947 pprInstr (SLL reg1 ri reg2) = pprRegRIReg (sLit "sll") False reg1 ri reg2
1948 pprInstr (SRL reg1 ri reg2) = pprRegRIReg (sLit "srl") False reg1 ri reg2
1949 pprInstr (SRA reg1 ri reg2) = pprRegRIReg (sLit "sra") False reg1 ri reg2
1951 pprInstr (RDY rd) = ptext (sLit "\trd\t%y,") <> pprReg rd
1952 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg (sLit "smul") b reg1 ri reg2
1953 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg (sLit "umul") b reg1 ri reg2
1955 pprInstr (SETHI imm reg)
1957 ptext (sLit "\tsethi\t"),
1963 pprInstr NOP = ptext (sLit "\tnop")
1965 pprInstr (FABS F32 reg1 reg2) = pprSizeRegReg (sLit "fabs") F32 reg1 reg2
1966 pprInstr (FABS F64 reg1 reg2)
1967 = (<>) (pprSizeRegReg (sLit "fabs") F32 reg1 reg2)
1968 (if (reg1 == reg2) then empty
1969 else (<>) (char '\n')
1970 (pprSizeRegReg (sLit "fmov") F32 (fPair reg1) (fPair reg2)))
1972 pprInstr (FADD size reg1 reg2 reg3)
1973 = pprSizeRegRegReg (sLit "fadd") size reg1 reg2 reg3
1974 pprInstr (FCMP e size reg1 reg2)
1975 = pprSizeRegReg (if e then sLit "fcmpe" else sLit "fcmp") size reg1 reg2
1976 pprInstr (FDIV size reg1 reg2 reg3)
1977 = pprSizeRegRegReg (sLit "fdiv") size reg1 reg2 reg3
1979 pprInstr (FMOV F32 reg1 reg2) = pprSizeRegReg (sLit "fmov") F32 reg1 reg2
1980 pprInstr (FMOV F64 reg1 reg2)
1981 = (<>) (pprSizeRegReg (sLit "fmov") F32 reg1 reg2)
1982 (if (reg1 == reg2) then empty
1983 else (<>) (char '\n')
1984 (pprSizeRegReg (sLit "fmov") F32 (fPair reg1) (fPair reg2)))
1986 pprInstr (FMUL size reg1 reg2 reg3)
1987 = pprSizeRegRegReg (sLit "fmul") size reg1 reg2 reg3
1989 pprInstr (FNEG F32 reg1 reg2) = pprSizeRegReg (sLit "fneg") F32 reg1 reg2
1990 pprInstr (FNEG F64 reg1 reg2)
1991 = (<>) (pprSizeRegReg (sLit "fneg") F32 reg1 reg2)
1992 (if (reg1 == reg2) then empty
1993 else (<>) (char '\n')
1994 (pprSizeRegReg (sLit "fmov") F32 (fPair reg1) (fPair reg2)))
1996 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg (sLit "fsqrt") size reg1 reg2
1997 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "fsub") size reg1 reg2 reg3
1998 pprInstr (FxTOy size1 size2 reg1 reg2)
2011 pprReg reg1, comma, pprReg reg2
2015 pprInstr (BI cond b lab)
2017 ptext (sLit "\tb"), pprCond cond,
2018 if b then pp_comma_a else empty,
2023 pprInstr (BF cond b lab)
2025 ptext (sLit "\tfb"), pprCond cond,
2026 if b then pp_comma_a else empty,
2031 pprInstr (JMP addr) = (<>) (ptext (sLit "\tjmp\t")) (pprAddr addr)
2033 pprInstr (CALL (Left imm) n _)
2034 = hcat [ ptext (sLit "\tcall\t"), pprImm imm, comma, int n ]
2035 pprInstr (CALL (Right reg) n _)
2036 = hcat [ ptext (sLit "\tcall\t"), pprReg reg, comma, int n ]
2039 pprRI (RIReg r) = pprReg r
2040 pprRI (RIImm r) = pprImm r
2042 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
2043 pprSizeRegReg name size reg1 reg2
2048 F32 -> ptext (sLit "s\t")
2049 F64 -> ptext (sLit "d\t")),
2055 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
2056 pprSizeRegRegReg name size reg1 reg2 reg3
2061 F32 -> ptext (sLit "s\t")
2062 F64 -> ptext (sLit "d\t")),
2070 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
2071 pprRegRIReg name b reg1 ri reg2
2075 if b then ptext (sLit "cc\t") else char '\t',
2083 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
2084 pprRIReg name b ri reg1
2088 if b then ptext (sLit "cc\t") else char '\t',
2094 pp_ld_lbracket = ptext (sLit "\tld\t[")
2095 pp_rbracket_comma = text "],"
2096 pp_comma_lbracket = text ",["
2097 pp_comma_a = text ",a"
2099 #endif /* sparc_TARGET_ARCH */
2102 -- -----------------------------------------------------------------------------
2103 -- pprInstr for PowerPC
2105 #if powerpc_TARGET_ARCH
2107 pprInstr (SPILL reg slot)
2109 ptext (sLit "\tSPILL"),
2113 ptext (sLit "SLOT") <> parens (int slot)]
2115 pprInstr (RELOAD slot reg)
2117 ptext (sLit "\tRELOAD"),
2119 ptext (sLit "SLOT") <> parens (int slot),
2123 pprInstr (LD sz reg addr) = hcat [
2132 case addr of AddrRegImm _ _ -> empty
2133 AddrRegReg _ _ -> char 'x',
2139 pprInstr (LA sz reg addr) = hcat [
2148 case addr of AddrRegImm _ _ -> empty
2149 AddrRegReg _ _ -> char 'x',
2155 pprInstr (ST sz reg addr) = hcat [
2159 case addr of AddrRegImm _ _ -> empty
2160 AddrRegReg _ _ -> char 'x',
2166 pprInstr (STU sz reg addr) = hcat [
2171 case addr of AddrRegImm _ _ -> empty
2172 AddrRegReg _ _ -> char 'x',
2177 pprInstr (LIS reg imm) = hcat [
2185 pprInstr (LI reg imm) = hcat [
2193 pprInstr (MR reg1 reg2)
2194 | reg1 == reg2 = empty
2195 | otherwise = hcat [
2197 case regClass reg1 of
2198 RcInteger -> ptext (sLit "mr")
2199 _ -> ptext (sLit "fmr"),
2205 pprInstr (CMP sz reg ri) = hcat [
2221 pprInstr (CMPL sz reg ri) = hcat [
2231 ptext (sLit "cmpl"),
2237 pprInstr (BCC cond (BlockId id)) = hcat [
2244 where lbl = mkAsmTempLabel id
2246 pprInstr (BCCFAR cond (BlockId id)) = vcat [
2249 pprCond (condNegate cond),
2250 ptext (sLit "\t$+8")
2253 ptext (sLit "\tb\t"),
2257 where lbl = mkAsmTempLabel id
2259 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
2266 pprInstr (MTCTR reg) = hcat [
2268 ptext (sLit "mtctr"),
2272 pprInstr (BCTR _) = hcat [
2276 pprInstr (BL lbl _) = hcat [
2277 ptext (sLit "\tbl\t"),
2280 pprInstr (BCTRL _) = hcat [
2282 ptext (sLit "bctrl")
2284 pprInstr (ADD reg1 reg2 ri) = pprLogic (sLit "add") reg1 reg2 ri
2285 pprInstr (ADDIS reg1 reg2 imm) = hcat [
2287 ptext (sLit "addis"),
2296 pprInstr (ADDC reg1 reg2 reg3) = pprLogic (sLit "addc") reg1 reg2 (RIReg reg3)
2297 pprInstr (ADDE reg1 reg2 reg3) = pprLogic (sLit "adde") reg1 reg2 (RIReg reg3)
2298 pprInstr (SUBF reg1 reg2 reg3) = pprLogic (sLit "subf") reg1 reg2 (RIReg reg3)
2299 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic (sLit "mullw") reg1 reg2 ri
2300 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic (sLit "mull") reg1 reg2 ri
2301 pprInstr (DIVW reg1 reg2 reg3) = pprLogic (sLit "divw") reg1 reg2 (RIReg reg3)
2302 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic (sLit "divwu") reg1 reg2 (RIReg reg3)
2304 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
2305 hcat [ ptext (sLit "\tmullwo\t"), pprReg reg1, ptext (sLit ", "),
2306 pprReg reg2, ptext (sLit ", "),
2308 hcat [ ptext (sLit "\tmfxer\t"), pprReg reg1 ],
2309 hcat [ ptext (sLit "\trlwinm\t"), pprReg reg1, ptext (sLit ", "),
2310 pprReg reg1, ptext (sLit ", "),
2311 ptext (sLit "2, 31, 31") ]
2314 -- for some reason, "andi" doesn't exist.
2315 -- we'll use "andi." instead.
2316 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
2318 ptext (sLit "andi."),
2326 pprInstr (AND reg1 reg2 ri) = pprLogic (sLit "and") reg1 reg2 ri
2328 pprInstr (OR reg1 reg2 ri) = pprLogic (sLit "or") reg1 reg2 ri
2329 pprInstr (XOR reg1 reg2 ri) = pprLogic (sLit "xor") reg1 reg2 ri
2331 pprInstr (XORIS reg1 reg2 imm) = hcat [
2333 ptext (sLit "xoris"),
2342 pprInstr (EXTS sz reg1 reg2) = hcat [
2344 ptext (sLit "exts"),
2352 pprInstr (NEG reg1 reg2) = pprUnary (sLit "neg") reg1 reg2
2353 pprInstr (NOT reg1 reg2) = pprUnary (sLit "not") reg1 reg2
2355 pprInstr (SLW reg1 reg2 ri) = pprLogic (sLit "slw") reg1 reg2 (limitShiftRI ri)
2356 pprInstr (SRW reg1 reg2 ri) = pprLogic (sLit "srw") reg1 reg2 (limitShiftRI ri)
2357 pprInstr (SRAW reg1 reg2 ri) = pprLogic (sLit "sraw") reg1 reg2 (limitShiftRI ri)
2358 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
2359 ptext (sLit "\trlwinm\t"),
2371 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF (sLit "fadd") sz reg1 reg2 reg3
2372 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF (sLit "fsub") sz reg1 reg2 reg3
2373 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF (sLit "fmul") sz reg1 reg2 reg3
2374 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF (sLit "fdiv") sz reg1 reg2 reg3
2375 pprInstr (FNEG reg1 reg2) = pprUnary (sLit "fneg") reg1 reg2
2377 pprInstr (FCMP reg1 reg2) = hcat [
2379 ptext (sLit "fcmpu\tcr0, "),
2380 -- Note: we're using fcmpu, not fcmpo
2381 -- The difference is with fcmpo, compare with NaN is an invalid operation.
2382 -- We don't handle invalid fp ops, so we don't care
2388 pprInstr (FCTIWZ reg1 reg2) = pprUnary (sLit "fctiwz") reg1 reg2
2389 pprInstr (FRSP reg1 reg2) = pprUnary (sLit "frsp") reg1 reg2
2391 pprInstr (CRNOR dst src1 src2) = hcat [
2392 ptext (sLit "\tcrnor\t"),
2400 pprInstr (MFCR reg) = hcat [
2402 ptext (sLit "mfcr"),
2407 pprInstr (MFLR reg) = hcat [
2409 ptext (sLit "mflr"),
2414 pprInstr (FETCHPC reg) = vcat [
2415 ptext (sLit "\tbcl\t20,31,1f"),
2416 hcat [ ptext (sLit "1:\tmflr\t"), pprReg reg ]
2419 pprInstr LWSYNC = ptext (sLit "\tlwsync")
2421 pprInstr _ = panic "pprInstr (ppc)"
2423 pprLogic op reg1 reg2 ri = hcat [
2428 RIImm _ -> char 'i',
2437 pprUnary op reg1 reg2 = hcat [
2446 pprBinaryF op sz reg1 reg2 reg3 = hcat [
2459 pprRI (RIReg r) = pprReg r
2460 pprRI (RIImm r) = pprImm r
2462 pprFSize F64 = empty
2463 pprFSize F32 = char 's'
2465 -- limit immediate argument for shift instruction to range 0..32
2466 -- (yes, the maximum is really 32, not 31)
2467 limitShiftRI :: RI -> RI
2468 limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
2471 #endif /* powerpc_TARGET_ARCH */
2474 -- -----------------------------------------------------------------------------
2475 -- Converting floating-point literals to integrals for printing
2477 castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)
2478 castFloatToWord8Array = castSTUArray
2480 castDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8)
2481 castDoubleToWord8Array = castSTUArray
2483 -- floatToBytes and doubleToBytes convert to the host's byte
2484 -- order. Providing that we're not cross-compiling for a
2485 -- target with the opposite endianness, this should work ok
2488 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
2489 -- could they be merged?
2491 floatToBytes :: Float -> [Int]
2494 arr <- newArray_ ((0::Int),3)
2496 arr <- castFloatToWord8Array arr
2497 i0 <- readArray arr 0
2498 i1 <- readArray arr 1
2499 i2 <- readArray arr 2
2500 i3 <- readArray arr 3
2501 return (map fromIntegral [i0,i1,i2,i3])
2504 doubleToBytes :: Double -> [Int]
2507 arr <- newArray_ ((0::Int),7)
2509 arr <- castDoubleToWord8Array arr
2510 i0 <- readArray arr 0
2511 i1 <- readArray arr 1
2512 i2 <- readArray arr 2
2513 i3 <- readArray arr 3
2514 i4 <- readArray arr 4
2515 i5 <- readArray arr 5
2516 i6 <- readArray arr 6
2517 i7 <- readArray arr 7
2518 return (map fromIntegral [i0,i1,i2,i3,i4,i5,i6,i7])