2 % (c) The AQUA Project, Glasgow University, 1996-1998
4 \section[PprMach]{Pretty-printing assembly language}
6 We start with the @pprXXX@s with some cross-platform commonality
7 (e.g., @pprReg@); we conclude with the no-commonality monster,
11 #include "nativeGen/NCG.h"
13 module PprMach ( pprInstr, pprSize, pprUserReg ) where
15 #include "HsVersions.h"
17 import MachRegs -- may differ per-platform
20 import CLabel ( pprCLabel_asm, externallyVisibleCLabel )
21 import CStrings ( charToC )
22 import Maybes ( maybeToBool )
23 import Stix ( CodeSegment(..), StixTree(..) )
24 import Char ( isPrint, isDigit )
32 %************************************************************************
34 \subsection{@pprReg@: print a @Reg@}
36 %************************************************************************
38 For x86, the way we print a register name depends
39 on which bit of it we care about. Yurgh.
41 pprUserReg:: Reg -> SDoc
42 pprUserReg = pprReg IF_ARCH_i386(L,)
45 pprReg :: IF_ARCH_i386(Size ->,) Reg -> SDoc
47 pprReg IF_ARCH_i386(s,) r
49 FixedReg i -> ppr_reg_no IF_ARCH_i386(s,) i
50 MappedReg i -> ppr_reg_no IF_ARCH_i386(s,) i
51 other -> text (show other) -- should only happen when debugging
54 ppr_reg_no :: FAST_REG_NO -> SDoc
57 ILIT( 0) -> SLIT("$0"); ILIT( 1) -> SLIT("$1");
58 ILIT( 2) -> SLIT("$2"); ILIT( 3) -> SLIT("$3");
59 ILIT( 4) -> SLIT("$4"); ILIT( 5) -> SLIT("$5");
60 ILIT( 6) -> SLIT("$6"); ILIT( 7) -> SLIT("$7");
61 ILIT( 8) -> SLIT("$8"); ILIT( 9) -> SLIT("$9");
62 ILIT(10) -> SLIT("$10"); ILIT(11) -> SLIT("$11");
63 ILIT(12) -> SLIT("$12"); ILIT(13) -> SLIT("$13");
64 ILIT(14) -> SLIT("$14"); ILIT(15) -> SLIT("$15");
65 ILIT(16) -> SLIT("$16"); ILIT(17) -> SLIT("$17");
66 ILIT(18) -> SLIT("$18"); ILIT(19) -> SLIT("$19");
67 ILIT(20) -> SLIT("$20"); ILIT(21) -> SLIT("$21");
68 ILIT(22) -> SLIT("$22"); ILIT(23) -> SLIT("$23");
69 ILIT(24) -> SLIT("$24"); ILIT(25) -> SLIT("$25");
70 ILIT(26) -> SLIT("$26"); ILIT(27) -> SLIT("$27");
71 ILIT(28) -> SLIT("$28"); ILIT(29) -> SLIT("$29");
72 ILIT(30) -> SLIT("$30"); ILIT(31) -> SLIT("$31");
73 ILIT(32) -> SLIT("$f0"); ILIT(33) -> SLIT("$f1");
74 ILIT(34) -> SLIT("$f2"); ILIT(35) -> SLIT("$f3");
75 ILIT(36) -> SLIT("$f4"); ILIT(37) -> SLIT("$f5");
76 ILIT(38) -> SLIT("$f6"); ILIT(39) -> SLIT("$f7");
77 ILIT(40) -> SLIT("$f8"); ILIT(41) -> SLIT("$f9");
78 ILIT(42) -> SLIT("$f10"); ILIT(43) -> SLIT("$f11");
79 ILIT(44) -> SLIT("$f12"); ILIT(45) -> SLIT("$f13");
80 ILIT(46) -> SLIT("$f14"); ILIT(47) -> SLIT("$f15");
81 ILIT(48) -> SLIT("$f16"); ILIT(49) -> SLIT("$f17");
82 ILIT(50) -> SLIT("$f18"); ILIT(51) -> SLIT("$f19");
83 ILIT(52) -> SLIT("$f20"); ILIT(53) -> SLIT("$f21");
84 ILIT(54) -> SLIT("$f22"); ILIT(55) -> SLIT("$f23");
85 ILIT(56) -> SLIT("$f24"); ILIT(57) -> SLIT("$f25");
86 ILIT(58) -> SLIT("$f26"); ILIT(59) -> SLIT("$f27");
87 ILIT(60) -> SLIT("$f28"); ILIT(61) -> SLIT("$f29");
88 ILIT(62) -> SLIT("$f30"); ILIT(63) -> SLIT("$f31");
89 _ -> SLIT("very naughty alpha register")
93 ppr_reg_no :: Size -> FAST_REG_NO -> SDoc
94 ppr_reg_no B i = ptext
96 ILIT( 0) -> SLIT("%al"); ILIT( 1) -> SLIT("%bl");
97 ILIT( 2) -> SLIT("%cl"); ILIT( 3) -> SLIT("%dl");
98 _ -> SLIT("very naughty I386 byte register")
101 ppr_reg_no _ i = ptext
103 ILIT( 0) -> SLIT("%eax"); ILIT( 1) -> SLIT("%ebx");
104 ILIT( 2) -> SLIT("%ecx"); ILIT( 3) -> SLIT("%edx");
105 ILIT( 4) -> SLIT("%esi"); ILIT( 5) -> SLIT("%edi");
106 ILIT( 6) -> SLIT("%ebp"); ILIT( 7) -> SLIT("%esp");
107 ILIT( 8) -> SLIT("%fake0"); ILIT( 9) -> SLIT("%fake1");
108 ILIT(10) -> SLIT("%fake2"); ILIT(11) -> SLIT("%fake3");
109 ILIT(12) -> SLIT("%fake4"); ILIT(13) -> SLIT("%fake5");
110 _ -> SLIT("very naughty I386 register")
113 #if sparc_TARGET_ARCH
114 ppr_reg_no :: FAST_REG_NO -> SDoc
117 ILIT( 0) -> SLIT("%g0"); ILIT( 1) -> SLIT("%g1");
118 ILIT( 2) -> SLIT("%g2"); ILIT( 3) -> SLIT("%g3");
119 ILIT( 4) -> SLIT("%g4"); ILIT( 5) -> SLIT("%g5");
120 ILIT( 6) -> SLIT("%g6"); ILIT( 7) -> SLIT("%g7");
121 ILIT( 8) -> SLIT("%o0"); ILIT( 9) -> SLIT("%o1");
122 ILIT(10) -> SLIT("%o2"); ILIT(11) -> SLIT("%o3");
123 ILIT(12) -> SLIT("%o4"); ILIT(13) -> SLIT("%o5");
124 ILIT(14) -> SLIT("%o6"); ILIT(15) -> SLIT("%o7");
125 ILIT(16) -> SLIT("%l0"); ILIT(17) -> SLIT("%l1");
126 ILIT(18) -> SLIT("%l2"); ILIT(19) -> SLIT("%l3");
127 ILIT(20) -> SLIT("%l4"); ILIT(21) -> SLIT("%l5");
128 ILIT(22) -> SLIT("%l6"); ILIT(23) -> SLIT("%l7");
129 ILIT(24) -> SLIT("%i0"); ILIT(25) -> SLIT("%i1");
130 ILIT(26) -> SLIT("%i2"); ILIT(27) -> SLIT("%i3");
131 ILIT(28) -> SLIT("%i4"); ILIT(29) -> SLIT("%i5");
132 ILIT(30) -> SLIT("%i6"); ILIT(31) -> SLIT("%i7");
133 ILIT(32) -> SLIT("%f0"); ILIT(33) -> SLIT("%f1");
134 ILIT(34) -> SLIT("%f2"); ILIT(35) -> SLIT("%f3");
135 ILIT(36) -> SLIT("%f4"); ILIT(37) -> SLIT("%f5");
136 ILIT(38) -> SLIT("%f6"); ILIT(39) -> SLIT("%f7");
137 ILIT(40) -> SLIT("%f8"); ILIT(41) -> SLIT("%f9");
138 ILIT(42) -> SLIT("%f10"); ILIT(43) -> SLIT("%f11");
139 ILIT(44) -> SLIT("%f12"); ILIT(45) -> SLIT("%f13");
140 ILIT(46) -> SLIT("%f14"); ILIT(47) -> SLIT("%f15");
141 ILIT(48) -> SLIT("%f16"); ILIT(49) -> SLIT("%f17");
142 ILIT(50) -> SLIT("%f18"); ILIT(51) -> SLIT("%f19");
143 ILIT(52) -> SLIT("%f20"); ILIT(53) -> SLIT("%f21");
144 ILIT(54) -> SLIT("%f22"); ILIT(55) -> SLIT("%f23");
145 ILIT(56) -> SLIT("%f24"); ILIT(57) -> SLIT("%f25");
146 ILIT(58) -> SLIT("%f26"); ILIT(59) -> SLIT("%f27");
147 ILIT(60) -> SLIT("%f28"); ILIT(61) -> SLIT("%f29");
148 ILIT(62) -> SLIT("%f30"); ILIT(63) -> SLIT("%f31");
149 _ -> SLIT("very naughty sparc register")
154 %************************************************************************
156 \subsection{@pprSize@: print a @Size@}
158 %************************************************************************
161 pprSize :: Size -> SDoc
163 pprSize x = ptext (case x of
164 #if alpha_TARGET_ARCH
167 -- W -> SLIT("w") UNUSED
168 -- WU -> SLIT("wu") UNUSED
169 -- L -> SLIT("l") UNUSED
171 -- FF -> SLIT("f") UNUSED
172 -- DF -> SLIT("d") UNUSED
173 -- GF -> SLIT("g") UNUSED
174 -- SF -> SLIT("s") UNUSED
179 -- HB -> SLIT("b") UNUSED
180 -- S -> SLIT("w") UNUSED
185 #if sparc_TARGET_ARCH
188 -- HW -> SLIT("hw") UNUSED
189 -- HWU -> SLIT("uhw") UNUSED
192 -- D -> SLIT("d") UNUSED
195 pprStSize :: Size -> SDoc
196 pprStSize x = ptext (case x of
199 -- HW -> SLIT("hw") UNUSED
200 -- HWU -> SLIT("uhw") UNUSED
203 -- D -> SLIT("d") UNUSED
209 %************************************************************************
211 \subsection{@pprCond@: print a @Cond@}
213 %************************************************************************
216 pprCond :: Cond -> SDoc
218 pprCond c = ptext (case c of {
219 #if alpha_TARGET_ARCH
230 GEU -> SLIT("ae"); LU -> SLIT("b");
231 EQQ -> SLIT("e"); GTT -> SLIT("g");
232 GE -> SLIT("ge"); GU -> SLIT("a");
233 LTT -> SLIT("l"); LE -> SLIT("le");
234 LEU -> SLIT("be"); NE -> SLIT("ne");
235 NEG -> SLIT("s"); POS -> SLIT("ns");
236 ALWAYS -> SLIT("mp") -- hack
238 #if sparc_TARGET_ARCH
239 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
240 GEU -> SLIT("geu"); LU -> SLIT("lu");
241 EQQ -> SLIT("e"); GTT -> SLIT("g");
242 GE -> SLIT("ge"); GU -> SLIT("gu");
243 LTT -> SLIT("l"); LE -> SLIT("le");
244 LEU -> SLIT("leu"); NE -> SLIT("ne");
245 NEG -> SLIT("neg"); POS -> SLIT("pos");
246 VC -> SLIT("vc"); VS -> SLIT("vs")
251 %************************************************************************
253 \subsection{@pprImm@: print an @Imm@}
255 %************************************************************************
258 pprImm :: Imm -> SDoc
260 pprImm (ImmInt i) = int i
261 pprImm (ImmInteger i) = integer i
262 pprImm (ImmCLbl l) = pprCLabel_asm l
263 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
264 pprImm (ImmLit s) = s
266 pprImm (ImmLab s) | underscorePrefix = (<>) (char '_') s
269 #if sparc_TARGET_ARCH
271 = hcat [ pp_lo, pprImm i, rparen ]
276 = hcat [ pp_hi, pprImm i, rparen ]
282 %************************************************************************
284 \subsection{@pprAddr@: print an @Addr@}
286 %************************************************************************
289 pprAddr :: MachRegsAddr -> SDoc
291 #if alpha_TARGET_ARCH
292 pprAddr (AddrReg r) = parens (pprReg r)
293 pprAddr (AddrImm i) = pprImm i
294 pprAddr (AddrRegImm r1 i)
295 = (<>) (pprImm i) (parens (pprReg r1))
301 pprAddr (ImmAddr imm off)
307 else if (off < 0) then
308 (<>) pp_imm (int off)
310 hcat [pp_imm, char '+', int off]
312 pprAddr (AddrBaseIndex base index displacement)
314 pp_disp = ppr_disp displacement
315 pp_off p = (<>) pp_disp (parens p)
316 pp_reg r = pprReg L r
319 (Nothing, Nothing) -> pp_disp
320 (Just b, Nothing) -> pp_off (pp_reg b)
321 (Nothing, Just (r,i)) -> pp_off (hcat [pp_reg r, comma, int i])
322 (Just b, Just (r,i)) -> pp_off (hcat [pp_reg b, comma, pp_reg r, comma, int i])
324 ppr_disp (ImmInt 0) = empty
325 ppr_disp imm = pprImm imm
330 #if sparc_TARGET_ARCH
331 pprAddr (AddrRegReg r1 (FixedReg ILIT(0))) = pprReg r1
333 pprAddr (AddrRegReg r1 r2)
334 = hcat [ pprReg r1, char '+', pprReg r2 ]
336 pprAddr (AddrRegImm r1 (ImmInt i))
338 | not (fits13Bits i) = largeOffsetError i
339 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
341 pp_sign = if i > 0 then char '+' else empty
343 pprAddr (AddrRegImm r1 (ImmInteger i))
345 | not (fits13Bits i) = largeOffsetError i
346 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
348 pp_sign = if i > 0 then char '+' else empty
350 pprAddr (AddrRegImm r1 imm)
351 = hcat [ pprReg r1, char '+', pprImm imm ]
355 %************************************************************************
357 \subsection{@pprInstr@: print an @Instr@}
359 %************************************************************************
362 pprInstr :: Instr -> SDoc
364 --pprInstr (COMMENT s) = empty -- nuke 'em
366 = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ptext s))
367 ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ptext s))
368 ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ptext s))
371 pprInstr (SEGMENT TextSegment)
372 = IF_ARCH_alpha(ptext SLIT("\t.text\n\t.align 3") {-word boundary-}
373 ,IF_ARCH_sparc(ptext SLIT("\t.text\n\t.align 4") {-word boundary-}
374 ,IF_ARCH_i386((text ".text\n\t.align 4,0x90") {-needs per-OS variation!-}
377 pprInstr (SEGMENT DataSegment)
379 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
380 ,IF_ARCH_sparc(SLIT("\t.data\n\t.align 8") {-<8 will break double constants -}
381 ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
384 pprInstr (LABEL clab)
386 pp_lab = pprCLabel_asm clab
389 if not (externallyVisibleCLabel clab) then
393 IF_ARCH_alpha(SLIT("\t.globl\t")
394 ,IF_ARCH_i386(SLIT(".globl ")
395 ,IF_ARCH_sparc(SLIT("\t.global\t")
397 , pp_lab, char '\n'],
402 pprInstr (ASCII False{-no backslash conversion-} str)
403 = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ]
405 pprInstr (ASCII True str)
406 = (<>) (text "\t.ascii \"") (asciify str 60)
408 asciify :: String -> Int -> SDoc
410 asciify [] _ = text "\\0\""
411 asciify s n | n <= 0 = (<>) (text "\"\n\t.ascii \"") (asciify s 60)
412 asciify ('\\':cs) n = (<>) (text "\\\\") (asciify cs (n-1))
413 asciify ('\"':cs) n = (<>) (text "\\\"") (asciify cs (n-1))
414 asciify (c:cs) n | isPrint c = (<>) (char c) (asciify cs (n-1))
415 asciify [c] _ = (<>) (text (charToC c)) (text ("\\0\"")){-"-}
416 asciify (c:(cs@(d:_))) n
417 | isDigit d = (<>) (text (charToC c)) (asciify cs 0)
418 | otherwise = (<>) (text (charToC c)) (asciify cs (n-1))
422 = vcat [(<>) (ptext pp_size) (pprImm x) | x <- xs]
425 #if alpha_TARGET_ARCH
426 B -> SLIT("\t.byte\t")
427 BU -> SLIT("\t.byte\t")
428 Q -> SLIT("\t.quad\t")
429 TF -> SLIT("\t.t_floating\t")
432 B -> SLIT("\t.byte\t")
433 L -> SLIT("\t.long\t")
434 F -> SLIT("\t.float\t")
435 DF -> SLIT("\t.double\t")
437 #if sparc_TARGET_ARCH
438 B -> SLIT("\t.byte\t")
439 BU -> SLIT("\t.byte\t")
440 W -> SLIT("\t.word\t")
441 DF -> SLIT("\t.double\t")
447 = vcat (concatMap (ppr_item s) xs)
449 #if alpha_TARGET_ARCH
450 ppr_item = error "ppr_item on Alpha"
452 This needs to be fixed.
453 B -> SLIT("\t.byte\t")
454 BU -> SLIT("\t.byte\t")
455 Q -> SLIT("\t.quad\t")
456 TF -> SLIT("\t.t_floating\t")
459 #if sparc_TARGET_ARCH
460 ppr_item = error "ppr_item on Sparc"
462 This needs to be fixed.
463 B -> SLIT("\t.byte\t")
464 BU -> SLIT("\t.byte\t")
465 W -> SLIT("\t.word\t")
466 DF -> SLIT("\t.double\t")
470 ppr_item B x = [text "\t.byte\t" <> pprImm x]
471 ppr_item L x = [text "\t.long\t" <> pprImm x]
472 ppr_item F (ImmDouble r)
473 = let bs = floatToBytes (fromRational r)
474 in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
475 ppr_item DF (ImmDouble r)
476 = let bs = doubleToBytes (fromRational r)
477 in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
479 floatToBytes :: Float -> [Int]
482 arr <- newFloatArray ((0::Int),3)
483 writeFloatArray arr 0 f
484 i0 <- readCharArray arr 0
485 i1 <- readCharArray arr 1
486 i2 <- readCharArray arr 2
487 i3 <- readCharArray arr 3
488 return (map ord [i0,i1,i2,i3])
491 doubleToBytes :: Double -> [Int]
494 arr <- newDoubleArray ((0::Int),7)
495 writeDoubleArray arr 0 d
496 i0 <- readCharArray arr 0
497 i1 <- readCharArray arr 1
498 i2 <- readCharArray arr 2
499 i3 <- readCharArray arr 3
500 i4 <- readCharArray arr 4
501 i5 <- readCharArray arr 5
502 i6 <- readCharArray arr 6
503 i7 <- readCharArray arr 7
504 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])
509 -- fall through to rest of (machine-specific) pprInstr...
512 %************************************************************************
514 \subsubsection{@pprInstr@ for an Alpha}
516 %************************************************************************
519 #if alpha_TARGET_ARCH
521 pprInstr (LD size reg addr)
531 pprInstr (LDA reg addr)
533 ptext SLIT("\tlda\t"),
539 pprInstr (LDAH reg addr)
541 ptext SLIT("\tldah\t"),
547 pprInstr (LDGP reg addr)
549 ptext SLIT("\tldgp\t"),
555 pprInstr (LDI size reg imm)
565 pprInstr (ST size reg addr)
577 ptext SLIT("\tclr\t"),
581 pprInstr (ABS size ri reg)
591 pprInstr (NEG size ov ri reg)
595 if ov then ptext SLIT("v\t") else char '\t',
601 pprInstr (ADD size ov reg1 ri reg2)
605 if ov then ptext SLIT("v\t") else char '\t',
613 pprInstr (SADD size scale reg1 ri reg2)
615 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
626 pprInstr (SUB size ov reg1 ri reg2)
630 if ov then ptext SLIT("v\t") else char '\t',
638 pprInstr (SSUB size scale reg1 ri reg2)
640 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
651 pprInstr (MUL size ov reg1 ri reg2)
655 if ov then ptext SLIT("v\t") else char '\t',
663 pprInstr (DIV size uns reg1 ri reg2)
667 if uns then ptext SLIT("u\t") else char '\t',
675 pprInstr (REM size uns reg1 ri reg2)
679 if uns then ptext SLIT("u\t") else char '\t',
687 pprInstr (NOT ri reg)
696 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
697 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
698 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
699 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
700 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
701 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
703 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
704 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
705 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
707 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
708 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
710 pprInstr (NOP) = ptext SLIT("\tnop")
712 pprInstr (CMP cond reg1 ri reg2)
726 ptext SLIT("\tfclr\t"),
730 pprInstr (FABS reg1 reg2)
732 ptext SLIT("\tfabs\t"),
738 pprInstr (FNEG size reg1 reg2)
748 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
749 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
750 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
751 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
753 pprInstr (CVTxy size1 size2 reg1 reg2)
757 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
764 pprInstr (FCMP size cond reg1 reg2 reg3)
777 pprInstr (FMOV reg1 reg2)
779 ptext SLIT("\tfmov\t"),
785 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
787 pprInstr (BI NEVER reg lab) = empty
789 pprInstr (BI cond reg lab)
799 pprInstr (BF cond reg lab)
810 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
812 pprInstr (JMP reg addr hint)
814 ptext SLIT("\tjmp\t"),
823 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
825 pprInstr (JSR reg addr n)
827 ptext SLIT("\tjsr\t"),
833 pprInstr (FUNBEGIN clab)
835 if (externallyVisibleCLabel clab) then
836 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
839 ptext SLIT("\t.ent "),
848 pp_lab = pprCLabel_asm clab
850 -- NEVER use commas within those string literals, cpp will ruin your day
851 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
852 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
853 ptext SLIT("4240"), char ',',
854 ptext SLIT("$26"), char ',',
855 ptext SLIT("0\n\t.prologue 1") ]
857 pprInstr (FUNEND clab)
858 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
861 Continue with Alpha-only printing bits and bobs:
865 pprRI (RIReg r) = pprReg r
866 pprRI (RIImm r) = pprImm r
868 pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> SDoc
870 pprRegRIReg name reg1 ri reg2
882 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
884 pprSizeRegRegReg name size reg1 reg2 reg3
897 #endif {-alpha_TARGET_ARCH-}
900 %************************************************************************
902 \subsubsection{@pprInstr@ for an I386}
904 %************************************************************************
909 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
913 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
917 pprInstr (MOV size src dst)
918 = pprSizeOpOp SLIT("mov") size src dst
919 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes L src dst
920 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes L src dst
922 -- here we do some patching, since the physical registers are only set late
923 -- in the code generation.
924 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
926 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
927 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
929 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
930 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
932 = pprInstr (ADD size (OpImm displ) dst)
933 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
935 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
936 = pprSizeOp SLIT("dec") size dst
937 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
938 = pprSizeOp SLIT("inc") size dst
939 pprInstr (ADD size src dst)
940 = pprSizeOpOp SLIT("add") size src dst
941 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
942 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
943 pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
945 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
946 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
947 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
948 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
949 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
951 pprInstr (SHL size imm dst) = pprSizeImmOp SLIT("shl") size imm dst
952 pprInstr (SAR size imm dst) = pprSizeImmOp SLIT("sar") size imm dst
953 pprInstr (SHR size imm dst) = pprSizeImmOp SLIT("shr") size imm dst
954 pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src
956 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
957 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
958 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
959 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
960 pprInstr PUSHA = ptext SLIT("\tpushal")
961 pprInstr POPA = ptext SLIT("\tpopal")
963 pprInstr (NOP) = ptext SLIT("\tnop")
964 pprInstr (CLTD) = ptext SLIT("\tcltd")
966 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
968 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
970 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
971 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
973 = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
976 -- Simulating a flat register set on the x86 FP stack is tricky.
977 -- you have to free %st(7) before pushing anything on the FP reg stack
978 -- so as to preclude the possibility of a FP stack overflow exception.
979 pprInstr g@(GMOV src dst)
983 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
985 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
986 pprInstr g@(GLD sz addr dst)
987 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
988 pprAddr addr, gsemi, gpop dst 1])
990 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
991 pprInstr g@(GST sz src addr)
992 = pprG g (hcat [gtab, gpush src 0, gsemi,
993 text "fstp", pprSize sz, gsp, pprAddr addr])
995 pprInstr g@(GFTOD src dst)
997 pprInstr g@(GFTOI src dst)
1000 pprInstr g@(GDTOF src dst)
1002 pprInstr g@(GDTOI src dst)
1005 pprInstr g@(GITOF src dst)
1006 = pprInstr (GITOD src dst)
1007 pprInstr g@(GITOD src dst)
1008 = pprG g (hcat [gtab, text "pushl ", pprReg L src,
1009 text " ; ffree %st(7); fildl (%esp) ; ",
1010 gpop dst 1, text " ; addl $4,%esp"])
1012 pprInstr g@(GCMP sz src1 src2)
1013 = pprG g (hcat [gtab, text "pushl %eax ; ",
1014 gpush src2 0, gsemi, gpush src1 1]
1016 hcat [gtab, text "fcompp ; fstsw %ax ; sahf ; popl %eax"])
1018 pprInstr g@(GABS sz src dst)
1019 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1020 pprInstr g@(GNEG sz src dst)
1021 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1023 pprInstr g@(GSQRT sz src dst)
1024 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1025 hcat [gtab, gcoerceto sz, gpop dst 1])
1026 pprInstr g@(GSIN sz src dst)
1027 = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1028 hcat [gtab, gcoerceto sz, gpop dst 1])
1029 pprInstr g@(GCOS sz src dst)
1030 = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1031 hcat [gtab, gcoerceto sz, gpop dst 1])
1032 pprInstr g@(GTAN sz src dst)
1033 = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1034 gpush src 0, text " ; fptan ; ",
1035 text " fstp %st(0)"] $$
1036 hcat [gtab, gcoerceto sz, gpop dst 1])
1038 pprInstr g@(GADD sz src1 src2 dst)
1039 = pprG g (hcat [gtab, gpush src1 0,
1040 text " ; fadd ", greg src2 1, text ",%st(0)",
1042 pprInstr g@(GSUB sz src1 src2 dst)
1043 = pprG g (hcat [gtab, gpush src1 0,
1044 text " ; fsub ", greg src2 1, text ",%st(0)",
1046 pprInstr g@(GMUL sz src1 src2 dst)
1047 = pprG g (hcat [gtab, gpush src1 0,
1048 text " ; fmul ", greg src2 1, text ",%st(0)",
1050 pprInstr g@(GDIV sz src1 src2 dst)
1051 = pprG g (hcat [gtab, gpush src1 0,
1052 text " ; fdiv ", greg src2 1, text ",%st(0)",
1056 = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1057 ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1060 --------------------------
1062 -- coerce %st(0) to the specified size
1063 gcoerceto DF = empty
1064 gcoerceto F = text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1067 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1069 = hcat [text "fstp ", greg reg offset]
1071 bogus = text "\tbogus"
1072 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1076 gregno (FixedReg i) = I# i
1077 gregno (MappedReg i) = I# i
1078 gregno other = pprPanic "gregno" (text (show other))
1080 pprG :: Instr -> SDoc -> SDoc
1082 = (char '#' <> pprGInstr fake) $$ actual
1084 pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") DF src dst
1085 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1086 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1088 pprGInstr (GFTOD src dst) = pprSizeSizeRegReg SLIT("gftod") F DF src dst
1089 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F L src dst
1091 pprGInstr (GDTOF src dst) = pprSizeSizeRegReg SLIT("gdtof") DF F src dst
1092 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") DF L src dst
1094 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") L F src dst
1095 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") L DF src dst
1097 pprGInstr (GCMP sz src dst) = pprSizeRegReg SLIT("gcmp") sz src dst
1098 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1099 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1100 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1101 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1102 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1103 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1105 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1106 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1107 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1108 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1111 Continue with I386-only printing bits and bobs:
1113 pprDollImm :: Imm -> SDoc
1115 pprDollImm i = hcat [ ptext SLIT("$"), pprImm i]
1117 pprOperand :: Size -> Operand -> SDoc
1118 pprOperand s (OpReg r) = pprReg s r
1119 pprOperand s (OpImm i) = pprDollImm i
1120 pprOperand s (OpAddr ea) = pprAddr ea
1122 pprSizeImmOp :: FAST_STRING -> Size -> Imm -> Operand -> SDoc
1123 pprSizeImmOp name size imm op1
1135 pprSizeOp :: FAST_STRING -> Size -> Operand -> SDoc
1136 pprSizeOp name size op1
1145 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1146 pprSizeOpOp name size op1 op2
1152 pprOperand size op1,
1157 pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1158 pprSizeByteOpOp name size op1 op2
1169 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> SDoc
1170 pprSizeOpReg name size op1 reg
1176 pprOperand size op1,
1181 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
1182 pprSizeRegReg name size reg1 reg2
1193 pprSizeSizeRegReg :: FAST_STRING -> Size -> Size -> Reg -> Reg -> SDoc
1194 pprSizeSizeRegReg name size1 size2 reg1 reg2
1206 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
1207 pprSizeRegRegReg name size reg1 reg2 reg3
1220 pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> SDoc
1221 pprSizeAddr name size op
1230 pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> SDoc
1231 pprSizeAddrReg name size op dst
1242 pprSizeRegAddr :: FAST_STRING -> Size -> Reg -> MachRegsAddr -> SDoc
1243 pprSizeRegAddr name size src op
1254 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1255 pprOpOp name size op1 op2
1259 pprOperand size op1,
1264 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> SDoc
1265 pprSizeOpOpCoerce name size1 size2 op1 op2
1266 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1267 pprOperand size1 op1,
1269 pprOperand size2 op2
1272 pprCondInstr :: FAST_STRING -> Cond -> SDoc -> SDoc
1273 pprCondInstr name cond arg
1274 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1276 #endif {-i386_TARGET_ARCH-}
1279 %************************************************************************
1281 \subsubsection{@pprInstr@ for a SPARC}
1283 %************************************************************************
1286 #if sparc_TARGET_ARCH
1288 -- a clumsy hack for now, to handle possible double alignment problems
1290 -- even clumsier, to allow for RegReg regs that show when doing indexed
1291 -- reads (bytearrays).
1293 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1295 ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1296 pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg, char '\n',
1297 pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)
1300 pprInstr (LD DF addr reg) | maybeToBool off_addr
1314 off_addr = addrOffset addr 4
1315 addr2 = case off_addr of Just x -> x
1317 pprInstr (LD size addr reg)
1328 -- The same clumsy hack as above
1330 pprInstr (ST DF reg (AddrRegReg g1 g2))
1332 ptext SLIT("\tadd\t"),
1333 pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1334 ptext SLIT("\tst\t"),
1335 pprReg reg, pp_comma_lbracket, pprReg g1,
1336 ptext SLIT("]\n\tst\t"),
1337 pprReg (fPair reg), pp_comma_lbracket, pprReg g1, ptext SLIT("+4]")
1340 pprInstr (ST DF reg addr) | maybeToBool off_addr
1342 ptext SLIT("\tst\t"),
1343 pprReg reg, pp_comma_lbracket, pprAddr addr,
1345 ptext SLIT("]\n\tst\t"),
1346 pprReg (fPair reg), pp_comma_lbracket,
1347 pprAddr addr2, rbrack
1350 off_addr = addrOffset addr 4
1351 addr2 = case off_addr of Just x -> x
1353 -- no distinction is made between signed and unsigned bytes on stores for the
1354 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1355 -- so we call a special-purpose pprSize for ST..
1357 pprInstr (ST size reg addr)
1368 pprInstr (ADD x cc reg1 ri reg2)
1369 | not x && not cc && riZero ri
1370 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1372 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1374 pprInstr (SUB x cc reg1 ri reg2)
1375 | not x && cc && reg2 == g0
1376 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1377 | not x && not cc && riZero ri
1378 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1380 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1382 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1383 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1385 pprInstr (OR b reg1 ri reg2)
1386 | not b && reg1 == g0
1387 = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1389 = pprRegRIReg SLIT("or") b reg1 ri reg2
1391 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1393 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1394 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1396 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1397 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1398 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1400 pprInstr (SETHI imm reg)
1402 ptext SLIT("\tsethi\t"),
1408 pprInstr NOP = ptext SLIT("\tnop")
1410 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1411 pprInstr (FABS DF reg1 reg2)
1412 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1413 (if (reg1 == reg2) then empty
1414 else (<>) (char '\n')
1415 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1417 pprInstr (FADD size reg1 reg2 reg3)
1418 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1419 pprInstr (FCMP e size reg1 reg2)
1420 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1421 pprInstr (FDIV size reg1 reg2 reg3)
1422 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1424 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1425 pprInstr (FMOV DF reg1 reg2)
1426 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1427 (if (reg1 == reg2) then empty
1428 else (<>) (char '\n')
1429 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1431 pprInstr (FMUL size reg1 reg2 reg3)
1432 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1434 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1435 pprInstr (FNEG DF reg1 reg2)
1436 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1437 (if (reg1 == reg2) then empty
1438 else (<>) (char '\n')
1439 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1441 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1442 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1443 pprInstr (FxTOy size1 size2 reg1 reg2)
1456 pprReg reg1, comma, pprReg reg2
1460 pprInstr (BI cond b lab)
1462 ptext SLIT("\tb"), pprCond cond,
1463 if b then pp_comma_a else empty,
1468 pprInstr (BF cond b lab)
1470 ptext SLIT("\tfb"), pprCond cond,
1471 if b then pp_comma_a else empty,
1476 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1478 pprInstr (CALL imm n _)
1479 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1482 Continue with SPARC-only printing bits and bobs:
1485 pprRI (RIReg r) = pprReg r
1486 pprRI (RIImm r) = pprImm r
1488 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
1489 pprSizeRegReg name size reg1 reg2
1494 F -> ptext SLIT("s\t")
1495 DF -> ptext SLIT("d\t")),
1501 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
1502 pprSizeRegRegReg name size reg1 reg2 reg3
1507 F -> ptext SLIT("s\t")
1508 DF -> ptext SLIT("d\t")),
1516 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> SDoc
1517 pprRegRIReg name b reg1 ri reg2
1521 if b then ptext SLIT("cc\t") else char '\t',
1529 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> SDoc
1530 pprRIReg name b ri reg1
1534 if b then ptext SLIT("cc\t") else char '\t',
1540 pp_ld_lbracket = ptext SLIT("\tld\t[")
1541 pp_rbracket_comma = text "],"
1542 pp_comma_lbracket = text ",["
1543 pp_comma_a = text ",a"
1545 #endif {-sparc_TARGET_ARCH-}