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 #include "nativeGen/NCG.h"
16 pprNatCmmTop, pprBasicBlock,
17 pprInstr, pprSize, pprUserReg,
21 #include "HsVersions.h"
24 import MachOp ( MachRep(..), wordRep, isFloatingRep )
25 import MachRegs -- may differ per-platform
28 import CLabel ( CLabel, pprCLabel, externallyVisibleCLabel,
29 labelDynamic, mkAsmTempLabel, entryLblToInfoLbl )
30 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
31 import CLabel ( mkDeadStripPreventer )
34 import Panic ( panic )
35 import Unique ( pprUnique )
38 import qualified Outputable
40 import StaticFlags ( opt_PIC, opt_Static )
43 import Data.Word ( Word8 )
44 import Control.Monad.ST
45 import Data.Char ( chr, ord )
46 import Data.Maybe ( isJust )
48 #if powerpc_TARGET_ARCH || darwin_TARGET_OS
49 import Data.Word(Word32)
53 -- -----------------------------------------------------------------------------
54 -- Printing this stuff out
56 asmSDoc d = Outputable.withPprStyleDoc (
57 Outputable.mkCodeStyle Outputable.AsmStyle) d
58 pprCLabel_asm l = asmSDoc (pprCLabel l)
60 pprNatCmmTop :: NatCmmTop -> Doc
61 pprNatCmmTop (CmmData section dats) =
62 pprSectionHeader section $$ vcat (map pprData dats)
64 -- special case for split markers:
65 pprNatCmmTop (CmmProc [] lbl _ []) = pprLabel lbl
67 pprNatCmmTop (CmmProc info lbl params blocks) =
68 pprSectionHeader Text $$
71 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
72 pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
75 vcat (map pprData info) $$
76 pprLabel (entryLblToInfoLbl lbl)
80 (BasicBlock _ instrs : rest) ->
81 (if null info then pprLabel lbl else empty) $$
82 -- the first block doesn't get a label:
83 vcat (map pprInstr instrs) $$
84 vcat (map pprBasicBlock rest)
86 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
87 -- If we are using the .subsections_via_symbols directive
88 -- (available on recent versions of Darwin),
89 -- we have to make sure that there is some kind of reference
90 -- from the entry code to a label on the _top_ of of the info table,
91 -- so that the linker will not think it is unreferenced and dead-strip
92 -- it. That's why the label is called a DeadStripPreventer (_dsp).
95 <+> pprCLabel_asm (entryLblToInfoLbl lbl)
97 <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
102 pprBasicBlock :: NatBasicBlock -> Doc
103 pprBasicBlock (BasicBlock (BlockId id) instrs) =
104 pprLabel (mkAsmTempLabel id) $$
105 vcat (map pprInstr instrs)
107 -- -----------------------------------------------------------------------------
108 -- pprReg: print a 'Reg'
110 -- For x86, the way we print a register name depends
111 -- on which bit of it we care about. Yurgh.
113 pprUserReg :: Reg -> Doc
114 pprUserReg = pprReg IF_ARCH_i386(I32,) IF_ARCH_x86_64(I64,)
116 pprReg :: IF_ARCH_i386(MachRep ->,) IF_ARCH_x86_64(MachRep ->,) Reg -> Doc
118 pprReg IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) r
120 RealReg i -> ppr_reg_no IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) i
121 VirtualRegI u -> text "%vI_" <> asmSDoc (pprUnique u)
122 VirtualRegHi u -> text "%vHi_" <> asmSDoc (pprUnique u)
123 VirtualRegF u -> text "%vF_" <> asmSDoc (pprUnique u)
124 VirtualRegD u -> text "%vD_" <> asmSDoc (pprUnique u)
126 #if alpha_TARGET_ARCH
127 ppr_reg_no :: Int -> Doc
130 0 -> SLIT("$0"); 1 -> SLIT("$1");
131 2 -> SLIT("$2"); 3 -> SLIT("$3");
132 4 -> SLIT("$4"); 5 -> SLIT("$5");
133 6 -> SLIT("$6"); 7 -> SLIT("$7");
134 8 -> SLIT("$8"); 9 -> SLIT("$9");
135 10 -> SLIT("$10"); 11 -> SLIT("$11");
136 12 -> SLIT("$12"); 13 -> SLIT("$13");
137 14 -> SLIT("$14"); 15 -> SLIT("$15");
138 16 -> SLIT("$16"); 17 -> SLIT("$17");
139 18 -> SLIT("$18"); 19 -> SLIT("$19");
140 20 -> SLIT("$20"); 21 -> SLIT("$21");
141 22 -> SLIT("$22"); 23 -> SLIT("$23");
142 24 -> SLIT("$24"); 25 -> SLIT("$25");
143 26 -> SLIT("$26"); 27 -> SLIT("$27");
144 28 -> SLIT("$28"); 29 -> SLIT("$29");
145 30 -> SLIT("$30"); 31 -> SLIT("$31");
146 32 -> SLIT("$f0"); 33 -> SLIT("$f1");
147 34 -> SLIT("$f2"); 35 -> SLIT("$f3");
148 36 -> SLIT("$f4"); 37 -> SLIT("$f5");
149 38 -> SLIT("$f6"); 39 -> SLIT("$f7");
150 40 -> SLIT("$f8"); 41 -> SLIT("$f9");
151 42 -> SLIT("$f10"); 43 -> SLIT("$f11");
152 44 -> SLIT("$f12"); 45 -> SLIT("$f13");
153 46 -> SLIT("$f14"); 47 -> SLIT("$f15");
154 48 -> SLIT("$f16"); 49 -> SLIT("$f17");
155 50 -> SLIT("$f18"); 51 -> SLIT("$f19");
156 52 -> SLIT("$f20"); 53 -> SLIT("$f21");
157 54 -> SLIT("$f22"); 55 -> SLIT("$f23");
158 56 -> SLIT("$f24"); 57 -> SLIT("$f25");
159 58 -> SLIT("$f26"); 59 -> SLIT("$f27");
160 60 -> SLIT("$f28"); 61 -> SLIT("$f29");
161 62 -> SLIT("$f30"); 63 -> SLIT("$f31");
162 _ -> SLIT("very naughty alpha register")
166 ppr_reg_no :: MachRep -> Int -> Doc
167 ppr_reg_no I8 = ppr_reg_byte
168 ppr_reg_no I16 = ppr_reg_word
169 ppr_reg_no _ = ppr_reg_long
171 ppr_reg_byte i = ptext
173 0 -> SLIT("%al"); 1 -> SLIT("%bl");
174 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
175 _ -> SLIT("very naughty I386 byte register")
178 ppr_reg_word i = ptext
180 0 -> SLIT("%ax"); 1 -> SLIT("%bx");
181 2 -> SLIT("%cx"); 3 -> SLIT("%dx");
182 4 -> SLIT("%si"); 5 -> SLIT("%di");
183 6 -> SLIT("%bp"); 7 -> SLIT("%sp");
184 _ -> SLIT("very naughty I386 word register")
187 ppr_reg_long i = ptext
189 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
190 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
191 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
192 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
193 8 -> SLIT("%fake0"); 9 -> SLIT("%fake1");
194 10 -> SLIT("%fake2"); 11 -> SLIT("%fake3");
195 12 -> SLIT("%fake4"); 13 -> SLIT("%fake5");
196 _ -> SLIT("very naughty I386 register")
200 #if x86_64_TARGET_ARCH
201 ppr_reg_no :: MachRep -> Int -> Doc
202 ppr_reg_no I8 = ppr_reg_byte
203 ppr_reg_no I16 = ppr_reg_word
204 ppr_reg_no I32 = ppr_reg_long
205 ppr_reg_no _ = ppr_reg_quad
207 ppr_reg_byte i = ptext
209 0 -> SLIT("%al"); 1 -> SLIT("%bl");
210 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
211 4 -> SLIT("%sil"); 5 -> SLIT("%dil"); -- new 8-bit regs!
212 6 -> SLIT("%bpl"); 7 -> SLIT("%spl");
213 8 -> SLIT("%r8b"); 9 -> SLIT("%r9b");
214 10 -> SLIT("%r10b"); 11 -> SLIT("%r11b");
215 12 -> SLIT("%r12b"); 13 -> SLIT("%r13b");
216 14 -> SLIT("%r14b"); 15 -> SLIT("%r15b");
217 _ -> SLIT("very naughty x86_64 byte register")
220 ppr_reg_word i = ptext
222 0 -> SLIT("%ax"); 1 -> SLIT("%bx");
223 2 -> SLIT("%cx"); 3 -> SLIT("%dx");
224 4 -> SLIT("%si"); 5 -> SLIT("%di");
225 6 -> SLIT("%bp"); 7 -> SLIT("%sp");
226 8 -> SLIT("%r8w"); 9 -> SLIT("%r9w");
227 10 -> SLIT("%r10w"); 11 -> SLIT("%r11w");
228 12 -> SLIT("%r12w"); 13 -> SLIT("%r13w");
229 14 -> SLIT("%r14w"); 15 -> SLIT("%r15w");
230 _ -> SLIT("very naughty x86_64 word register")
233 ppr_reg_long i = ptext
235 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
236 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
237 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
238 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
239 8 -> SLIT("%r8d"); 9 -> SLIT("%r9d");
240 10 -> SLIT("%r10d"); 11 -> SLIT("%r11d");
241 12 -> SLIT("%r12d"); 13 -> SLIT("%r13d");
242 14 -> SLIT("%r14d"); 15 -> SLIT("%r15d");
243 _ -> SLIT("very naughty x86_64 register")
246 ppr_reg_quad i = ptext
248 0 -> SLIT("%rax"); 1 -> SLIT("%rbx");
249 2 -> SLIT("%rcx"); 3 -> SLIT("%rdx");
250 4 -> SLIT("%rsi"); 5 -> SLIT("%rdi");
251 6 -> SLIT("%rbp"); 7 -> SLIT("%rsp");
252 8 -> SLIT("%r8"); 9 -> SLIT("%r9");
253 10 -> SLIT("%r10"); 11 -> SLIT("%r11");
254 12 -> SLIT("%r12"); 13 -> SLIT("%r13");
255 14 -> SLIT("%r14"); 15 -> SLIT("%r15");
256 16 -> SLIT("%xmm0"); 17 -> SLIT("%xmm1");
257 18 -> SLIT("%xmm2"); 19 -> SLIT("%xmm3");
258 20 -> SLIT("%xmm4"); 21 -> SLIT("%xmm5");
259 22 -> SLIT("%xmm6"); 23 -> SLIT("%xmm7");
260 24 -> SLIT("%xmm8"); 25 -> SLIT("%xmm9");
261 26 -> SLIT("%xmm10"); 27 -> SLIT("%xmm11");
262 28 -> SLIT("%xmm12"); 29 -> SLIT("%xmm13");
263 30 -> SLIT("%xmm14"); 31 -> SLIT("%xmm15");
264 _ -> SLIT("very naughty x86_64 register")
268 #if sparc_TARGET_ARCH
269 ppr_reg_no :: Int -> Doc
272 0 -> SLIT("%g0"); 1 -> SLIT("%g1");
273 2 -> SLIT("%g2"); 3 -> SLIT("%g3");
274 4 -> SLIT("%g4"); 5 -> SLIT("%g5");
275 6 -> SLIT("%g6"); 7 -> SLIT("%g7");
276 8 -> SLIT("%o0"); 9 -> SLIT("%o1");
277 10 -> SLIT("%o2"); 11 -> SLIT("%o3");
278 12 -> SLIT("%o4"); 13 -> SLIT("%o5");
279 14 -> SLIT("%o6"); 15 -> SLIT("%o7");
280 16 -> SLIT("%l0"); 17 -> SLIT("%l1");
281 18 -> SLIT("%l2"); 19 -> SLIT("%l3");
282 20 -> SLIT("%l4"); 21 -> SLIT("%l5");
283 22 -> SLIT("%l6"); 23 -> SLIT("%l7");
284 24 -> SLIT("%i0"); 25 -> SLIT("%i1");
285 26 -> SLIT("%i2"); 27 -> SLIT("%i3");
286 28 -> SLIT("%i4"); 29 -> SLIT("%i5");
287 30 -> SLIT("%i6"); 31 -> SLIT("%i7");
288 32 -> SLIT("%f0"); 33 -> SLIT("%f1");
289 34 -> SLIT("%f2"); 35 -> SLIT("%f3");
290 36 -> SLIT("%f4"); 37 -> SLIT("%f5");
291 38 -> SLIT("%f6"); 39 -> SLIT("%f7");
292 40 -> SLIT("%f8"); 41 -> SLIT("%f9");
293 42 -> SLIT("%f10"); 43 -> SLIT("%f11");
294 44 -> SLIT("%f12"); 45 -> SLIT("%f13");
295 46 -> SLIT("%f14"); 47 -> SLIT("%f15");
296 48 -> SLIT("%f16"); 49 -> SLIT("%f17");
297 50 -> SLIT("%f18"); 51 -> SLIT("%f19");
298 52 -> SLIT("%f20"); 53 -> SLIT("%f21");
299 54 -> SLIT("%f22"); 55 -> SLIT("%f23");
300 56 -> SLIT("%f24"); 57 -> SLIT("%f25");
301 58 -> SLIT("%f26"); 59 -> SLIT("%f27");
302 60 -> SLIT("%f28"); 61 -> SLIT("%f29");
303 62 -> SLIT("%f30"); 63 -> SLIT("%f31");
304 _ -> SLIT("very naughty sparc register")
307 #if powerpc_TARGET_ARCH
309 ppr_reg_no :: Int -> Doc
312 0 -> SLIT("r0"); 1 -> SLIT("r1");
313 2 -> SLIT("r2"); 3 -> SLIT("r3");
314 4 -> SLIT("r4"); 5 -> SLIT("r5");
315 6 -> SLIT("r6"); 7 -> SLIT("r7");
316 8 -> SLIT("r8"); 9 -> SLIT("r9");
317 10 -> SLIT("r10"); 11 -> SLIT("r11");
318 12 -> SLIT("r12"); 13 -> SLIT("r13");
319 14 -> SLIT("r14"); 15 -> SLIT("r15");
320 16 -> SLIT("r16"); 17 -> SLIT("r17");
321 18 -> SLIT("r18"); 19 -> SLIT("r19");
322 20 -> SLIT("r20"); 21 -> SLIT("r21");
323 22 -> SLIT("r22"); 23 -> SLIT("r23");
324 24 -> SLIT("r24"); 25 -> SLIT("r25");
325 26 -> SLIT("r26"); 27 -> SLIT("r27");
326 28 -> SLIT("r28"); 29 -> SLIT("r29");
327 30 -> SLIT("r30"); 31 -> SLIT("r31");
328 32 -> SLIT("f0"); 33 -> SLIT("f1");
329 34 -> SLIT("f2"); 35 -> SLIT("f3");
330 36 -> SLIT("f4"); 37 -> SLIT("f5");
331 38 -> SLIT("f6"); 39 -> SLIT("f7");
332 40 -> SLIT("f8"); 41 -> SLIT("f9");
333 42 -> SLIT("f10"); 43 -> SLIT("f11");
334 44 -> SLIT("f12"); 45 -> SLIT("f13");
335 46 -> SLIT("f14"); 47 -> SLIT("f15");
336 48 -> SLIT("f16"); 49 -> SLIT("f17");
337 50 -> SLIT("f18"); 51 -> SLIT("f19");
338 52 -> SLIT("f20"); 53 -> SLIT("f21");
339 54 -> SLIT("f22"); 55 -> SLIT("f23");
340 56 -> SLIT("f24"); 57 -> SLIT("f25");
341 58 -> SLIT("f26"); 59 -> SLIT("f27");
342 60 -> SLIT("f28"); 61 -> SLIT("f29");
343 62 -> SLIT("f30"); 63 -> SLIT("f31");
344 _ -> SLIT("very naughty powerpc register")
347 ppr_reg_no :: Int -> Doc
348 ppr_reg_no i | i <= 31 = int i -- GPRs
349 | i <= 63 = int (i-32) -- FPRs
350 | otherwise = ptext SLIT("very naughty powerpc register")
355 -- -----------------------------------------------------------------------------
356 -- pprSize: print a 'Size'
358 #if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH || sparc_TARGET_ARCH
359 pprSize :: MachRep -> Doc
361 pprSize :: Size -> Doc
364 pprSize x = ptext (case x of
365 #if alpha_TARGET_ARCH
368 -- W -> SLIT("w") UNUSED
369 -- Wu -> SLIT("wu") UNUSED
372 -- FF -> SLIT("f") UNUSED
373 -- DF -> SLIT("d") UNUSED
374 -- GF -> SLIT("g") UNUSED
375 -- SF -> SLIT("s") UNUSED
378 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
389 #if x86_64_TARGET_ARCH
390 F32 -> SLIT("ss") -- "scalar single-precision float" (SSE2)
391 F64 -> SLIT("sd") -- "scalar double-precision float" (SSE2)
393 #if sparc_TARGET_ARCH
400 pprStSize :: MachRep -> Doc
401 pprStSize x = ptext (case x of
408 #if powerpc_TARGET_ARCH
417 -- -----------------------------------------------------------------------------
418 -- pprCond: print a 'Cond'
420 pprCond :: Cond -> Doc
422 pprCond c = ptext (case c of {
423 #if alpha_TARGET_ARCH
433 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
434 GEU -> SLIT("ae"); LU -> SLIT("b");
435 EQQ -> SLIT("e"); GTT -> SLIT("g");
436 GE -> SLIT("ge"); GU -> SLIT("a");
437 LTT -> SLIT("l"); LE -> SLIT("le");
438 LEU -> SLIT("be"); NE -> SLIT("ne");
439 NEG -> SLIT("s"); POS -> SLIT("ns");
440 CARRY -> SLIT("c"); OFLO -> SLIT("o");
441 PARITY -> SLIT("p"); NOTPARITY -> SLIT("np");
442 ALWAYS -> SLIT("mp") -- hack
444 #if sparc_TARGET_ARCH
445 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
446 GEU -> SLIT("geu"); LU -> SLIT("lu");
447 EQQ -> SLIT("e"); GTT -> SLIT("g");
448 GE -> SLIT("ge"); GU -> SLIT("gu");
449 LTT -> SLIT("l"); LE -> SLIT("le");
450 LEU -> SLIT("leu"); NE -> SLIT("ne");
451 NEG -> SLIT("neg"); POS -> SLIT("pos");
452 VC -> SLIT("vc"); VS -> SLIT("vs")
454 #if powerpc_TARGET_ARCH
456 EQQ -> SLIT("eq"); NE -> SLIT("ne");
457 LTT -> SLIT("lt"); GE -> SLIT("ge");
458 GTT -> SLIT("gt"); LE -> SLIT("le");
459 LU -> SLIT("lt"); GEU -> SLIT("ge");
460 GU -> SLIT("gt"); LEU -> SLIT("le");
465 -- -----------------------------------------------------------------------------
466 -- pprImm: print an 'Imm'
470 pprImm (ImmInt i) = int i
471 pprImm (ImmInteger i) = integer i
472 pprImm (ImmCLbl l) = pprCLabel_asm l
473 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
474 pprImm (ImmLit s) = s
476 pprImm (ImmFloat _) = ptext SLIT("naughty float immediate")
477 pprImm (ImmDouble _) = ptext SLIT("naughty double immediate")
479 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
480 #if sparc_TARGET_ARCH
481 -- ToDo: This should really be fixed in the PIC support, but only
483 pprImm (ImmConstantDiff a b) = pprImm a
485 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
486 <> lparen <> pprImm b <> rparen
489 #if sparc_TARGET_ARCH
491 = hcat [ pp_lo, pprImm i, rparen ]
496 = hcat [ pp_hi, pprImm i, rparen ]
500 #if powerpc_TARGET_ARCH
503 = hcat [ pp_lo, pprImm i, rparen ]
508 = hcat [ pp_hi, pprImm i, rparen ]
513 = hcat [ pp_ha, pprImm i, rparen ]
519 = pprImm i <> text "@l"
522 = pprImm i <> text "@h"
525 = pprImm i <> text "@ha"
530 -- -----------------------------------------------------------------------------
531 -- @pprAddr: print an 'AddrMode'
533 pprAddr :: AddrMode -> Doc
535 #if alpha_TARGET_ARCH
536 pprAddr (AddrReg r) = parens (pprReg r)
537 pprAddr (AddrImm i) = pprImm i
538 pprAddr (AddrRegImm r1 i)
539 = (<>) (pprImm i) (parens (pprReg r1))
544 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
545 pprAddr (ImmAddr imm off)
546 = let pp_imm = pprImm imm
550 else if (off < 0) then
553 pp_imm <> char '+' <> int off
555 pprAddr (AddrBaseIndex base index displacement)
557 pp_disp = ppr_disp displacement
558 pp_off p = pp_disp <> char '(' <> p <> char ')'
559 pp_reg r = pprReg wordRep r
562 (EABaseNone, EAIndexNone) -> pp_disp
563 (EABaseReg b, EAIndexNone) -> pp_off (pp_reg b)
564 (EABaseRip, EAIndexNone) -> pp_off (ptext SLIT("%rip"))
565 (EABaseNone, EAIndex r i) -> pp_off (comma <> pp_reg r <> comma <> int i)
566 (EABaseReg b, EAIndex r i) -> pp_off (pp_reg b <> comma <> pp_reg r
569 ppr_disp (ImmInt 0) = empty
570 ppr_disp imm = pprImm imm
575 #if sparc_TARGET_ARCH
576 pprAddr (AddrRegReg r1 (RealReg 0)) = pprReg r1
578 pprAddr (AddrRegReg r1 r2)
579 = hcat [ pprReg r1, char '+', pprReg r2 ]
581 pprAddr (AddrRegImm r1 (ImmInt i))
583 | not (fits13Bits i) = largeOffsetError i
584 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
586 pp_sign = if i > 0 then char '+' else empty
588 pprAddr (AddrRegImm r1 (ImmInteger i))
590 | not (fits13Bits i) = largeOffsetError i
591 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
593 pp_sign = if i > 0 then char '+' else empty
595 pprAddr (AddrRegImm r1 imm)
596 = hcat [ pprReg r1, char '+', pprImm imm ]
601 #if powerpc_TARGET_ARCH
602 pprAddr (AddrRegReg r1 r2)
603 = pprReg r1 <+> ptext SLIT(", ") <+> pprReg r2
605 pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
606 pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
607 pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
611 -- -----------------------------------------------------------------------------
612 -- pprData: print a 'CmmStatic'
614 pprSectionHeader Text
616 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
617 ,IF_ARCH_sparc(SLIT(".text\n\t.align 4") {-word boundary-}
618 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".text\n\t.align 2"),
619 SLIT(".text\n\t.align 4,0x90"))
620 {-needs per-OS variation!-}
621 ,IF_ARCH_x86_64(SLIT(".text\n\t.align 8") {-needs per-OS variation!-}
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(SLIT(".data\n\t.align 8")
631 ,IF_ARCH_powerpc(SLIT(".data\n.align 2")
633 pprSectionHeader ReadOnlyData
635 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
636 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
637 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const\n.align 2"),
638 SLIT(".section .rodata\n\t.align 4"))
639 ,IF_ARCH_x86_64(SLIT(".section .rodata\n\t.align 8")
640 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 2"),
641 SLIT(".section .rodata\n\t.align 2"))
643 pprSectionHeader RelocatableReadOnlyData
645 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
646 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
647 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const_data\n.align 2"),
648 SLIT(".section .rodata\n\t.align 4"))
649 ,IF_ARCH_x86_64(SLIT(".section .rodata\n\t.align 8")
650 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
651 SLIT(".data\n\t.align 2"))
653 pprSectionHeader UninitialisedData
655 IF_ARCH_alpha(SLIT("\t.bss\n\t.align 3")
656 ,IF_ARCH_sparc(SLIT(".bss\n\t.align 8") {-<8 will break double constants -}
657 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const_data\n\t.align 2"),
658 SLIT(".section .bss\n\t.align 4"))
659 ,IF_ARCH_x86_64(SLIT(".section .bss\n\t.align 8")
660 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
661 SLIT(".section .bss\n\t.align 2"))
663 pprSectionHeader ReadOnlyData16
665 IF_ARCH_alpha(SLIT("\t.data\n\t.align 4")
666 ,IF_ARCH_sparc(SLIT(".data\n\t.align 16")
667 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const\n.align 4"),
668 SLIT(".section .rodata\n\t.align 16"))
669 ,IF_ARCH_x86_64(SLIT(".section .rodata.cst16\n\t.align 16")
670 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 4"),
671 SLIT(".section .rodata\n\t.align 4"))
674 pprSectionHeader (OtherSection sec)
675 = panic "PprMach.pprSectionHeader: unknown section"
677 pprData :: CmmStatic -> Doc
678 pprData (CmmAlign bytes) = pprAlign bytes
679 pprData (CmmDataLabel lbl) = pprLabel lbl
680 pprData (CmmString str) = pprASCII str
681 pprData (CmmUninitialised bytes) = ptext SLIT(".space ") <> int bytes
682 pprData (CmmStaticLit lit) = pprDataItem lit
684 pprGloblDecl :: CLabel -> Doc
686 | not (externallyVisibleCLabel lbl) = empty
687 | otherwise = ptext IF_ARCH_sparc(SLIT(".global "),
691 pprLabel :: CLabel -> Doc
692 pprLabel lbl = pprGloblDecl lbl $$ (pprCLabel_asm lbl <> char ':')
696 = vcat (map do1 str) $$ do1 0
699 do1 w = ptext SLIT("\t.byte\t") <> int (fromIntegral w)
702 IF_ARCH_alpha(ptextSLIT(".align ") <> int pow2,
703 IF_ARCH_i386(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes),
704 IF_ARCH_x86_64(ptext SLIT(".align ") <> int bytes,
705 IF_ARCH_sparc(ptext SLIT(".align ") <> int bytes,
706 IF_ARCH_powerpc(ptext SLIT(".align ") <> int pow2,)))))
710 log2 :: Int -> Int -- cache the common ones
715 log2 n = 1 + log2 (n `quot` 2)
718 pprDataItem :: CmmLit -> Doc
720 = vcat (ppr_item (cmmLitRep lit) lit)
724 -- These seem to be common:
725 ppr_item I8 x = [ptext SLIT("\t.byte\t") <> pprImm imm]
726 ppr_item I32 x = [ptext SLIT("\t.long\t") <> pprImm imm]
727 ppr_item F32 (CmmFloat r _)
728 = let bs = floatToBytes (fromRational r)
729 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
730 ppr_item F64 (CmmFloat r _)
731 = let bs = doubleToBytes (fromRational r)
732 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
734 #if sparc_TARGET_ARCH
735 -- copy n paste of x86 version
736 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
737 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
739 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
740 ppr_item I16 x = [ptext SLIT("\t.word\t") <> pprImm imm]
742 #if i386_TARGET_ARCH && darwin_TARGET_OS
743 ppr_item I64 (CmmInt x _) =
744 [ptext SLIT("\t.long\t")
745 <> int (fromIntegral (fromIntegral x :: Word32)),
746 ptext SLIT("\t.long\t")
748 (fromIntegral (x `shiftR` 32) :: Word32))]
751 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
753 #if x86_64_TARGET_ARCH
754 -- x86_64: binutils can't handle the R_X86_64_PC64 relocation
755 -- type, which means we can't do pc-relative 64-bit addresses.
756 -- Fortunately we're assuming the small memory model, in which
757 -- all such offsets will fit into 32 bits, so we have to stick
758 -- to 32-bit offset fields and modify the RTS appropriately
759 -- (see InfoTables.h).
762 | isRelativeReloc x =
763 [ptext SLIT("\t.long\t") <> pprImm imm,
764 ptext SLIT("\t.long\t0")]
766 [ptext SLIT("\t.quad\t") <> pprImm imm]
768 isRelativeReloc (CmmLabelOff _ _) = True
769 isRelativeReloc (CmmLabelDiffOff _ _ _) = True
770 isRelativeReloc _ = False
772 #if powerpc_TARGET_ARCH
773 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
774 ppr_item I64 (CmmInt x _) =
775 [ptext SLIT("\t.long\t")
777 (fromIntegral (x `shiftR` 32) :: Word32)),
778 ptext SLIT("\t.long\t")
779 <> int (fromIntegral (fromIntegral x :: Word32))]
782 -- fall through to rest of (machine-specific) pprInstr...
784 -- -----------------------------------------------------------------------------
785 -- pprInstr: print an 'Instr'
787 pprInstr :: Instr -> Doc
789 --pprInstr (COMMENT s) = empty -- nuke 'em
791 = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
792 ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ftext s))
793 ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ftext s))
794 ,IF_ARCH_x86_64( ((<>) (ptext SLIT("# ")) (ftext s))
795 ,IF_ARCH_powerpc( IF_OS_linux(
796 ((<>) (ptext SLIT("# ")) (ftext s)),
797 ((<>) (ptext SLIT("; ")) (ftext s)))
801 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
803 pprInstr (NEWBLOCK _)
804 = panic "PprMach.pprInstr: NEWBLOCK"
807 = panic "PprMach.pprInstr: LDATA"
809 -- -----------------------------------------------------------------------------
810 -- pprInstr for an Alpha
812 #if alpha_TARGET_ARCH
814 pprInstr (LD size reg addr)
824 pprInstr (LDA reg addr)
826 ptext SLIT("\tlda\t"),
832 pprInstr (LDAH reg addr)
834 ptext SLIT("\tldah\t"),
840 pprInstr (LDGP reg addr)
842 ptext SLIT("\tldgp\t"),
848 pprInstr (LDI size reg imm)
858 pprInstr (ST size reg addr)
870 ptext SLIT("\tclr\t"),
874 pprInstr (ABS size ri reg)
884 pprInstr (NEG size ov ri reg)
888 if ov then ptext SLIT("v\t") else char '\t',
894 pprInstr (ADD size ov reg1 ri reg2)
898 if ov then ptext SLIT("v\t") else char '\t',
906 pprInstr (SADD size scale reg1 ri reg2)
908 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
919 pprInstr (SUB size ov reg1 ri reg2)
923 if ov then ptext SLIT("v\t") else char '\t',
931 pprInstr (SSUB size scale reg1 ri reg2)
933 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
944 pprInstr (MUL size ov reg1 ri reg2)
948 if ov then ptext SLIT("v\t") else char '\t',
956 pprInstr (DIV size uns reg1 ri reg2)
960 if uns then ptext SLIT("u\t") else char '\t',
968 pprInstr (REM size uns reg1 ri reg2)
972 if uns then ptext SLIT("u\t") else char '\t',
980 pprInstr (NOT ri reg)
989 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
990 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
991 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
992 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
993 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
994 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
996 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
997 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
998 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
1000 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
1001 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
1003 pprInstr (NOP) = ptext SLIT("\tnop")
1005 pprInstr (CMP cond reg1 ri reg2)
1007 ptext SLIT("\tcmp"),
1019 ptext SLIT("\tfclr\t"),
1023 pprInstr (FABS reg1 reg2)
1025 ptext SLIT("\tfabs\t"),
1031 pprInstr (FNEG size reg1 reg2)
1033 ptext SLIT("\tneg"),
1041 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
1042 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
1043 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
1044 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
1046 pprInstr (CVTxy size1 size2 reg1 reg2)
1048 ptext SLIT("\tcvt"),
1050 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
1057 pprInstr (FCMP size cond reg1 reg2 reg3)
1059 ptext SLIT("\tcmp"),
1070 pprInstr (FMOV reg1 reg2)
1072 ptext SLIT("\tfmov\t"),
1078 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
1080 pprInstr (BI NEVER reg lab) = empty
1082 pprInstr (BI cond reg lab)
1092 pprInstr (BF cond reg lab)
1103 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
1105 pprInstr (JMP reg addr hint)
1107 ptext SLIT("\tjmp\t"),
1115 pprInstr (BSR imm n)
1116 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
1118 pprInstr (JSR reg addr n)
1120 ptext SLIT("\tjsr\t"),
1126 pprInstr (FUNBEGIN clab)
1128 if (externallyVisibleCLabel clab) then
1129 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
1132 ptext SLIT("\t.ent "),
1141 pp_lab = pprCLabel_asm clab
1143 -- NEVER use commas within those string literals, cpp will ruin your day
1144 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
1145 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
1146 ptext SLIT("4240"), char ',',
1147 ptext SLIT("$26"), char ',',
1148 ptext SLIT("0\n\t.prologue 1") ]
1150 pprInstr (FUNEND clab)
1151 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
1154 Continue with Alpha-only printing bits and bobs:
1158 pprRI (RIReg r) = pprReg r
1159 pprRI (RIImm r) = pprImm r
1161 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
1162 pprRegRIReg name reg1 ri reg2
1174 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1175 pprSizeRegRegReg name size reg1 reg2 reg3
1188 #endif /* alpha_TARGET_ARCH */
1191 -- -----------------------------------------------------------------------------
1192 -- pprInstr for an x86
1194 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1196 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
1199 #if 0 /* #ifdef DEBUG */
1200 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
1205 pprInstr (MOV size src dst)
1206 = pprSizeOpOp SLIT("mov") size src dst
1208 pprInstr (MOVZxL I32 src dst) = pprSizeOpOp SLIT("mov") I32 src dst
1209 -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
1210 -- movl. But we represent it as a MOVZxL instruction, because
1211 -- the reg alloc would tend to throw away a plain reg-to-reg
1212 -- move, and we still want it to do that.
1214 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes I32 src dst
1215 -- zero-extension only needs to extend to 32 bits: on x86_64,
1216 -- the remaining zero-extension to 64 bits is automatic, and the 32-bit
1217 -- instruction is shorter.
1219 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes wordRep src dst
1221 -- here we do some patching, since the physical registers are only set late
1222 -- in the code generation.
1223 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1225 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
1226 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1228 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
1229 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
1231 = pprInstr (ADD size (OpImm displ) dst)
1232 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
1234 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
1235 = pprSizeOp SLIT("dec") size dst
1236 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
1237 = pprSizeOp SLIT("inc") size dst
1238 pprInstr (ADD size src dst)
1239 = pprSizeOpOp SLIT("add") size src dst
1240 pprInstr (ADC size src dst)
1241 = pprSizeOpOp SLIT("adc") size src dst
1242 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
1243 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1245 {- A hack. The Intel documentation says that "The two and three
1246 operand forms [of IMUL] may also be used with unsigned operands
1247 because the lower half of the product is the same regardless if
1248 (sic) the operands are signed or unsigned. The CF and OF flags,
1249 however, cannot be used to determine if the upper half of the
1250 result is non-zero." So there.
1252 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
1253 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
1255 pprInstr (XOR F32 src dst) = pprOpOp SLIT("xorps") F32 src dst
1256 pprInstr (XOR F64 src dst) = pprOpOp SLIT("xorpd") F64 src dst
1257 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
1259 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
1260 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
1262 pprInstr (SHL size src dst) = pprShift SLIT("shl") size src dst
1263 pprInstr (SAR size src dst) = pprShift SLIT("sar") size src dst
1264 pprInstr (SHR size src dst) = pprShift SLIT("shr") size src dst
1266 pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src
1268 pprInstr (CMP size src dst)
1269 | isFloatingRep size = pprSizeOpOp SLIT("ucomi") size src dst -- SSE2
1270 | otherwise = pprSizeOpOp SLIT("cmp") size src dst
1272 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
1273 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
1274 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
1276 -- both unused (SDM):
1277 -- pprInstr PUSHA = ptext SLIT("\tpushal")
1278 -- pprInstr POPA = ptext SLIT("\tpopal")
1280 pprInstr NOP = ptext SLIT("\tnop")
1281 pprInstr (CLTD I32) = ptext SLIT("\tcltd")
1282 pprInstr (CLTD I64) = ptext SLIT("\tcqto")
1284 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand I8 op)
1286 pprInstr (JXX cond (BlockId id))
1287 = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
1288 where lab = mkAsmTempLabel id
1290 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
1291 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep op)
1292 pprInstr (JMP_TBL op ids) = pprInstr (JMP op)
1293 pprInstr (CALL (Left imm) _) = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
1294 pprInstr (CALL (Right reg) _) = (<>) (ptext SLIT("\tcall *")) (pprReg wordRep reg)
1296 pprInstr (IDIV sz op) = pprSizeOp SLIT("idiv") sz op
1297 pprInstr (DIV sz op) = pprSizeOp SLIT("div") sz op
1298 pprInstr (IMUL2 sz op) = pprSizeOp SLIT("imul") sz op
1300 #if x86_64_TARGET_ARCH
1301 pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("mul") size op1 op2
1303 pprInstr (FDIV size op1 op2) = pprSizeOpOp SLIT("div") size op1 op2
1305 pprInstr (CVTSS2SD from to) = pprRegReg SLIT("cvtss2sd") from to
1306 pprInstr (CVTSD2SS from to) = pprRegReg SLIT("cvtsd2ss") from to
1307 pprInstr (CVTSS2SI from to) = pprOpReg SLIT("cvtss2siq") from to
1308 pprInstr (CVTSD2SI from to) = pprOpReg SLIT("cvtsd2siq") from to
1309 pprInstr (CVTSI2SS from to) = pprOpReg SLIT("cvtsi2ssq") from to
1310 pprInstr (CVTSI2SD from to) = pprOpReg SLIT("cvtsi2sdq") from to
1313 -- FETCHGOT for PIC on ELF platforms
1314 pprInstr (FETCHGOT reg)
1315 = vcat [ ptext SLIT("\tcall 1f"),
1316 hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ],
1317 hcat [ ptext SLIT("\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
1321 -- FETCHPC for PIC on Darwin/x86
1322 -- get the instruction pointer into a register
1323 -- (Terminology note: the IP is called Program Counter on PPC,
1324 -- and it's a good thing to use the same name on both platforms)
1325 pprInstr (FETCHPC reg)
1326 = vcat [ ptext SLIT("\tcall 1f"),
1327 hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ]
1334 -- -----------------------------------------------------------------------------
1335 -- i386 floating-point
1337 #if i386_TARGET_ARCH
1338 -- Simulating a flat register set on the x86 FP stack is tricky.
1339 -- you have to free %st(7) before pushing anything on the FP reg stack
1340 -- so as to preclude the possibility of a FP stack overflow exception.
1341 pprInstr g@(GMOV src dst)
1345 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1347 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1348 pprInstr g@(GLD sz addr dst)
1349 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1350 pprAddr addr, gsemi, gpop dst 1])
1352 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1353 pprInstr g@(GST sz src addr)
1354 = pprG g (hcat [gtab, gpush src 0, gsemi,
1355 text "fstp", pprSize sz, gsp, pprAddr addr])
1357 pprInstr g@(GLDZ dst)
1358 = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
1359 pprInstr g@(GLD1 dst)
1360 = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
1362 pprInstr g@(GFTOI src dst)
1363 = pprInstr (GDTOI src dst)
1364 pprInstr g@(GDTOI src dst)
1365 = pprG g (hcat [gtab, text "subl $4, %esp ; ",
1366 gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ",
1369 pprInstr g@(GITOF src dst)
1370 = pprInstr (GITOD src dst)
1371 pprInstr g@(GITOD src dst)
1372 = pprG g (hcat [gtab, text "pushl ", pprReg I32 src,
1373 text " ; ffree %st(7); fildl (%esp) ; ",
1374 gpop dst 1, text " ; addl $4,%esp"])
1376 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
1377 this far into the jungle AND you give a Rat's Ass (tm) what's going
1378 on, here's the deal. Generate code to do a floating point comparison
1379 of src1 and src2, of kind cond, and set the Zero flag if true.
1381 The complications are to do with handling NaNs correctly. We want the
1382 property that if either argument is NaN, then the result of the
1383 comparison is False ... except if we're comparing for inequality,
1384 in which case the answer is True.
1386 Here's how the general (non-inequality) case works. As an
1387 example, consider generating the an equality test:
1389 pushl %eax -- we need to mess with this
1390 <get src1 to top of FPU stack>
1391 fcomp <src2 location in FPU stack> and pop pushed src1
1392 -- Result of comparison is in FPU Status Register bits
1394 fstsw %ax -- Move FPU Status Reg to %ax
1395 sahf -- move C3 C2 C0 from %ax to integer flag reg
1396 -- now the serious magic begins
1397 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
1398 sete %al -- %al = if arg1 == arg2 then 1 else 0
1399 andb %ah,%al -- %al &= %ah
1400 -- so %al == 1 iff (comparable && same); else it holds 0
1401 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
1402 else %al == 0xFF, ZeroFlag=0
1403 -- the zero flag is now set as we desire.
1406 The special case of inequality differs thusly:
1408 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
1409 setne %al -- %al = if arg1 /= arg2 then 1 else 0
1410 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
1411 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
1412 else (%al == 0xFF, ZF=0)
1414 pprInstr g@(GCMP cond src1 src2)
1415 | case cond of { NE -> True; other -> False }
1417 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1418 hcat [gtab, text "fcomp ", greg src2 1,
1419 text "; fstsw %ax ; sahf ; setpe %ah"],
1420 hcat [gtab, text "setne %al ; ",
1421 text "orb %ah,%al ; decb %al ; popl %eax"]
1425 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1426 hcat [gtab, text "fcomp ", greg src2 1,
1427 text "; fstsw %ax ; sahf ; setpo %ah"],
1428 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
1429 text "andb %ah,%al ; decb %al ; popl %eax"]
1432 {- On the 486, the flags set by FP compare are the unsigned ones!
1433 (This looks like a HACK to me. WDP 96/03)
1435 fix_FP_cond :: Cond -> Cond
1436 fix_FP_cond GE = GEU
1437 fix_FP_cond GTT = GU
1438 fix_FP_cond LTT = LU
1439 fix_FP_cond LE = LEU
1440 fix_FP_cond EQQ = EQQ
1442 -- there should be no others
1445 pprInstr g@(GABS sz src dst)
1446 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1447 pprInstr g@(GNEG sz src dst)
1448 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1450 pprInstr g@(GSQRT sz src dst)
1451 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1452 hcat [gtab, gcoerceto sz, gpop dst 1])
1453 pprInstr g@(GSIN sz src dst)
1454 = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1455 hcat [gtab, gcoerceto sz, gpop dst 1])
1456 pprInstr g@(GCOS sz src dst)
1457 = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1458 hcat [gtab, gcoerceto sz, gpop dst 1])
1459 pprInstr g@(GTAN sz src dst)
1460 = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1461 gpush src 0, text " ; fptan ; ",
1462 text " fstp %st(0)"] $$
1463 hcat [gtab, gcoerceto sz, gpop dst 1])
1465 -- In the translations for GADD, GMUL, GSUB and GDIV,
1466 -- the first two cases are mere optimisations. The otherwise clause
1467 -- generates correct code under all circumstances.
1469 pprInstr g@(GADD sz src1 src2 dst)
1471 = pprG g (text "\t#GADD-xxxcase1" $$
1472 hcat [gtab, gpush src2 0,
1473 text " ; faddp %st(0),", greg src1 1])
1475 = pprG g (text "\t#GADD-xxxcase2" $$
1476 hcat [gtab, gpush src1 0,
1477 text " ; faddp %st(0),", greg src2 1])
1479 = pprG g (hcat [gtab, gpush src1 0,
1480 text " ; fadd ", greg src2 1, text ",%st(0)",
1484 pprInstr g@(GMUL sz src1 src2 dst)
1486 = pprG g (text "\t#GMUL-xxxcase1" $$
1487 hcat [gtab, gpush src2 0,
1488 text " ; fmulp %st(0),", greg src1 1])
1490 = pprG g (text "\t#GMUL-xxxcase2" $$
1491 hcat [gtab, gpush src1 0,
1492 text " ; fmulp %st(0),", greg src2 1])
1494 = pprG g (hcat [gtab, gpush src1 0,
1495 text " ; fmul ", greg src2 1, text ",%st(0)",
1499 pprInstr g@(GSUB sz src1 src2 dst)
1501 = pprG g (text "\t#GSUB-xxxcase1" $$
1502 hcat [gtab, gpush src2 0,
1503 text " ; fsubrp %st(0),", greg src1 1])
1505 = pprG g (text "\t#GSUB-xxxcase2" $$
1506 hcat [gtab, gpush src1 0,
1507 text " ; fsubp %st(0),", greg src2 1])
1509 = pprG g (hcat [gtab, gpush src1 0,
1510 text " ; fsub ", greg src2 1, text ",%st(0)",
1514 pprInstr g@(GDIV sz src1 src2 dst)
1516 = pprG g (text "\t#GDIV-xxxcase1" $$
1517 hcat [gtab, gpush src2 0,
1518 text " ; fdivrp %st(0),", greg src1 1])
1520 = pprG g (text "\t#GDIV-xxxcase2" $$
1521 hcat [gtab, gpush src1 0,
1522 text " ; fdivp %st(0),", greg src2 1])
1524 = pprG g (hcat [gtab, gpush src1 0,
1525 text " ; fdiv ", greg src2 1, text ",%st(0)",
1530 = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1531 ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1534 --------------------------
1536 -- coerce %st(0) to the specified size
1537 gcoerceto F64 = empty
1538 gcoerceto F32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1541 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1543 = hcat [text "fstp ", greg reg offset]
1545 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1550 gregno (RealReg i) = i
1551 gregno other = --pprPanic "gregno" (ppr other)
1552 999 -- bogus; only needed for debug printing
1554 pprG :: Instr -> Doc -> Doc
1556 = (char '#' <> pprGInstr fake) $$ actual
1558 pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") F64 src dst
1559 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1560 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1562 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") F64 dst
1563 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") F64 dst
1565 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F32 I32 src dst
1566 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") F64 I32 src dst
1568 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") I32 F32 src dst
1569 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") I32 F64 src dst
1571 pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") F64 co src dst
1572 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1573 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1574 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1575 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1576 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1577 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1579 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1580 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1581 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1582 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1585 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1587 -- Continue with I386-only printing bits and bobs:
1589 pprDollImm :: Imm -> Doc
1591 pprDollImm i = ptext SLIT("$") <> pprImm i
1593 pprOperand :: MachRep -> Operand -> Doc
1594 pprOperand s (OpReg r) = pprReg s r
1595 pprOperand s (OpImm i) = pprDollImm i
1596 pprOperand s (OpAddr ea) = pprAddr ea
1598 pprMnemonic_ :: LitString -> Doc
1600 char '\t' <> ptext name <> space
1602 pprMnemonic :: LitString -> MachRep -> Doc
1603 pprMnemonic name size =
1604 char '\t' <> ptext name <> pprSize size <> space
1606 pprSizeImmOp :: LitString -> MachRep -> Imm -> Operand -> Doc
1607 pprSizeImmOp name size imm op1
1609 pprMnemonic name size,
1616 pprSizeOp :: LitString -> MachRep -> Operand -> Doc
1617 pprSizeOp name size op1
1619 pprMnemonic name size,
1623 pprSizeOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1624 pprSizeOpOp name size op1 op2
1626 pprMnemonic name size,
1627 pprOperand size op1,
1632 pprOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1633 pprOpOp name size op1 op2
1636 pprOperand size op1,
1641 pprSizeReg :: LitString -> MachRep -> Reg -> Doc
1642 pprSizeReg name size reg1
1644 pprMnemonic name size,
1648 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1649 pprSizeRegReg name size reg1 reg2
1651 pprMnemonic name size,
1657 pprRegReg :: LitString -> Reg -> Reg -> Doc
1658 pprRegReg name reg1 reg2
1661 pprReg wordRep reg1,
1666 pprOpReg :: LitString -> Operand -> Reg -> Doc
1667 pprOpReg name op1 reg2
1670 pprOperand wordRep op1,
1675 pprCondRegReg :: LitString -> MachRep -> Cond -> Reg -> Reg -> Doc
1676 pprCondRegReg name size cond reg1 reg2
1687 pprSizeSizeRegReg :: LitString -> MachRep -> MachRep -> Reg -> Reg -> Doc
1688 pprSizeSizeRegReg name size1 size2 reg1 reg2
1701 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
1702 pprSizeRegRegReg name size reg1 reg2 reg3
1704 pprMnemonic name size,
1712 pprSizeAddrReg :: LitString -> MachRep -> AddrMode -> Reg -> Doc
1713 pprSizeAddrReg name size op dst
1715 pprMnemonic name size,
1721 pprSizeRegAddr :: LitString -> MachRep -> Reg -> AddrMode -> Doc
1722 pprSizeRegAddr name size src op
1724 pprMnemonic name size,
1730 pprShift :: LitString -> MachRep -> Operand -> Operand -> Doc
1731 pprShift name size src dest
1733 pprMnemonic name size,
1734 pprOperand I8 src, -- src is 8-bit sized
1736 pprOperand size dest
1739 pprSizeOpOpCoerce :: LitString -> MachRep -> MachRep -> Operand -> Operand -> Doc
1740 pprSizeOpOpCoerce name size1 size2 op1 op2
1741 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1742 pprOperand size1 op1,
1744 pprOperand size2 op2
1747 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1748 pprCondInstr name cond arg
1749 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1751 #endif /* i386_TARGET_ARCH */
1754 -- ------------------------------------------------------------------------------- pprInstr for a SPARC
1756 #if sparc_TARGET_ARCH
1758 -- a clumsy hack for now, to handle possible double alignment problems
1760 -- even clumsier, to allow for RegReg regs that show when doing indexed
1761 -- reads (bytearrays).
1764 -- Translate to the following:
1767 -- ld [g1+4],%f(n+1)
1768 -- sub g1,g2,g1 -- to restore g1
1770 pprInstr (LD F64 (AddrRegReg g1 g2) reg)
1772 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1773 hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1774 hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1775 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1780 -- ld [addr+4],%f(n+1)
1781 pprInstr (LD F64 addr reg) | isJust off_addr
1783 hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1784 hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1787 off_addr = addrOffset addr 4
1788 addr2 = case off_addr of Just x -> x
1791 pprInstr (LD size addr reg)
1802 -- The same clumsy hack as above
1804 -- Translate to the following:
1807 -- st %f(n+1),[g1+4]
1808 -- sub g1,g2,g1 -- to restore g1
1809 pprInstr (ST F64 reg (AddrRegReg g1 g2))
1811 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1812 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1814 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1815 pprReg g1, ptext SLIT("+4]")],
1816 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1821 -- st %f(n+1),[addr+4]
1822 pprInstr (ST F64 reg addr) | isJust off_addr
1824 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1825 pprAddr addr, rbrack],
1826 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1827 pprAddr addr2, rbrack]
1830 off_addr = addrOffset addr 4
1831 addr2 = case off_addr of Just x -> x
1833 -- no distinction is made between signed and unsigned bytes on stores for the
1834 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1835 -- so we call a special-purpose pprSize for ST..
1837 pprInstr (ST size reg addr)
1848 pprInstr (ADD x cc reg1 ri reg2)
1849 | not x && not cc && riZero ri
1850 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1852 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1854 pprInstr (SUB x cc reg1 ri reg2)
1855 | not x && cc && reg2 == g0
1856 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1857 | not x && not cc && riZero ri
1858 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1860 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1862 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1863 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1865 pprInstr (OR b reg1 ri reg2)
1866 | not b && reg1 == g0
1867 = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1869 RIReg rrr | rrr == reg2 -> empty
1872 = pprRegRIReg SLIT("or") b reg1 ri reg2
1874 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1876 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1877 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1879 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1880 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1881 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1883 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1884 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul") b reg1 ri reg2
1885 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul") b reg1 ri reg2
1887 pprInstr (SETHI imm reg)
1889 ptext SLIT("\tsethi\t"),
1895 pprInstr NOP = ptext SLIT("\tnop")
1897 pprInstr (FABS F32 reg1 reg2) = pprSizeRegReg SLIT("fabs") F32 reg1 reg2
1898 pprInstr (FABS F64 reg1 reg2)
1899 = (<>) (pprSizeRegReg SLIT("fabs") F32 reg1 reg2)
1900 (if (reg1 == reg2) then empty
1901 else (<>) (char '\n')
1902 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1904 pprInstr (FADD size reg1 reg2 reg3)
1905 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1906 pprInstr (FCMP e size reg1 reg2)
1907 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1908 pprInstr (FDIV size reg1 reg2 reg3)
1909 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1911 pprInstr (FMOV F32 reg1 reg2) = pprSizeRegReg SLIT("fmov") F32 reg1 reg2
1912 pprInstr (FMOV F64 reg1 reg2)
1913 = (<>) (pprSizeRegReg SLIT("fmov") F32 reg1 reg2)
1914 (if (reg1 == reg2) then empty
1915 else (<>) (char '\n')
1916 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1918 pprInstr (FMUL size reg1 reg2 reg3)
1919 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1921 pprInstr (FNEG F32 reg1 reg2) = pprSizeRegReg SLIT("fneg") F32 reg1 reg2
1922 pprInstr (FNEG F64 reg1 reg2)
1923 = (<>) (pprSizeRegReg SLIT("fneg") F32 reg1 reg2)
1924 (if (reg1 == reg2) then empty
1925 else (<>) (char '\n')
1926 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1928 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1929 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1930 pprInstr (FxTOy size1 size2 reg1 reg2)
1937 F64 -> SLIT("dto")),
1942 F64 -> SLIT("d\t")),
1943 pprReg reg1, comma, pprReg reg2
1947 pprInstr (BI cond b lab)
1949 ptext SLIT("\tb"), pprCond cond,
1950 if b then pp_comma_a else empty,
1955 pprInstr (BF cond b lab)
1957 ptext SLIT("\tfb"), pprCond cond,
1958 if b then pp_comma_a else empty,
1963 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1965 pprInstr (CALL (Left imm) n _)
1966 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1967 pprInstr (CALL (Right reg) n _)
1968 = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
1971 pprRI (RIReg r) = pprReg r
1972 pprRI (RIImm r) = pprImm r
1974 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1975 pprSizeRegReg name size reg1 reg2
1980 F32 -> ptext SLIT("s\t")
1981 F64 -> ptext SLIT("d\t")),
1987 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
1988 pprSizeRegRegReg name size reg1 reg2 reg3
1993 F32 -> ptext SLIT("s\t")
1994 F64 -> ptext SLIT("d\t")),
2002 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
2003 pprRegRIReg name b reg1 ri reg2
2007 if b then ptext SLIT("cc\t") else char '\t',
2015 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
2016 pprRIReg name b ri reg1
2020 if b then ptext SLIT("cc\t") else char '\t',
2026 pp_ld_lbracket = ptext SLIT("\tld\t[")
2027 pp_rbracket_comma = text "],"
2028 pp_comma_lbracket = text ",["
2029 pp_comma_a = text ",a"
2031 #endif /* sparc_TARGET_ARCH */
2034 -- -----------------------------------------------------------------------------
2035 -- pprInstr for PowerPC
2037 #if powerpc_TARGET_ARCH
2038 pprInstr (LD sz reg addr) = hcat [
2047 case addr of AddrRegImm _ _ -> empty
2048 AddrRegReg _ _ -> char 'x',
2054 pprInstr (LA sz reg addr) = hcat [
2063 case addr of AddrRegImm _ _ -> empty
2064 AddrRegReg _ _ -> char 'x',
2070 pprInstr (ST sz reg addr) = hcat [
2074 case addr of AddrRegImm _ _ -> empty
2075 AddrRegReg _ _ -> char 'x',
2081 pprInstr (STU sz reg addr) = hcat [
2086 case addr of AddrRegImm _ _ -> empty
2087 AddrRegReg _ _ -> char 'x',
2092 pprInstr (LIS reg imm) = hcat [
2100 pprInstr (LI reg imm) = hcat [
2108 pprInstr (MR reg1 reg2)
2109 | reg1 == reg2 = empty
2110 | otherwise = hcat [
2112 case regClass reg1 of
2113 RcInteger -> ptext SLIT("mr")
2114 _ -> ptext SLIT("fmr"),
2120 pprInstr (CMP sz reg ri) = hcat [
2136 pprInstr (CMPL sz reg ri) = hcat [
2152 pprInstr (BCC cond (BlockId id)) = hcat [
2159 where lbl = mkAsmTempLabel id
2161 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
2168 pprInstr (MTCTR reg) = hcat [
2170 ptext SLIT("mtctr"),
2174 pprInstr (BCTR _) = hcat [
2178 pprInstr (BL lbl _) = hcat [
2179 ptext SLIT("\tbl\t"),
2182 pprInstr (BCTRL _) = hcat [
2186 pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
2187 pprInstr (ADDIS reg1 reg2 imm) = hcat [
2189 ptext SLIT("addis"),
2198 pprInstr (ADDC reg1 reg2 reg3) = pprLogic SLIT("addc") reg1 reg2 (RIReg reg3)
2199 pprInstr (ADDE reg1 reg2 reg3) = pprLogic SLIT("adde") reg1 reg2 (RIReg reg3)
2200 pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
2201 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
2202 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
2203 pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
2204 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3)
2206 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
2207 hcat [ ptext SLIT("\tmullwo\t"), pprReg reg1, ptext SLIT(", "),
2208 pprReg reg2, ptext SLIT(", "),
2210 hcat [ ptext SLIT("\tmfxer\t"), pprReg reg1 ],
2211 hcat [ ptext SLIT("\trlwinm\t"), pprReg reg1, ptext SLIT(", "),
2212 pprReg reg1, ptext SLIT(", "),
2213 ptext SLIT("2, 31, 31") ]
2216 -- for some reason, "andi" doesn't exist.
2217 -- we'll use "andi." instead.
2218 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
2220 ptext SLIT("andi."),
2228 pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 ri
2230 pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 ri
2231 pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 ri
2233 pprInstr (XORIS reg1 reg2 imm) = hcat [
2235 ptext SLIT("xoris"),
2244 pprInstr (EXTS sz reg1 reg2) = hcat [
2254 pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2
2255 pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2
2257 pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 (limitShiftRI ri)
2258 pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 (limitShiftRI ri)
2259 pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 (limitShiftRI ri)
2260 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
2261 ptext SLIT("\trlwinm\t"),
2273 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
2274 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
2275 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
2276 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
2277 pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
2279 pprInstr (FCMP reg1 reg2) = hcat [
2281 ptext SLIT("fcmpu\tcr0, "),
2282 -- Note: we're using fcmpu, not fcmpo
2283 -- The difference is with fcmpo, compare with NaN is an invalid operation.
2284 -- We don't handle invalid fp ops, so we don't care
2290 pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
2291 pprInstr (FRSP reg1 reg2) = pprUnary SLIT("frsp") reg1 reg2
2293 pprInstr (CRNOR dst src1 src2) = hcat [
2294 ptext SLIT("\tcrnor\t"),
2302 pprInstr (MFCR reg) = hcat [
2309 pprInstr (MFLR reg) = hcat [
2316 pprInstr (FETCHPC reg) = vcat [
2317 ptext SLIT("\tbcl\t20,31,1f"),
2318 hcat [ ptext SLIT("1:\tmflr\t"), pprReg reg ]
2321 pprInstr _ = panic "pprInstr (ppc)"
2323 pprLogic op reg1 reg2 ri = hcat [
2328 RIImm _ -> char 'i',
2337 pprUnary op reg1 reg2 = hcat [
2346 pprBinaryF op sz reg1 reg2 reg3 = hcat [
2359 pprRI (RIReg r) = pprReg r
2360 pprRI (RIImm r) = pprImm r
2362 pprFSize F64 = empty
2363 pprFSize F32 = char 's'
2365 -- limit immediate argument for shift instruction to range 0..32
2366 -- (yes, the maximum is really 32, not 31)
2367 limitShiftRI :: RI -> RI
2368 limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
2371 #endif /* powerpc_TARGET_ARCH */
2374 -- -----------------------------------------------------------------------------
2375 -- Converting floating-point literals to integrals for printing
2377 #if __GLASGOW_HASKELL__ >= 504
2378 newFloatArray :: (Int,Int) -> ST s (STUArray s Int Float)
2379 newFloatArray = newArray_
2381 newDoubleArray :: (Int,Int) -> ST s (STUArray s Int Double)
2382 newDoubleArray = newArray_
2384 castFloatToCharArray :: STUArray s Int Float -> ST s (STUArray s Int Word8)
2385 castFloatToCharArray = castSTUArray
2387 castDoubleToCharArray :: STUArray s Int Double -> ST s (STUArray s Int Word8)
2388 castDoubleToCharArray = castSTUArray
2390 writeFloatArray :: STUArray s Int Float -> Int -> Float -> ST s ()
2391 writeFloatArray = writeArray
2393 writeDoubleArray :: STUArray s Int Double -> Int -> Double -> ST s ()
2394 writeDoubleArray = writeArray
2396 readCharArray :: STUArray s Int Word8 -> Int -> ST s Char
2397 readCharArray arr i = do
2398 w <- readArray arr i
2399 return $! (chr (fromIntegral w))
2403 castFloatToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
2404 castFloatToCharArray = return
2406 castDoubleToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
2409 castDoubleToCharArray = return
2413 -- floatToBytes and doubleToBytes convert to the host's byte
2414 -- order. Providing that we're not cross-compiling for a
2415 -- target with the opposite endianness, this should work ok
2418 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
2419 -- could they be merged?
2421 floatToBytes :: Float -> [Int]
2424 arr <- newFloatArray ((0::Int),3)
2425 writeFloatArray arr 0 f
2426 arr <- castFloatToCharArray arr
2427 i0 <- readCharArray arr 0
2428 i1 <- readCharArray arr 1
2429 i2 <- readCharArray arr 2
2430 i3 <- readCharArray arr 3
2431 return (map ord [i0,i1,i2,i3])
2434 doubleToBytes :: Double -> [Int]
2437 arr <- newDoubleArray ((0::Int),7)
2438 writeDoubleArray arr 0 d
2439 arr <- castDoubleToCharArray arr
2440 i0 <- readCharArray arr 0
2441 i1 <- readCharArray arr 1
2442 i2 <- readCharArray arr 2
2443 i3 <- readCharArray arr 3
2444 i4 <- readCharArray arr 4
2445 i5 <- readCharArray arr 5
2446 i6 <- readCharArray arr 6
2447 i7 <- readCharArray arr 7
2448 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])