1 -----------------------------------------------------------------------------
3 -- Pretty-printing assembly language
5 -- (c) The University of Glasgow 1993-2004
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(..) )
25 import MachRegs -- may differ per-platform
28 import CLabel ( CLabel, pprCLabel, externallyVisibleCLabel,
29 labelDynamic, mkAsmTempLabel, entryLblToInfoLbl )
31 import Panic ( panic )
32 import Unique ( pprUnique )
35 import qualified Outputable
37 import CmdLineOpts ( opt_PIC, opt_Static )
39 #if __GLASGOW_HASKELL__ >= 504
41 import Data.Word ( Word8 )
47 import Char ( chr, ord )
49 #if powerpc_TARGET_ARCH
50 import DATA_WORD(Word32)
54 -- -----------------------------------------------------------------------------
55 -- Printing this stuff out
57 asmSDoc d = Outputable.withPprStyleDoc (
58 Outputable.mkCodeStyle Outputable.AsmStyle) d
59 pprCLabel_asm l = asmSDoc (pprCLabel l)
61 pprNatCmmTop :: NatCmmTop -> Doc
62 pprNatCmmTop (CmmData section dats) =
63 pprSectionHeader section $$ vcat (map pprData dats)
65 -- special case for split markers:
66 pprNatCmmTop (CmmProc [] lbl _ []) = pprLabel lbl
68 pprNatCmmTop (CmmProc info lbl params blocks) =
69 pprSectionHeader Text $$
71 then vcat (map pprData info)
72 $$ pprLabel (entryLblToInfoLbl lbl)
76 (BasicBlock _ instrs : rest) ->
77 (if null info then pprLabel lbl else empty) $$
78 -- the first block doesn't get a label:
79 vcat (map pprInstr instrs) $$
80 vcat (map pprBasicBlock rest))
83 pprBasicBlock :: NatBasicBlock -> Doc
84 pprBasicBlock (BasicBlock (BlockId id) instrs) =
85 pprLabel (mkAsmTempLabel id) $$
86 vcat (map pprInstr instrs)
88 -- -----------------------------------------------------------------------------
89 -- pprReg: print a 'Reg'
91 -- For x86, the way we print a register name depends
92 -- on which bit of it we care about. Yurgh.
94 pprUserReg :: Reg -> Doc
95 pprUserReg = pprReg IF_ARCH_i386(I32,)
97 pprReg :: IF_ARCH_i386(MachRep ->,) Reg -> Doc
99 pprReg IF_ARCH_i386(s,) r
101 RealReg i -> ppr_reg_no IF_ARCH_i386(s,) i
102 VirtualRegI u -> text "%vI_" <> asmSDoc (pprUnique u)
103 VirtualRegHi u -> text "%vHi_" <> asmSDoc (pprUnique u)
104 VirtualRegF u -> text "%vF_" <> asmSDoc (pprUnique u)
105 VirtualRegD u -> text "%vD_" <> asmSDoc (pprUnique u)
107 #if alpha_TARGET_ARCH
108 ppr_reg_no :: Int -> Doc
111 0 -> SLIT("$0"); 1 -> SLIT("$1");
112 2 -> SLIT("$2"); 3 -> SLIT("$3");
113 4 -> SLIT("$4"); 5 -> SLIT("$5");
114 6 -> SLIT("$6"); 7 -> SLIT("$7");
115 8 -> SLIT("$8"); 9 -> SLIT("$9");
116 10 -> SLIT("$10"); 11 -> SLIT("$11");
117 12 -> SLIT("$12"); 13 -> SLIT("$13");
118 14 -> SLIT("$14"); 15 -> SLIT("$15");
119 16 -> SLIT("$16"); 17 -> SLIT("$17");
120 18 -> SLIT("$18"); 19 -> SLIT("$19");
121 20 -> SLIT("$20"); 21 -> SLIT("$21");
122 22 -> SLIT("$22"); 23 -> SLIT("$23");
123 24 -> SLIT("$24"); 25 -> SLIT("$25");
124 26 -> SLIT("$26"); 27 -> SLIT("$27");
125 28 -> SLIT("$28"); 29 -> SLIT("$29");
126 30 -> SLIT("$30"); 31 -> SLIT("$31");
127 32 -> SLIT("$f0"); 33 -> SLIT("$f1");
128 34 -> SLIT("$f2"); 35 -> SLIT("$f3");
129 36 -> SLIT("$f4"); 37 -> SLIT("$f5");
130 38 -> SLIT("$f6"); 39 -> SLIT("$f7");
131 40 -> SLIT("$f8"); 41 -> SLIT("$f9");
132 42 -> SLIT("$f10"); 43 -> SLIT("$f11");
133 44 -> SLIT("$f12"); 45 -> SLIT("$f13");
134 46 -> SLIT("$f14"); 47 -> SLIT("$f15");
135 48 -> SLIT("$f16"); 49 -> SLIT("$f17");
136 50 -> SLIT("$f18"); 51 -> SLIT("$f19");
137 52 -> SLIT("$f20"); 53 -> SLIT("$f21");
138 54 -> SLIT("$f22"); 55 -> SLIT("$f23");
139 56 -> SLIT("$f24"); 57 -> SLIT("$f25");
140 58 -> SLIT("$f26"); 59 -> SLIT("$f27");
141 60 -> SLIT("$f28"); 61 -> SLIT("$f29");
142 62 -> SLIT("$f30"); 63 -> SLIT("$f31");
143 _ -> SLIT("very naughty alpha register")
147 ppr_reg_no :: MachRep -> Int -> Doc
148 ppr_reg_no I8 = ppr_reg_byte
149 ppr_reg_no I16 = ppr_reg_word
150 ppr_reg_no _ = ppr_reg_long
152 ppr_reg_byte i = ptext
154 0 -> SLIT("%al"); 1 -> SLIT("%bl");
155 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
156 _ -> SLIT("very naughty I386 byte register")
159 ppr_reg_word i = ptext
161 0 -> SLIT("%ax"); 1 -> SLIT("%bx");
162 2 -> SLIT("%cx"); 3 -> SLIT("%dx");
163 4 -> SLIT("%si"); 5 -> SLIT("%di");
164 6 -> SLIT("%bp"); 7 -> SLIT("%sp");
165 _ -> SLIT("very naughty I386 word register")
168 ppr_reg_long i = ptext
170 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
171 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
172 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
173 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
174 8 -> SLIT("%fake0"); 9 -> SLIT("%fake1");
175 10 -> SLIT("%fake2"); 11 -> SLIT("%fake3");
176 12 -> SLIT("%fake4"); 13 -> SLIT("%fake5");
177 _ -> SLIT("very naughty I386 register")
180 #if sparc_TARGET_ARCH
181 ppr_reg_no :: Int -> Doc
184 0 -> SLIT("%g0"); 1 -> SLIT("%g1");
185 2 -> SLIT("%g2"); 3 -> SLIT("%g3");
186 4 -> SLIT("%g4"); 5 -> SLIT("%g5");
187 6 -> SLIT("%g6"); 7 -> SLIT("%g7");
188 8 -> SLIT("%o0"); 9 -> SLIT("%o1");
189 10 -> SLIT("%o2"); 11 -> SLIT("%o3");
190 12 -> SLIT("%o4"); 13 -> SLIT("%o5");
191 14 -> SLIT("%o6"); 15 -> SLIT("%o7");
192 16 -> SLIT("%l0"); 17 -> SLIT("%l1");
193 18 -> SLIT("%l2"); 19 -> SLIT("%l3");
194 20 -> SLIT("%l4"); 21 -> SLIT("%l5");
195 22 -> SLIT("%l6"); 23 -> SLIT("%l7");
196 24 -> SLIT("%i0"); 25 -> SLIT("%i1");
197 26 -> SLIT("%i2"); 27 -> SLIT("%i3");
198 28 -> SLIT("%i4"); 29 -> SLIT("%i5");
199 30 -> SLIT("%i6"); 31 -> SLIT("%i7");
200 32 -> SLIT("%f0"); 33 -> SLIT("%f1");
201 34 -> SLIT("%f2"); 35 -> SLIT("%f3");
202 36 -> SLIT("%f4"); 37 -> SLIT("%f5");
203 38 -> SLIT("%f6"); 39 -> SLIT("%f7");
204 40 -> SLIT("%f8"); 41 -> SLIT("%f9");
205 42 -> SLIT("%f10"); 43 -> SLIT("%f11");
206 44 -> SLIT("%f12"); 45 -> SLIT("%f13");
207 46 -> SLIT("%f14"); 47 -> SLIT("%f15");
208 48 -> SLIT("%f16"); 49 -> SLIT("%f17");
209 50 -> SLIT("%f18"); 51 -> SLIT("%f19");
210 52 -> SLIT("%f20"); 53 -> SLIT("%f21");
211 54 -> SLIT("%f22"); 55 -> SLIT("%f23");
212 56 -> SLIT("%f24"); 57 -> SLIT("%f25");
213 58 -> SLIT("%f26"); 59 -> SLIT("%f27");
214 60 -> SLIT("%f28"); 61 -> SLIT("%f29");
215 62 -> SLIT("%f30"); 63 -> SLIT("%f31");
216 _ -> SLIT("very naughty sparc register")
219 #if powerpc_TARGET_ARCH
221 ppr_reg_no :: Int -> Doc
224 0 -> SLIT("r0"); 1 -> SLIT("r1");
225 2 -> SLIT("r2"); 3 -> SLIT("r3");
226 4 -> SLIT("r4"); 5 -> SLIT("r5");
227 6 -> SLIT("r6"); 7 -> SLIT("r7");
228 8 -> SLIT("r8"); 9 -> SLIT("r9");
229 10 -> SLIT("r10"); 11 -> SLIT("r11");
230 12 -> SLIT("r12"); 13 -> SLIT("r13");
231 14 -> SLIT("r14"); 15 -> SLIT("r15");
232 16 -> SLIT("r16"); 17 -> SLIT("r17");
233 18 -> SLIT("r18"); 19 -> SLIT("r19");
234 20 -> SLIT("r20"); 21 -> SLIT("r21");
235 22 -> SLIT("r22"); 23 -> SLIT("r23");
236 24 -> SLIT("r24"); 25 -> SLIT("r25");
237 26 -> SLIT("r26"); 27 -> SLIT("r27");
238 28 -> SLIT("r28"); 29 -> SLIT("r29");
239 30 -> SLIT("r30"); 31 -> SLIT("r31");
240 32 -> SLIT("f0"); 33 -> SLIT("f1");
241 34 -> SLIT("f2"); 35 -> SLIT("f3");
242 36 -> SLIT("f4"); 37 -> SLIT("f5");
243 38 -> SLIT("f6"); 39 -> SLIT("f7");
244 40 -> SLIT("f8"); 41 -> SLIT("f9");
245 42 -> SLIT("f10"); 43 -> SLIT("f11");
246 44 -> SLIT("f12"); 45 -> SLIT("f13");
247 46 -> SLIT("f14"); 47 -> SLIT("f15");
248 48 -> SLIT("f16"); 49 -> SLIT("f17");
249 50 -> SLIT("f18"); 51 -> SLIT("f19");
250 52 -> SLIT("f20"); 53 -> SLIT("f21");
251 54 -> SLIT("f22"); 55 -> SLIT("f23");
252 56 -> SLIT("f24"); 57 -> SLIT("f25");
253 58 -> SLIT("f26"); 59 -> SLIT("f27");
254 60 -> SLIT("f28"); 61 -> SLIT("f29");
255 62 -> SLIT("f30"); 63 -> SLIT("f31");
256 _ -> SLIT("very naughty powerpc register")
259 ppr_reg_no :: Int -> Doc
260 ppr_reg_no i | i <= 31 = int i -- GPRs
261 | i <= 63 = int (i-32) -- FPRs
262 | otherwise = ptext SLIT("very naughty powerpc register")
267 -- -----------------------------------------------------------------------------
268 -- pprSize: print a 'Size'
270 #if powerpc_TARGET_ARCH || i386_TARGET_ARCH
271 pprSize :: MachRep -> Doc
273 pprSize :: Size -> Doc
276 pprSize x = ptext (case x of
277 #if alpha_TARGET_ARCH
280 -- W -> SLIT("w") UNUSED
281 -- Wu -> SLIT("wu") UNUSED
284 -- FF -> SLIT("f") UNUSED
285 -- DF -> SLIT("d") UNUSED
286 -- GF -> SLIT("g") UNUSED
287 -- SF -> SLIT("s") UNUSED
298 #if sparc_TARGET_ARCH
307 pprStSize :: Size -> Doc
308 pprStSize x = ptext (case x of
317 #if powerpc_TARGET_ARCH
326 -- -----------------------------------------------------------------------------
327 -- pprCond: print a 'Cond'
329 pprCond :: Cond -> Doc
331 pprCond c = ptext (case c of {
332 #if alpha_TARGET_ARCH
343 GEU -> SLIT("ae"); LU -> SLIT("b");
344 EQQ -> SLIT("e"); GTT -> SLIT("g");
345 GE -> SLIT("ge"); GU -> SLIT("a");
346 LTT -> SLIT("l"); LE -> SLIT("le");
347 LEU -> SLIT("be"); NE -> SLIT("ne");
348 NEG -> SLIT("s"); POS -> SLIT("ns");
349 CARRY -> SLIT("c"); OFLO -> SLIT("o");
350 ALWAYS -> SLIT("mp") -- hack
352 #if sparc_TARGET_ARCH
353 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
354 GEU -> SLIT("geu"); LU -> SLIT("lu");
355 EQQ -> SLIT("e"); GTT -> SLIT("g");
356 GE -> SLIT("ge"); GU -> SLIT("gu");
357 LTT -> SLIT("l"); LE -> SLIT("le");
358 LEU -> SLIT("leu"); NE -> SLIT("ne");
359 NEG -> SLIT("neg"); POS -> SLIT("pos");
360 VC -> SLIT("vc"); VS -> SLIT("vs")
362 #if powerpc_TARGET_ARCH
364 EQQ -> SLIT("eq"); NE -> SLIT("ne");
365 LTT -> SLIT("lt"); GE -> SLIT("ge");
366 GTT -> SLIT("gt"); LE -> SLIT("le");
367 LU -> SLIT("lt"); GEU -> SLIT("ge");
368 GU -> SLIT("gt"); LEU -> SLIT("le");
373 -- -----------------------------------------------------------------------------
374 -- pprImm: print an 'Imm'
378 pprImm (ImmInt i) = int i
379 pprImm (ImmInteger i) = integer i
380 pprImm (ImmCLbl l) = pprCLabel_asm l
381 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
382 pprImm (ImmLit s) = s
384 pprImm (ImmFloat _) = panic "pprImm:ImmFloat"
385 pprImm (ImmDouble _) = panic "pprImm:ImmDouble"
387 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
388 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
389 <> lparen <> pprImm b <> rparen
391 #if sparc_TARGET_ARCH
393 = hcat [ pp_lo, pprImm i, rparen ]
398 = hcat [ pp_hi, pprImm i, rparen ]
402 #if powerpc_TARGET_ARCH
405 = hcat [ pp_lo, pprImm i, rparen ]
410 = hcat [ pp_hi, pprImm i, rparen ]
415 = hcat [ pp_ha, pprImm i, rparen ]
421 = pprImm i <> text "@l"
424 = pprImm i <> text "@h"
427 = pprImm i <> text "@ha"
432 -- -----------------------------------------------------------------------------
433 -- @pprAddr: print an 'AddrMode'
435 pprAddr :: AddrMode -> Doc
437 #if alpha_TARGET_ARCH
438 pprAddr (AddrReg r) = parens (pprReg r)
439 pprAddr (AddrImm i) = pprImm i
440 pprAddr (AddrRegImm r1 i)
441 = (<>) (pprImm i) (parens (pprReg r1))
447 pprAddr (ImmAddr imm off)
448 = let pp_imm = pprImm imm
452 else if (off < 0) then
455 pp_imm <> char '+' <> int off
457 pprAddr (AddrBaseIndex base index displacement)
459 pp_disp = ppr_disp displacement
460 pp_off p = pp_disp <> char '(' <> p <> char ')'
461 pp_reg r = pprReg I32 r
464 (Nothing, Nothing) -> pp_disp
465 (Just b, Nothing) -> pp_off (pp_reg b)
466 (Nothing, Just (r,i)) -> pp_off (comma <> pp_reg r <> comma <> int i)
467 (Just b, Just (r,i)) -> pp_off (pp_reg b <> comma <> pp_reg r
470 ppr_disp (ImmInt 0) = empty
471 ppr_disp imm = pprImm imm
476 #if sparc_TARGET_ARCH
477 pprAddr (AddrRegReg r1 (RealReg 0)) = pprReg r1
479 pprAddr (AddrRegReg r1 r2)
480 = hcat [ pprReg r1, char '+', pprReg r2 ]
482 pprAddr (AddrRegImm r1 (ImmInt i))
484 | not (fits13Bits i) = largeOffsetError i
485 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
487 pp_sign = if i > 0 then char '+' else empty
489 pprAddr (AddrRegImm r1 (ImmInteger i))
491 | not (fits13Bits i) = largeOffsetError i
492 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
494 pp_sign = if i > 0 then char '+' else empty
496 pprAddr (AddrRegImm r1 imm)
497 = hcat [ pprReg r1, char '+', pprImm imm ]
502 #if powerpc_TARGET_ARCH
503 pprAddr (AddrRegReg r1 r2)
504 = pprReg r1 <+> ptext SLIT(", ") <+> pprReg r2
506 pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
507 pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
508 pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
512 -- -----------------------------------------------------------------------------
513 -- pprData: print a 'CmmStatic'
515 #if defined(linux_TARGET_OS)
516 #if defined(powerpc_TARGET_ARCH) || defined(i386_TARGET_ARCH)
517 -- Hack to make dynamic linking work
518 pprSectionHeader ReadOnlyData
519 | not opt_PIC && not opt_Static
520 = pprSectionHeader Data
524 pprSectionHeader Text
526 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
527 ,IF_ARCH_sparc(SLIT(".text\n\t.align 4") {-word boundary-}
528 ,IF_ARCH_i386(SLIT(".text\n\t.align 4,0x90") {-needs per-OS variation!-}
529 ,IF_ARCH_powerpc(SLIT(".text\n.align 2")
531 pprSectionHeader Data
533 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
534 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
535 ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
536 ,IF_ARCH_powerpc(SLIT(".data\n.align 2")
538 pprSectionHeader ReadOnlyData
540 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
541 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
542 ,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 4")
543 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
544 SLIT(".section .rodata\n\t.align 2"))
546 pprSectionHeader UninitialisedData
548 IF_ARCH_alpha(SLIT("\t.bss\n\t.align 3")
549 ,IF_ARCH_sparc(SLIT(".bss\n\t.align 8") {-<8 will break double constants -}
550 ,IF_ARCH_i386(SLIT(".section .bss\n\t.align 4")
551 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
552 SLIT(".section .bss\n\t.align 2"))
554 pprSectionHeader (OtherSection sec)
555 = panic "PprMach.pprSectionHeader: unknown section"
557 pprData :: CmmStatic -> Doc
558 pprData (CmmAlign bytes) = pprAlign bytes
559 pprData (CmmDataLabel lbl) = pprLabel lbl
560 pprData (CmmString str) = pprASCII str
561 pprData (CmmUninitialised bytes) = ptext SLIT(".space ") <> int bytes
562 pprData (CmmStaticLit lit) = pprDataItem lit
564 pprGloblDecl :: CLabel -> Doc
566 | not (externallyVisibleCLabel lbl) = empty
567 | otherwise = ptext IF_ARCH_alpha(SLIT(".globl ")
568 ,IF_ARCH_i386(SLIT(".globl ")
569 ,IF_ARCH_sparc(SLIT(".global ")
570 ,IF_ARCH_powerpc(SLIT(".globl ")
574 pprLabel :: CLabel -> Doc
575 pprLabel lbl = pprGloblDecl lbl $$ (pprCLabel_asm lbl <> char ':')
578 -- Assume we want to backslash-convert the string
580 = vcat (map do1 (str ++ [chr 0]))
583 do1 c = ptext SLIT("\t.byte\t0x") <> hshow (ord c)
586 hshow n | n >= 0 && n <= 255
587 = char (tab !! (n `div` 16)) <> char (tab !! (n `mod` 16))
588 tab = "0123456789ABCDEF"
591 IF_ARCH_alpha(ptextSLIT(".align ") <> int pow2,
592 IF_ARCH_i386(ptext SLIT(".align ") <> int bytes,
593 IF_ARCH_sparc(ptext SLIT(".align ") <> int bytes,
594 IF_ARCH_powerpc(ptext SLIT(".align ") <> int pow2,))))
598 log2 :: Int -> Int -- cache the common ones
603 log2 n = 1 + log2 (n `quot` 2)
606 pprDataItem :: CmmLit -> Doc
608 = vcat (ppr_item (cmmLitRep lit) lit)
612 -- These seem to be common:
613 ppr_item I8 x = [ptext SLIT("\t.byte\t") <> pprImm imm]
614 ppr_item I32 x = [ptext SLIT("\t.long\t") <> pprImm imm]
615 ppr_item F32 (CmmFloat r _)
616 = let bs = floatToBytes (fromRational r)
617 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
618 ppr_item F64 (CmmFloat r _)
619 = let bs = doubleToBytes (fromRational r)
620 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
622 #if sparc_TARGET_ARCH
623 -- copy n paste of x86 version
624 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
625 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
628 ppr_item I16 x = [ptext SLIT("\t.word\t") <> pprImm imm]
629 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
631 #if powerpc_TARGET_ARCH
632 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
633 ppr_item I64 (CmmInt x _) =
634 [ptext SLIT("\t.long\t")
636 (fromIntegral (x `shiftR` 32) :: Word32)),
637 ptext SLIT("\t.long\t")
638 <> int (fromIntegral (fromIntegral x :: Word32))]
641 -- fall through to rest of (machine-specific) pprInstr...
643 -- -----------------------------------------------------------------------------
644 -- pprInstr: print an 'Instr'
646 pprInstr :: Instr -> Doc
648 --pprInstr (COMMENT s) = empty -- nuke 'em
650 = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
651 ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ftext s))
652 ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ftext s))
653 ,IF_ARCH_powerpc( IF_OS_linux(
654 ((<>) (ptext SLIT("# ")) (ftext s)),
655 ((<>) (ptext SLIT("; ")) (ftext s)))
659 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
661 pprInstr (NEWBLOCK _)
662 = panic "PprMach.pprInstr: NEWBLOCK"
665 = panic "PprMach.pprInstr: LDATA"
667 -- -----------------------------------------------------------------------------
668 -- pprInstr for an Alpha
670 #if alpha_TARGET_ARCH
672 pprInstr (LD size reg addr)
682 pprInstr (LDA reg addr)
684 ptext SLIT("\tlda\t"),
690 pprInstr (LDAH reg addr)
692 ptext SLIT("\tldah\t"),
698 pprInstr (LDGP reg addr)
700 ptext SLIT("\tldgp\t"),
706 pprInstr (LDI size reg imm)
716 pprInstr (ST size reg addr)
728 ptext SLIT("\tclr\t"),
732 pprInstr (ABS size ri reg)
742 pprInstr (NEG size ov ri reg)
746 if ov then ptext SLIT("v\t") else char '\t',
752 pprInstr (ADD size ov reg1 ri reg2)
756 if ov then ptext SLIT("v\t") else char '\t',
764 pprInstr (SADD size scale reg1 ri reg2)
766 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
777 pprInstr (SUB size ov reg1 ri reg2)
781 if ov then ptext SLIT("v\t") else char '\t',
789 pprInstr (SSUB size scale reg1 ri reg2)
791 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
802 pprInstr (MUL size ov reg1 ri reg2)
806 if ov then ptext SLIT("v\t") else char '\t',
814 pprInstr (DIV size uns reg1 ri reg2)
818 if uns then ptext SLIT("u\t") else char '\t',
826 pprInstr (REM size uns reg1 ri reg2)
830 if uns then ptext SLIT("u\t") else char '\t',
838 pprInstr (NOT ri reg)
847 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
848 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
849 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
850 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
851 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
852 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
854 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
855 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
856 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
858 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
859 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
861 pprInstr (NOP) = ptext SLIT("\tnop")
863 pprInstr (CMP cond reg1 ri reg2)
877 ptext SLIT("\tfclr\t"),
881 pprInstr (FABS reg1 reg2)
883 ptext SLIT("\tfabs\t"),
889 pprInstr (FNEG size reg1 reg2)
899 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
900 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
901 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
902 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
904 pprInstr (CVTxy size1 size2 reg1 reg2)
908 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
915 pprInstr (FCMP size cond reg1 reg2 reg3)
928 pprInstr (FMOV reg1 reg2)
930 ptext SLIT("\tfmov\t"),
936 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
938 pprInstr (BI NEVER reg lab) = empty
940 pprInstr (BI cond reg lab)
950 pprInstr (BF cond reg lab)
961 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
963 pprInstr (JMP reg addr hint)
965 ptext SLIT("\tjmp\t"),
974 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
976 pprInstr (JSR reg addr n)
978 ptext SLIT("\tjsr\t"),
984 pprInstr (FUNBEGIN clab)
986 if (externallyVisibleCLabel clab) then
987 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
990 ptext SLIT("\t.ent "),
999 pp_lab = pprCLabel_asm clab
1001 -- NEVER use commas within those string literals, cpp will ruin your day
1002 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
1003 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
1004 ptext SLIT("4240"), char ',',
1005 ptext SLIT("$26"), char ',',
1006 ptext SLIT("0\n\t.prologue 1") ]
1008 pprInstr (FUNEND clab)
1009 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
1012 Continue with Alpha-only printing bits and bobs:
1016 pprRI (RIReg r) = pprReg r
1017 pprRI (RIImm r) = pprImm r
1019 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
1020 pprRegRIReg name reg1 ri reg2
1032 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1033 pprSizeRegRegReg name size reg1 reg2 reg3
1046 #endif /* alpha_TARGET_ARCH */
1049 -- -----------------------------------------------------------------------------
1050 -- pprInstr for an x86
1052 #if i386_TARGET_ARCH
1054 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
1057 #if 0 /* #ifdef DEBUG */
1058 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
1062 pprInstr (MOV size src dst)
1063 = pprSizeOpOp SLIT("mov") size src dst
1064 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes I32 src dst
1065 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes I32 src dst
1067 -- here we do some patching, since the physical registers are only set late
1068 -- in the code generation.
1069 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
1071 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
1072 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
1074 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
1075 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
1077 = pprInstr (ADD size (OpImm displ) dst)
1078 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
1080 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
1081 = pprSizeOp SLIT("dec") size dst
1082 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
1083 = pprSizeOp SLIT("inc") size dst
1084 pprInstr (ADD size src dst)
1085 = pprSizeOpOp SLIT("add") size src dst
1086 pprInstr (ADC size src dst)
1087 = pprSizeOpOp SLIT("adc") size src dst
1088 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
1089 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1091 {- A hack. The Intel documentation says that "The two and three
1092 operand forms [of IMUL] may also be used with unsigned operands
1093 because the lower half of the product is the same regardless if
1094 (sic) the operands are signed or unsigned. The CF and OF flags,
1095 however, cannot be used to determine if the upper half of the
1096 result is non-zero." So there.
1098 pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1100 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
1101 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
1102 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
1103 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
1104 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
1106 pprInstr (SHL size src dst) = pprShift SLIT("shl") size src dst
1107 pprInstr (SAR size src dst) = pprShift SLIT("sar") size src dst
1108 pprInstr (SHR size src dst) = pprShift SLIT("shr") size src dst
1110 pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src
1112 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
1113 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
1114 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
1115 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
1117 -- both unused (SDM):
1118 -- pprInstr PUSHA = ptext SLIT("\tpushal")
1119 -- pprInstr POPA = ptext SLIT("\tpopal")
1121 pprInstr NOP = ptext SLIT("\tnop")
1122 pprInstr CLTD = ptext SLIT("\tcltd")
1124 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand I8 op)
1126 pprInstr (JXX cond (BlockId id))
1127 = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
1128 where lab = mkAsmTempLabel id
1130 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
1131 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand I32 op)
1132 pprInstr (JMP_TBL op ids) = pprInstr (JMP op)
1133 pprInstr (CALL (Left imm)) = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
1134 pprInstr (CALL (Right reg)) = (<>) (ptext SLIT("\tcall *")) (pprReg I32 reg)
1136 pprInstr (IDIV sz op) = pprSizeOp SLIT("idiv") sz op
1137 pprInstr (DIV sz op) = pprSizeOp SLIT("div") sz op
1139 pprInstr (IMUL64 sd_hi sd_lo) = pprInstr_imul64 sd_hi sd_lo
1142 -- Simulating a flat register set on the x86 FP stack is tricky.
1143 -- you have to free %st(7) before pushing anything on the FP reg stack
1144 -- so as to preclude the possibility of a FP stack overflow exception.
1145 pprInstr g@(GMOV src dst)
1149 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1151 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1152 pprInstr g@(GLD sz addr dst)
1153 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1154 pprAddr addr, gsemi, gpop dst 1])
1156 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1157 pprInstr g@(GST sz src addr)
1158 = pprG g (hcat [gtab, gpush src 0, gsemi,
1159 text "fstp", pprSize sz, gsp, pprAddr addr])
1161 pprInstr g@(GLDZ dst)
1162 = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
1163 pprInstr g@(GLD1 dst)
1164 = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
1166 pprInstr g@(GFTOI src dst)
1167 = pprInstr (GDTOI src dst)
1168 pprInstr g@(GDTOI src dst)
1169 = pprG g (hcat [gtab, text "subl $4, %esp ; ",
1170 gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ",
1173 pprInstr g@(GITOF src dst)
1174 = pprInstr (GITOD src dst)
1175 pprInstr g@(GITOD src dst)
1176 = pprG g (hcat [gtab, text "pushl ", pprReg I32 src,
1177 text " ; ffree %st(7); fildl (%esp) ; ",
1178 gpop dst 1, text " ; addl $4,%esp"])
1180 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
1181 this far into the jungle AND you give a Rat's Ass (tm) what's going
1182 on, here's the deal. Generate code to do a floating point comparison
1183 of src1 and src2, of kind cond, and set the Zero flag if true.
1185 The complications are to do with handling NaNs correctly. We want the
1186 property that if either argument is NaN, then the result of the
1187 comparison is False ... except if we're comparing for inequality,
1188 in which case the answer is True.
1190 Here's how the general (non-inequality) case works. As an
1191 example, consider generating the an equality test:
1193 pushl %eax -- we need to mess with this
1194 <get src1 to top of FPU stack>
1195 fcomp <src2 location in FPU stack> and pop pushed src1
1196 -- Result of comparison is in FPU Status Register bits
1198 fstsw %ax -- Move FPU Status Reg to %ax
1199 sahf -- move C3 C2 C0 from %ax to integer flag reg
1200 -- now the serious magic begins
1201 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
1202 sete %al -- %al = if arg1 == arg2 then 1 else 0
1203 andb %ah,%al -- %al &= %ah
1204 -- so %al == 1 iff (comparable && same); else it holds 0
1205 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
1206 else %al == 0xFF, ZeroFlag=0
1207 -- the zero flag is now set as we desire.
1210 The special case of inequality differs thusly:
1212 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
1213 setne %al -- %al = if arg1 /= arg2 then 1 else 0
1214 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
1215 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
1216 else (%al == 0xFF, ZF=0)
1218 pprInstr g@(GCMP cond src1 src2)
1219 | case cond of { NE -> True; other -> False }
1221 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1222 hcat [gtab, text "fcomp ", greg src2 1,
1223 text "; fstsw %ax ; sahf ; setpe %ah"],
1224 hcat [gtab, text "setne %al ; ",
1225 text "orb %ah,%al ; decb %al ; popl %eax"]
1229 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1230 hcat [gtab, text "fcomp ", greg src2 1,
1231 text "; fstsw %ax ; sahf ; setpo %ah"],
1232 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
1233 text "andb %ah,%al ; decb %al ; popl %eax"]
1236 {- On the 486, the flags set by FP compare are the unsigned ones!
1237 (This looks like a HACK to me. WDP 96/03)
1239 fix_FP_cond :: Cond -> Cond
1240 fix_FP_cond GE = GEU
1241 fix_FP_cond GTT = GU
1242 fix_FP_cond LTT = LU
1243 fix_FP_cond LE = LEU
1244 fix_FP_cond EQQ = EQQ
1246 -- there should be no others
1249 pprInstr g@(GABS sz src dst)
1250 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1251 pprInstr g@(GNEG sz src dst)
1252 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1254 pprInstr g@(GSQRT sz src dst)
1255 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1256 hcat [gtab, gcoerceto sz, gpop dst 1])
1257 pprInstr g@(GSIN sz src dst)
1258 = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1259 hcat [gtab, gcoerceto sz, gpop dst 1])
1260 pprInstr g@(GCOS sz src dst)
1261 = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1262 hcat [gtab, gcoerceto sz, gpop dst 1])
1263 pprInstr g@(GTAN sz src dst)
1264 = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1265 gpush src 0, text " ; fptan ; ",
1266 text " fstp %st(0)"] $$
1267 hcat [gtab, gcoerceto sz, gpop dst 1])
1269 -- In the translations for GADD, GMUL, GSUB and GDIV,
1270 -- the first two cases are mere optimisations. The otherwise clause
1271 -- generates correct code under all circumstances.
1273 pprInstr g@(GADD sz src1 src2 dst)
1275 = pprG g (text "\t#GADD-xxxcase1" $$
1276 hcat [gtab, gpush src2 0,
1277 text " ; faddp %st(0),", greg src1 1])
1279 = pprG g (text "\t#GADD-xxxcase2" $$
1280 hcat [gtab, gpush src1 0,
1281 text " ; faddp %st(0),", greg src2 1])
1283 = pprG g (hcat [gtab, gpush src1 0,
1284 text " ; fadd ", greg src2 1, text ",%st(0)",
1288 pprInstr g@(GMUL sz src1 src2 dst)
1290 = pprG g (text "\t#GMUL-xxxcase1" $$
1291 hcat [gtab, gpush src2 0,
1292 text " ; fmulp %st(0),", greg src1 1])
1294 = pprG g (text "\t#GMUL-xxxcase2" $$
1295 hcat [gtab, gpush src1 0,
1296 text " ; fmulp %st(0),", greg src2 1])
1298 = pprG g (hcat [gtab, gpush src1 0,
1299 text " ; fmul ", greg src2 1, text ",%st(0)",
1303 pprInstr g@(GSUB sz src1 src2 dst)
1305 = pprG g (text "\t#GSUB-xxxcase1" $$
1306 hcat [gtab, gpush src2 0,
1307 text " ; fsubrp %st(0),", greg src1 1])
1309 = pprG g (text "\t#GSUB-xxxcase2" $$
1310 hcat [gtab, gpush src1 0,
1311 text " ; fsubp %st(0),", greg src2 1])
1313 = pprG g (hcat [gtab, gpush src1 0,
1314 text " ; fsub ", greg src2 1, text ",%st(0)",
1318 pprInstr g@(GDIV sz src1 src2 dst)
1320 = pprG g (text "\t#GDIV-xxxcase1" $$
1321 hcat [gtab, gpush src2 0,
1322 text " ; fdivrp %st(0),", greg src1 1])
1324 = pprG g (text "\t#GDIV-xxxcase2" $$
1325 hcat [gtab, gpush src1 0,
1326 text " ; fdivp %st(0),", greg src2 1])
1328 = pprG g (hcat [gtab, gpush src1 0,
1329 text " ; fdiv ", greg src2 1, text ",%st(0)",
1334 = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1335 ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1338 pprInstr (FETCHGOT reg)
1339 = vcat [ ptext SLIT("\tcall 1f"),
1340 hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ],
1341 hcat [ ptext SLIT("\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
1345 -- Emit code to make hi_reg:lo_reg be the 64-bit product of hi_reg and lo_reg
1346 pprInstr_imul64 hi_reg lo_reg
1347 = let fakeInsn = text "imul64" <+> pp_hi_reg <> comma <+> pp_lo_reg
1348 pp_hi_reg = pprReg I32 hi_reg
1349 pp_lo_reg = pprReg I32 lo_reg
1352 text "\t# BEGIN " <> fakeInsn,
1353 text "\tpushl" <+> pp_hi_reg <> text" ; pushl" <+> pp_lo_reg,
1354 text "\tpushl %eax ; pushl %edx",
1355 text "\tmovl 12(%esp), %eax ; imull 8(%esp)",
1356 text "\tmovl %edx, 12(%esp) ; movl %eax, 8(%esp)",
1357 text "\tpopl %edx ; popl %eax",
1358 text "\tpopl" <+> pp_lo_reg <> text " ; popl" <+> pp_hi_reg,
1359 text "\t# END " <> fakeInsn
1363 --------------------------
1365 -- coerce %st(0) to the specified size
1366 gcoerceto F64 = empty
1367 gcoerceto F32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1370 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1372 = hcat [text "fstp ", greg reg offset]
1374 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1379 gregno (RealReg i) = i
1380 gregno other = --pprPanic "gregno" (ppr other)
1381 999 -- bogus; only needed for debug printing
1383 pprG :: Instr -> Doc -> Doc
1385 = (char '#' <> pprGInstr fake) $$ actual
1387 pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") F64 src dst
1388 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1389 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1391 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") F64 dst
1392 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") F64 dst
1394 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F32 I32 src dst
1395 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") F64 I32 src dst
1397 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") I32 F32 src dst
1398 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") I32 F64 src dst
1400 pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") F64 co src dst
1401 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1402 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1403 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1404 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1405 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1406 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1408 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1409 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1410 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1411 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1413 -- Continue with I386-only printing bits and bobs:
1415 pprDollImm :: Imm -> Doc
1417 pprDollImm i = ptext SLIT("$") <> pprImm i
1419 pprOperand :: MachRep -> Operand -> Doc
1420 pprOperand s (OpReg r) = pprReg s r
1421 pprOperand s (OpImm i) = pprDollImm i
1422 pprOperand s (OpAddr ea) = pprAddr ea
1424 pprMnemonic :: LitString -> MachRep -> Doc
1425 pprMnemonic name size =
1426 char '\t' <> ptext name <> pprSize size <> space
1428 pprSizeImmOp :: LitString -> MachRep -> Imm -> Operand -> Doc
1429 pprSizeImmOp name size imm op1
1431 pprMnemonic name size,
1438 pprSizeOp :: LitString -> MachRep -> Operand -> Doc
1439 pprSizeOp name size op1
1441 pprMnemonic name size,
1445 pprSizeOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1446 pprSizeOpOp name size op1 op2
1448 pprMnemonic name size,
1449 pprOperand size op1,
1454 pprSizeReg :: LitString -> MachRep -> Reg -> Doc
1455 pprSizeReg name size reg1
1457 pprMnemonic name size,
1461 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1462 pprSizeRegReg name size reg1 reg2
1464 pprMnemonic name size,
1470 pprCondRegReg :: LitString -> MachRep -> Cond -> Reg -> Reg -> Doc
1471 pprCondRegReg name size cond reg1 reg2
1482 pprSizeSizeRegReg :: LitString -> MachRep -> MachRep -> Reg -> Reg -> Doc
1483 pprSizeSizeRegReg name size1 size2 reg1 reg2
1496 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
1497 pprSizeRegRegReg name size reg1 reg2 reg3
1499 pprMnemonic name size,
1507 pprSizeAddrReg :: LitString -> MachRep -> AddrMode -> Reg -> Doc
1508 pprSizeAddrReg name size op dst
1510 pprMnemonic name size,
1516 pprSizeRegAddr :: LitString -> MachRep -> Reg -> AddrMode -> Doc
1517 pprSizeRegAddr name size src op
1519 pprMnemonic name size,
1525 pprShift :: LitString -> MachRep -> Operand -> Operand -> Doc
1526 pprShift name size src dest
1528 pprMnemonic name size,
1529 pprOperand I8 src, -- src is 8-bit sized
1531 pprOperand size dest
1534 pprSizeOpOpCoerce :: LitString -> MachRep -> MachRep -> Operand -> Operand -> Doc
1535 pprSizeOpOpCoerce name size1 size2 op1 op2
1536 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1537 pprOperand size1 op1,
1539 pprOperand size2 op2
1542 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1543 pprCondInstr name cond arg
1544 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1546 #endif /* i386_TARGET_ARCH */
1549 -- ------------------------------------------------------------------------------- pprInstr for a SPARC
1551 #if sparc_TARGET_ARCH
1553 -- a clumsy hack for now, to handle possible double alignment problems
1555 -- even clumsier, to allow for RegReg regs that show when doing indexed
1556 -- reads (bytearrays).
1559 -- Translate to the following:
1562 -- ld [g1+4],%f(n+1)
1563 -- sub g1,g2,g1 -- to restore g1
1564 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1566 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1567 hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1568 hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1569 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1574 -- ld [addr+4],%f(n+1)
1575 pprInstr (LD DF addr reg) | isJust off_addr
1577 hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1578 hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1581 off_addr = addrOffset addr 4
1582 addr2 = case off_addr of Just x -> x
1585 pprInstr (LD size addr reg)
1596 -- The same clumsy hack as above
1598 -- Translate to the following:
1601 -- st %f(n+1),[g1+4]
1602 -- sub g1,g2,g1 -- to restore g1
1603 pprInstr (ST DF reg (AddrRegReg g1 g2))
1605 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1606 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1608 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1609 pprReg g1, ptext SLIT("+4]")],
1610 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1615 -- st %f(n+1),[addr+4]
1616 pprInstr (ST DF reg addr) | isJust off_addr
1618 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1619 pprAddr addr, rbrack],
1620 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1621 pprAddr addr2, rbrack]
1624 off_addr = addrOffset addr 4
1625 addr2 = case off_addr of Just x -> x
1627 -- no distinction is made between signed and unsigned bytes on stores for the
1628 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1629 -- so we call a special-purpose pprSize for ST..
1631 pprInstr (ST size reg addr)
1642 pprInstr (ADD x cc reg1 ri reg2)
1643 | not x && not cc && riZero ri
1644 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1646 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1648 pprInstr (SUB x cc reg1 ri reg2)
1649 | not x && cc && reg2 == g0
1650 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1651 | not x && not cc && riZero ri
1652 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1654 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1656 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1657 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1659 pprInstr (OR b reg1 ri reg2)
1660 | not b && reg1 == g0
1661 = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1663 RIReg rrr | rrr == reg2 -> empty
1666 = pprRegRIReg SLIT("or") b reg1 ri reg2
1668 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1670 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1671 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1673 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1674 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1675 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1677 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1678 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul") b reg1 ri reg2
1679 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul") b reg1 ri reg2
1681 pprInstr (SETHI imm reg)
1683 ptext SLIT("\tsethi\t"),
1689 pprInstr NOP = ptext SLIT("\tnop")
1691 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1692 pprInstr (FABS DF reg1 reg2)
1693 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1694 (if (reg1 == reg2) then empty
1695 else (<>) (char '\n')
1696 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1698 pprInstr (FADD size reg1 reg2 reg3)
1699 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1700 pprInstr (FCMP e size reg1 reg2)
1701 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1702 pprInstr (FDIV size reg1 reg2 reg3)
1703 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1705 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1706 pprInstr (FMOV DF reg1 reg2)
1707 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1708 (if (reg1 == reg2) then empty
1709 else (<>) (char '\n')
1710 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1712 pprInstr (FMUL size reg1 reg2 reg3)
1713 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1715 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1716 pprInstr (FNEG DF reg1 reg2)
1717 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1718 (if (reg1 == reg2) then empty
1719 else (<>) (char '\n')
1720 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1722 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1723 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1724 pprInstr (FxTOy size1 size2 reg1 reg2)
1737 pprReg reg1, comma, pprReg reg2
1741 pprInstr (BI cond b lab)
1743 ptext SLIT("\tb"), pprCond cond,
1744 if b then pp_comma_a else empty,
1749 pprInstr (BF cond b lab)
1751 ptext SLIT("\tfb"), pprCond cond,
1752 if b then pp_comma_a else empty,
1757 pprInstr (JMP dsts addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1759 pprInstr (CALL (Left imm) n _)
1760 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1761 pprInstr (CALL (Right reg) n _)
1762 = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
1765 Continue with SPARC-only printing bits and bobs:
1768 pprRI (RIReg r) = pprReg r
1769 pprRI (RIImm r) = pprImm r
1771 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
1772 pprSizeRegReg name size reg1 reg2
1777 F -> ptext SLIT("s\t")
1778 DF -> ptext SLIT("d\t")),
1784 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1785 pprSizeRegRegReg name size reg1 reg2 reg3
1790 F -> ptext SLIT("s\t")
1791 DF -> ptext SLIT("d\t")),
1799 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
1800 pprRegRIReg name b reg1 ri reg2
1804 if b then ptext SLIT("cc\t") else char '\t',
1812 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
1813 pprRIReg name b ri reg1
1817 if b then ptext SLIT("cc\t") else char '\t',
1823 pp_ld_lbracket = ptext SLIT("\tld\t[")
1824 pp_rbracket_comma = text "],"
1825 pp_comma_lbracket = text ",["
1826 pp_comma_a = text ",a"
1828 #endif /* sparc_TARGET_ARCH */
1831 -- -----------------------------------------------------------------------------
1832 -- pprInstr for PowerPC
1834 #if powerpc_TARGET_ARCH
1835 pprInstr (LD sz reg addr) = hcat [
1844 case addr of AddrRegImm _ _ -> empty
1845 AddrRegReg _ _ -> char 'x',
1851 pprInstr (LA sz reg addr) = hcat [
1860 case addr of AddrRegImm _ _ -> empty
1861 AddrRegReg _ _ -> char 'x',
1867 pprInstr (ST sz reg addr) = hcat [
1871 case addr of AddrRegImm _ _ -> empty
1872 AddrRegReg _ _ -> char 'x',
1878 pprInstr (STU sz reg addr) = hcat [
1883 case addr of AddrRegImm _ _ -> empty
1884 AddrRegReg _ _ -> char 'x',
1889 pprInstr (LIS reg imm) = hcat [
1897 pprInstr (LI reg imm) = hcat [
1905 pprInstr (MR reg1 reg2)
1906 | reg1 == reg2 = empty
1907 | otherwise = hcat [
1909 case regClass reg1 of
1910 RcInteger -> ptext SLIT("mr")
1911 _ -> ptext SLIT("fmr"),
1917 pprInstr (CMP sz reg ri) = hcat [
1933 pprInstr (CMPL sz reg ri) = hcat [
1949 pprInstr (BCC cond (BlockId id)) = hcat [
1956 where lbl = mkAsmTempLabel id
1958 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
1965 pprInstr (MTCTR reg) = hcat [
1967 ptext SLIT("mtctr"),
1971 pprInstr (BCTR _) = hcat [
1975 pprInstr (BL lbl _) = hcat [
1976 ptext SLIT("\tbl\t"),
1979 pprInstr (BCTRL _) = hcat [
1983 pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
1984 pprInstr (ADDIS reg1 reg2 imm) = hcat [
1986 ptext SLIT("addis"),
1995 pprInstr (ADDC reg1 reg2 reg3) = pprLogic SLIT("addc") reg1 reg2 (RIReg reg3)
1996 pprInstr (ADDE reg1 reg2 reg3) = pprLogic SLIT("adde") reg1 reg2 (RIReg reg3)
1997 pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
1998 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
1999 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
2000 pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
2001 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3)
2003 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
2004 hcat [ ptext SLIT("\tmullwo\t"), pprReg reg1, ptext SLIT(", "),
2005 pprReg reg2, ptext SLIT(", "),
2007 hcat [ ptext SLIT("\tmfxer\t"), pprReg reg1 ],
2008 hcat [ ptext SLIT("\trlwinm\t"), pprReg reg1, ptext SLIT(", "),
2009 pprReg reg1, ptext SLIT(", "),
2010 ptext SLIT("2, 31, 31") ]
2013 -- for some reason, "andi" doesn't exist.
2014 -- we'll use "andi." instead.
2015 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
2017 ptext SLIT("andi."),
2025 pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 ri
2027 pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 ri
2028 pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 ri
2030 pprInstr (XORIS reg1 reg2 imm) = hcat [
2032 ptext SLIT("xoris"),
2041 pprInstr (EXTS sz reg1 reg2) = hcat [
2051 pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2
2052 pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2
2054 pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 (limitShiftRI ri)
2055 pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 (limitShiftRI ri)
2056 pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 (limitShiftRI ri)
2057 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
2058 ptext SLIT("\trlwinm\t"),
2070 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
2071 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
2072 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
2073 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
2074 pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
2076 pprInstr (FCMP reg1 reg2) = hcat [
2078 ptext SLIT("fcmpu\tcr0, "),
2079 -- Note: we're using fcmpu, not fcmpo
2080 -- The difference is with fcmpo, compare with NaN is an invalid operation.
2081 -- We don't handle invalid fp ops, so we don't care
2087 pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
2088 pprInstr (FRSP reg1 reg2) = pprUnary SLIT("frsp") reg1 reg2
2090 pprInstr (CRNOR dst src1 src2) = hcat [
2091 ptext SLIT("\tcrnor\t"),
2099 pprInstr (MFCR reg) = hcat [
2106 pprInstr (MFLR reg) = hcat [
2113 pprInstr (FETCHPC reg) = vcat [
2114 ptext SLIT("\tbcl\t20,31,1f"),
2115 hcat [ ptext SLIT("1:\tmflr\t"), pprReg reg ]
2118 pprInstr _ = panic "pprInstr (ppc)"
2120 pprLogic op reg1 reg2 ri = hcat [
2125 RIImm _ -> char 'i',
2134 pprUnary op reg1 reg2 = hcat [
2143 pprBinaryF op sz reg1 reg2 reg3 = hcat [
2156 pprRI (RIReg r) = pprReg r
2157 pprRI (RIImm r) = pprImm r
2159 pprFSize F64 = empty
2160 pprFSize F32 = char 's'
2162 -- limit immediate argument for shift instruction to range 0..32
2163 -- (yes, the maximum is really 32, not 31)
2164 limitShiftRI :: RI -> RI
2165 limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
2168 #endif /* powerpc_TARGET_ARCH */
2171 -- -----------------------------------------------------------------------------
2172 -- Converting floating-point literals to integrals for printing
2174 #if __GLASGOW_HASKELL__ >= 504
2175 newFloatArray :: (Int,Int) -> ST s (STUArray s Int Float)
2176 newFloatArray = newArray_
2178 newDoubleArray :: (Int,Int) -> ST s (STUArray s Int Double)
2179 newDoubleArray = newArray_
2181 castFloatToCharArray :: STUArray s Int Float -> ST s (STUArray s Int Word8)
2182 castFloatToCharArray = castSTUArray
2184 castDoubleToCharArray :: STUArray s Int Double -> ST s (STUArray s Int Word8)
2185 castDoubleToCharArray = castSTUArray
2187 writeFloatArray :: STUArray s Int Float -> Int -> Float -> ST s ()
2188 writeFloatArray = writeArray
2190 writeDoubleArray :: STUArray s Int Double -> Int -> Double -> ST s ()
2191 writeDoubleArray = writeArray
2193 readCharArray :: STUArray s Int Word8 -> Int -> ST s Char
2194 readCharArray arr i = do
2195 w <- readArray arr i
2196 return $! (chr (fromIntegral w))
2200 castFloatToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
2201 castFloatToCharArray = return
2203 castDoubleToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
2206 castDoubleToCharArray = return
2210 -- floatToBytes and doubleToBytes convert to the host's byte
2211 -- order. Providing that we're not cross-compiling for a
2212 -- target with the opposite endianness, this should work ok
2215 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
2216 -- could they be merged?
2218 floatToBytes :: Float -> [Int]
2221 arr <- newFloatArray ((0::Int),3)
2222 writeFloatArray arr 0 f
2223 arr <- castFloatToCharArray arr
2224 i0 <- readCharArray arr 0
2225 i1 <- readCharArray arr 1
2226 i2 <- readCharArray arr 2
2227 i3 <- readCharArray arr 3
2228 return (map ord [i0,i1,i2,i3])
2231 doubleToBytes :: Double -> [Int]
2234 arr <- newDoubleArray ((0::Int),7)
2235 writeDoubleArray arr 0 d
2236 arr <- castDoubleToCharArray arr
2237 i0 <- readCharArray arr 0
2238 i1 <- readCharArray arr 1
2239 i2 <- readCharArray arr 2
2240 i3 <- readCharArray arr 3
2241 i4 <- readCharArray arr 4
2242 i5 <- readCharArray arr 5
2243 i6 <- readCharArray arr 6
2244 i7 <- readCharArray arr 7
2245 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])