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, externallyVisibleCLabel, labelDynamic )
21 import Stix ( CodeSegment(..) )
22 import Unique ( pprUnique )
23 import Panic ( panic )
26 import qualified Outputable
28 #if __GLASGOW_HASKELL__ >= 504
30 import Data.Word ( Word8 )
37 import Char ( chr, ord )
38 import Maybe ( isJust )
40 asmSDoc d = Outputable.withPprStyleDoc (
41 Outputable.mkCodeStyle Outputable.AsmStyle) d
42 pprCLabel_asm l = asmSDoc (pprCLabel l)
45 %************************************************************************
47 \subsection{@pprReg@: print a @Reg@}
49 %************************************************************************
51 For x86, the way we print a register name depends
52 on which bit of it we care about. Yurgh.
54 pprUserReg :: Reg -> Doc
55 pprUserReg = pprReg IF_ARCH_i386(L,)
57 pprReg :: IF_ARCH_i386(Size ->,) Reg -> Doc
59 pprReg IF_ARCH_i386(s,) r
61 RealReg i -> ppr_reg_no IF_ARCH_i386(s,) i
62 VirtualRegI u -> text "%vI_" <> asmSDoc (pprVRegUnique u)
63 VirtualRegF u -> text "%vF_" <> asmSDoc (pprVRegUnique u)
66 ppr_reg_no :: Int -> Doc
69 0 -> SLIT("$0"); 1 -> SLIT("$1");
70 2 -> SLIT("$2"); 3 -> SLIT("$3");
71 4 -> SLIT("$4"); 5 -> SLIT("$5");
72 6 -> SLIT("$6"); 7 -> SLIT("$7");
73 8 -> SLIT("$8"); 9 -> SLIT("$9");
74 10 -> SLIT("$10"); 11 -> SLIT("$11");
75 12 -> SLIT("$12"); 13 -> SLIT("$13");
76 14 -> SLIT("$14"); 15 -> SLIT("$15");
77 16 -> SLIT("$16"); 17 -> SLIT("$17");
78 18 -> SLIT("$18"); 19 -> SLIT("$19");
79 20 -> SLIT("$20"); 21 -> SLIT("$21");
80 22 -> SLIT("$22"); 23 -> SLIT("$23");
81 24 -> SLIT("$24"); 25 -> SLIT("$25");
82 26 -> SLIT("$26"); 27 -> SLIT("$27");
83 28 -> SLIT("$28"); 29 -> SLIT("$29");
84 30 -> SLIT("$30"); 31 -> SLIT("$31");
85 32 -> SLIT("$f0"); 33 -> SLIT("$f1");
86 34 -> SLIT("$f2"); 35 -> SLIT("$f3");
87 36 -> SLIT("$f4"); 37 -> SLIT("$f5");
88 38 -> SLIT("$f6"); 39 -> SLIT("$f7");
89 40 -> SLIT("$f8"); 41 -> SLIT("$f9");
90 42 -> SLIT("$f10"); 43 -> SLIT("$f11");
91 44 -> SLIT("$f12"); 45 -> SLIT("$f13");
92 46 -> SLIT("$f14"); 47 -> SLIT("$f15");
93 48 -> SLIT("$f16"); 49 -> SLIT("$f17");
94 50 -> SLIT("$f18"); 51 -> SLIT("$f19");
95 52 -> SLIT("$f20"); 53 -> SLIT("$f21");
96 54 -> SLIT("$f22"); 55 -> SLIT("$f23");
97 56 -> SLIT("$f24"); 57 -> SLIT("$f25");
98 58 -> SLIT("$f26"); 59 -> SLIT("$f27");
99 60 -> SLIT("$f28"); 61 -> SLIT("$f29");
100 62 -> SLIT("$f30"); 63 -> SLIT("$f31");
101 _ -> SLIT("very naughty alpha register")
105 ppr_reg_no :: Size -> Int -> Doc
106 ppr_reg_no B = ppr_reg_byte
107 ppr_reg_no Bu = ppr_reg_byte
108 ppr_reg_no W = ppr_reg_word
109 ppr_reg_no Wu = ppr_reg_word
110 ppr_reg_no _ = ppr_reg_long
112 ppr_reg_byte i = ptext
114 0 -> SLIT("%al"); 1 -> SLIT("%bl");
115 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
116 _ -> SLIT("very naughty I386 byte register")
119 ppr_reg_word i = ptext
121 0 -> SLIT("%ax"); 1 -> SLIT("%bx");
122 2 -> SLIT("%cx"); 3 -> SLIT("%dx");
123 4 -> SLIT("%si"); 5 -> SLIT("%di");
124 6 -> SLIT("%bp"); 7 -> SLIT("%sp");
125 _ -> SLIT("very naughty I386 word register")
128 ppr_reg_long i = ptext
130 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
131 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
132 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
133 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
134 8 -> SLIT("%fake0"); 9 -> SLIT("%fake1");
135 10 -> SLIT("%fake2"); 11 -> SLIT("%fake3");
136 12 -> SLIT("%fake4"); 13 -> SLIT("%fake5");
137 _ -> SLIT("very naughty I386 register")
140 #if sparc_TARGET_ARCH
141 ppr_reg_no :: Int -> Doc
144 0 -> SLIT("%g0"); 1 -> SLIT("%g1");
145 2 -> SLIT("%g2"); 3 -> SLIT("%g3");
146 4 -> SLIT("%g4"); 5 -> SLIT("%g5");
147 6 -> SLIT("%g6"); 7 -> SLIT("%g7");
148 8 -> SLIT("%o0"); 9 -> SLIT("%o1");
149 10 -> SLIT("%o2"); 11 -> SLIT("%o3");
150 12 -> SLIT("%o4"); 13 -> SLIT("%o5");
151 14 -> SLIT("%o6"); 15 -> SLIT("%o7");
152 16 -> SLIT("%l0"); 17 -> SLIT("%l1");
153 18 -> SLIT("%l2"); 19 -> SLIT("%l3");
154 20 -> SLIT("%l4"); 21 -> SLIT("%l5");
155 22 -> SLIT("%l6"); 23 -> SLIT("%l7");
156 24 -> SLIT("%i0"); 25 -> SLIT("%i1");
157 26 -> SLIT("%i2"); 27 -> SLIT("%i3");
158 28 -> SLIT("%i4"); 29 -> SLIT("%i5");
159 30 -> SLIT("%i6"); 31 -> SLIT("%i7");
160 32 -> SLIT("%f0"); 33 -> SLIT("%f1");
161 34 -> SLIT("%f2"); 35 -> SLIT("%f3");
162 36 -> SLIT("%f4"); 37 -> SLIT("%f5");
163 38 -> SLIT("%f6"); 39 -> SLIT("%f7");
164 40 -> SLIT("%f8"); 41 -> SLIT("%f9");
165 42 -> SLIT("%f10"); 43 -> SLIT("%f11");
166 44 -> SLIT("%f12"); 45 -> SLIT("%f13");
167 46 -> SLIT("%f14"); 47 -> SLIT("%f15");
168 48 -> SLIT("%f16"); 49 -> SLIT("%f17");
169 50 -> SLIT("%f18"); 51 -> SLIT("%f19");
170 52 -> SLIT("%f20"); 53 -> SLIT("%f21");
171 54 -> SLIT("%f22"); 55 -> SLIT("%f23");
172 56 -> SLIT("%f24"); 57 -> SLIT("%f25");
173 58 -> SLIT("%f26"); 59 -> SLIT("%f27");
174 60 -> SLIT("%f28"); 61 -> SLIT("%f29");
175 62 -> SLIT("%f30"); 63 -> SLIT("%f31");
176 _ -> SLIT("very naughty sparc register")
181 %************************************************************************
183 \subsection{@pprSize@: print a @Size@}
185 %************************************************************************
188 pprSize :: Size -> Doc
190 pprSize x = ptext (case x of
191 #if alpha_TARGET_ARCH
194 -- W -> SLIT("w") UNUSED
195 -- Wu -> SLIT("wu") UNUSED
198 -- FF -> SLIT("f") UNUSED
199 -- DF -> SLIT("d") UNUSED
200 -- GF -> SLIT("g") UNUSED
201 -- SF -> SLIT("s") UNUSED
215 #if sparc_TARGET_ARCH
224 pprStSize :: Size -> Doc
225 pprStSize x = ptext (case x of
237 %************************************************************************
239 \subsection{@pprCond@: print a @Cond@}
241 %************************************************************************
244 pprCond :: Cond -> Doc
246 pprCond c = ptext (case c of {
247 #if alpha_TARGET_ARCH
258 GEU -> SLIT("ae"); LU -> SLIT("b");
259 EQQ -> SLIT("e"); GTT -> SLIT("g");
260 GE -> SLIT("ge"); GU -> SLIT("a");
261 LTT -> SLIT("l"); LE -> SLIT("le");
262 LEU -> SLIT("be"); NE -> SLIT("ne");
263 NEG -> SLIT("s"); POS -> SLIT("ns");
264 CARRY -> SLIT("c"); OFLO -> SLIT("o");
265 ALWAYS -> SLIT("mp") -- hack
267 #if sparc_TARGET_ARCH
268 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
269 GEU -> SLIT("geu"); LU -> SLIT("lu");
270 EQQ -> SLIT("e"); GTT -> SLIT("g");
271 GE -> SLIT("ge"); GU -> SLIT("gu");
272 LTT -> SLIT("l"); LE -> SLIT("le");
273 LEU -> SLIT("leu"); NE -> SLIT("ne");
274 NEG -> SLIT("neg"); POS -> SLIT("pos");
275 VC -> SLIT("vc"); VS -> SLIT("vs")
280 %************************************************************************
282 \subsection{@pprImm@: print an @Imm@}
284 %************************************************************************
289 pprImm (ImmInt i) = int i
290 pprImm (ImmInteger i) = integer i
291 pprImm (ImmCLbl l) = (if labelDynamic l then text "__imp_" else empty)
293 pprImm (ImmIndex l i) = (if labelDynamic l then text "__imp_" else empty)
294 <> pprCLabel_asm l <> char '+' <> int i
295 pprImm (ImmLit s) = s
297 pprImm (ImmLab dll s) = (if underscorePrefix then char '_' else empty)
298 <> (if dll then text "_imp__" else empty)
301 #if sparc_TARGET_ARCH
303 = hcat [ pp_lo, pprImm i, rparen ]
308 = hcat [ pp_hi, pprImm i, rparen ]
314 %************************************************************************
316 \subsection{@pprAddr@: print an @Addr@}
318 %************************************************************************
321 pprAddr :: MachRegsAddr -> Doc
323 #if alpha_TARGET_ARCH
324 pprAddr (AddrReg r) = parens (pprReg r)
325 pprAddr (AddrImm i) = pprImm i
326 pprAddr (AddrRegImm r1 i)
327 = (<>) (pprImm i) (parens (pprReg r1))
333 pprAddr (ImmAddr imm off)
334 = let pp_imm = pprImm imm
338 else if (off < 0) then
341 pp_imm <> char '+' <> int off
343 pprAddr (AddrBaseIndex base index displacement)
345 pp_disp = ppr_disp displacement
346 pp_off p = pp_disp <> char '(' <> p <> char ')'
347 pp_reg r = pprReg L r
350 (Nothing, Nothing) -> pp_disp
351 (Just b, Nothing) -> pp_off (pp_reg b)
352 (Nothing, Just (r,i)) -> pp_off (pp_reg r <> comma <> int i)
353 (Just b, Just (r,i)) -> pp_off (pp_reg b <> comma <> pp_reg r
356 ppr_disp (ImmInt 0) = empty
357 ppr_disp imm = pprImm imm
362 #if sparc_TARGET_ARCH
363 pprAddr (AddrRegReg r1 (RealReg 0)) = pprReg r1
365 pprAddr (AddrRegReg r1 r2)
366 = hcat [ pprReg r1, char '+', pprReg r2 ]
368 pprAddr (AddrRegImm r1 (ImmInt i))
370 | not (fits13Bits i) = largeOffsetError i
371 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
373 pp_sign = if i > 0 then char '+' else empty
375 pprAddr (AddrRegImm r1 (ImmInteger i))
377 | not (fits13Bits i) = largeOffsetError i
378 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
380 pp_sign = if i > 0 then char '+' else empty
382 pprAddr (AddrRegImm r1 imm)
383 = hcat [ pprReg r1, char '+', pprImm imm ]
387 %************************************************************************
389 \subsection{@pprInstr@: print an @Instr@}
391 %************************************************************************
394 pprInstr :: Instr -> Doc
396 --pprInstr (COMMENT s) = empty -- nuke 'em
398 = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
399 ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ftext s))
400 ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ftext s))
404 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
406 pprInstr (SEGMENT TextSegment)
407 = IF_ARCH_alpha(ptext SLIT("\t.text\n\t.align 3") {-word boundary-}
408 ,IF_ARCH_sparc(ptext SLIT(".text\n\t.align 4") {-word boundary-}
409 ,IF_ARCH_i386((text ".text\n\t.align 4,0x90") {-needs per-OS variation!-}
412 pprInstr (SEGMENT DataSegment)
414 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
415 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
416 ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
419 pprInstr (SEGMENT RoDataSegment)
421 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
422 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
423 ,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 4")
426 pprInstr (LABEL clab)
428 pp_lab = pprCLabel_asm clab
431 if not (externallyVisibleCLabel clab) then
435 IF_ARCH_alpha(SLIT("\t.globl\t")
436 ,IF_ARCH_i386(SLIT(".globl ")
437 ,IF_ARCH_sparc(SLIT(".global\t")
439 , pp_lab, char '\n'],
444 pprInstr (ASCII False{-no backslash conversion-} str)
445 = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ]
447 pprInstr (ASCII True str)
448 = vcat (map do1 (str ++ [chr 0]))
451 do1 c = ptext SLIT("\t.byte\t0x") <> hshow (ord c)
454 hshow n | n >= 0 && n <= 255
455 = char (tab !! (n `div` 16)) <> char (tab !! (n `mod` 16))
456 tab = "0123456789ABCDEF"
460 = vcat (concatMap (ppr_item s) xs)
463 #if alpha_TARGET_ARCH
464 ppr_item = error "ppr_item on Alpha"
466 #if sparc_TARGET_ARCH
467 -- copy n paste of x86 version
468 ppr_item B x = [ptext SLIT("\t.byte\t") <> pprImm x]
469 ppr_item W x = [ptext SLIT("\t.long\t") <> pprImm x]
470 ppr_item F (ImmFloat r)
471 = let bs = floatToBytes (fromRational r)
472 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
473 ppr_item DF (ImmDouble r)
474 = let bs = doubleToBytes (fromRational r)
475 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
478 ppr_item B x = [ptext SLIT("\t.byte\t") <> pprImm x]
479 ppr_item L x = [ptext SLIT("\t.long\t") <> pprImm x]
480 ppr_item F (ImmFloat r)
481 = let bs = floatToBytes (fromRational r)
482 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
483 ppr_item DF (ImmDouble r)
484 = let bs = doubleToBytes (fromRational r)
485 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
488 -- fall through to rest of (machine-specific) pprInstr...
491 %************************************************************************
493 \subsubsection{@pprInstr@ for an Alpha}
495 %************************************************************************
498 #if alpha_TARGET_ARCH
500 pprInstr (LD size reg addr)
510 pprInstr (LDA reg addr)
512 ptext SLIT("\tlda\t"),
518 pprInstr (LDAH reg addr)
520 ptext SLIT("\tldah\t"),
526 pprInstr (LDGP reg addr)
528 ptext SLIT("\tldgp\t"),
534 pprInstr (LDI size reg imm)
544 pprInstr (ST size reg addr)
556 ptext SLIT("\tclr\t"),
560 pprInstr (ABS size ri reg)
570 pprInstr (NEG size ov ri reg)
574 if ov then ptext SLIT("v\t") else char '\t',
580 pprInstr (ADD size ov reg1 ri reg2)
584 if ov then ptext SLIT("v\t") else char '\t',
592 pprInstr (SADD size scale reg1 ri reg2)
594 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
605 pprInstr (SUB size ov reg1 ri reg2)
609 if ov then ptext SLIT("v\t") else char '\t',
617 pprInstr (SSUB size scale reg1 ri reg2)
619 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
630 pprInstr (MUL size ov reg1 ri reg2)
634 if ov then ptext SLIT("v\t") else char '\t',
642 pprInstr (DIV size uns reg1 ri reg2)
646 if uns then ptext SLIT("u\t") else char '\t',
654 pprInstr (REM size uns reg1 ri reg2)
658 if uns then ptext SLIT("u\t") else char '\t',
666 pprInstr (NOT ri reg)
675 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
676 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
677 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
678 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
679 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
680 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
682 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
683 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
684 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
686 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
687 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
689 pprInstr (NOP) = ptext SLIT("\tnop")
691 pprInstr (CMP cond reg1 ri reg2)
705 ptext SLIT("\tfclr\t"),
709 pprInstr (FABS reg1 reg2)
711 ptext SLIT("\tfabs\t"),
717 pprInstr (FNEG size reg1 reg2)
727 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
728 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
729 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
730 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
732 pprInstr (CVTxy size1 size2 reg1 reg2)
736 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
743 pprInstr (FCMP size cond reg1 reg2 reg3)
756 pprInstr (FMOV reg1 reg2)
758 ptext SLIT("\tfmov\t"),
764 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
766 pprInstr (BI NEVER reg lab) = empty
768 pprInstr (BI cond reg lab)
778 pprInstr (BF cond reg lab)
789 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
791 pprInstr (JMP reg addr hint)
793 ptext SLIT("\tjmp\t"),
802 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
804 pprInstr (JSR reg addr n)
806 ptext SLIT("\tjsr\t"),
812 pprInstr (FUNBEGIN clab)
814 if (externallyVisibleCLabel clab) then
815 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
818 ptext SLIT("\t.ent "),
827 pp_lab = pprCLabel_asm clab
829 -- NEVER use commas within those string literals, cpp will ruin your day
830 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
831 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
832 ptext SLIT("4240"), char ',',
833 ptext SLIT("$26"), char ',',
834 ptext SLIT("0\n\t.prologue 1") ]
836 pprInstr (FUNEND clab)
837 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
840 Continue with Alpha-only printing bits and bobs:
844 pprRI (RIReg r) = pprReg r
845 pprRI (RIImm r) = pprImm r
847 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
848 pprRegRIReg name reg1 ri reg2
860 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
861 pprSizeRegRegReg name size reg1 reg2 reg3
874 #endif {-alpha_TARGET_ARCH-}
877 %************************************************************************
879 \subsubsection{@pprInstr@ for an I386}
881 %************************************************************************
886 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
889 #if 0 /* #ifdef DEBUG */
890 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
894 pprInstr (MOV size src dst)
895 = pprSizeOpOp SLIT("mov") size src dst
896 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes L src dst
897 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes L src dst
899 -- here we do some patching, since the physical registers are only set late
900 -- in the code generation.
901 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
903 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
904 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
906 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
907 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
909 = pprInstr (ADD size (OpImm displ) dst)
910 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
912 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
913 = pprSizeOp SLIT("dec") size dst
914 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
915 = pprSizeOp SLIT("inc") size dst
916 pprInstr (ADD size src dst)
917 = pprSizeOpOp SLIT("add") size src dst
918 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
919 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
921 {- A hack. The Intel documentation says that "The two and three
922 operand forms [of IMUL] may also be used with unsigned operands
923 because the lower half of the product is the same regardless if
924 (sic) the operands are signed or unsigned. The CF and OF flags,
925 however, cannot be used to determine if the upper half of the
926 result is non-zero." So there.
928 pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
930 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
931 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
932 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
933 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
934 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
936 pprInstr (SHL size imm dst) = pprSizeImmOp SLIT("shl") size imm dst
937 pprInstr (SAR size imm dst) = pprSizeImmOp SLIT("sar") size imm dst
938 pprInstr (SHR size imm dst) = pprSizeImmOp SLIT("shr") size imm dst
939 pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src
941 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
942 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
943 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
944 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
945 pprInstr PUSHA = ptext SLIT("\tpushal")
946 pprInstr POPA = ptext SLIT("\tpopal")
948 pprInstr NOP = ptext SLIT("\tnop")
949 pprInstr CLTD = ptext SLIT("\tcltd")
951 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
953 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
955 pprInstr (JMP dsts (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
956 pprInstr (JMP dsts op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
957 pprInstr (CALL (Left imm)) = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
958 pprInstr (CALL (Right reg)) = (<>) (ptext SLIT("\tcall *")) (pprReg L reg)
960 -- First bool indicates signedness; second whether quot or rem
961 pprInstr (IQUOT sz src dst) = pprInstr_quotRem True True sz src dst
962 pprInstr (IREM sz src dst) = pprInstr_quotRem True False sz src dst
964 pprInstr (QUOT sz src dst) = pprInstr_quotRem False True sz src dst
965 pprInstr (REM sz src dst) = pprInstr_quotRem False False sz src dst
967 pprInstr (IMUL64 sd_hi sd_lo) = pprInstr_imul64 sd_hi sd_lo
970 -- Simulating a flat register set on the x86 FP stack is tricky.
971 -- you have to free %st(7) before pushing anything on the FP reg stack
972 -- so as to preclude the possibility of a FP stack overflow exception.
973 pprInstr g@(GMOV src dst)
977 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
979 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
980 pprInstr g@(GLD sz addr dst)
981 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
982 pprAddr addr, gsemi, gpop dst 1])
984 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
985 pprInstr g@(GST sz src addr)
986 = pprG g (hcat [gtab, gpush src 0, gsemi,
987 text "fstp", pprSize sz, gsp, pprAddr addr])
989 pprInstr g@(GLDZ dst)
990 = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
991 pprInstr g@(GLD1 dst)
992 = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
994 pprInstr g@(GFTOI src dst)
995 = pprInstr (GDTOI src dst)
996 pprInstr g@(GDTOI src dst)
997 = pprG g (hcat [gtab, text "subl $4, %esp ; ",
998 gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ",
1001 pprInstr g@(GITOF src dst)
1002 = pprInstr (GITOD src dst)
1003 pprInstr g@(GITOD src dst)
1004 = pprG g (hcat [gtab, text "pushl ", pprReg L src,
1005 text " ; ffree %st(7); fildl (%esp) ; ",
1006 gpop dst 1, text " ; addl $4,%esp"])
1008 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
1009 this far into the jungle AND you give a Rat's Ass (tm) what's going
1010 on, here's the deal. Generate code to do a floating point comparison
1011 of src1 and src2, of kind cond, and set the Zero flag if true.
1013 The complications are to do with handling NaNs correctly. We want the
1014 property that if either argument is NaN, then the result of the
1015 comparison is False ... except if we're comparing for inequality,
1016 in which case the answer is True.
1018 Here's how the general (non-inequality) case works. As an
1019 example, consider generating the an equality test:
1021 pushl %eax -- we need to mess with this
1022 <get src1 to top of FPU stack>
1023 fcomp <src2 location in FPU stack> and pop pushed src1
1024 -- Result of comparison is in FPU Status Register bits
1026 fstsw %ax -- Move FPU Status Reg to %ax
1027 sahf -- move C3 C2 C0 from %ax to integer flag reg
1028 -- now the serious magic begins
1029 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
1030 sete %al -- %al = if arg1 == arg2 then 1 else 0
1031 andb %ah,%al -- %al &= %ah
1032 -- so %al == 1 iff (comparable && same); else it holds 0
1033 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
1034 else %al == 0xFF, ZeroFlag=0
1035 -- the zero flag is now set as we desire.
1038 The special case of inequality differs thusly:
1040 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
1041 setne %al -- %al = if arg1 /= arg2 then 1 else 0
1042 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
1043 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
1044 else (%al == 0xFF, ZF=0)
1046 pprInstr g@(GCMP cond src1 src2)
1047 | case cond of { NE -> True; other -> False }
1049 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1050 hcat [gtab, text "fcomp ", greg src2 1,
1051 text "; fstsw %ax ; sahf ; setpe %ah"],
1052 hcat [gtab, text "setne %al ; ",
1053 text "orb %ah,%al ; decb %al ; popl %eax"]
1057 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1058 hcat [gtab, text "fcomp ", greg src2 1,
1059 text "; fstsw %ax ; sahf ; setpo %ah"],
1060 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
1061 text "andb %ah,%al ; decb %al ; popl %eax"]
1064 {- On the 486, the flags set by FP compare are the unsigned ones!
1065 (This looks like a HACK to me. WDP 96/03)
1067 fix_FP_cond :: Cond -> Cond
1068 fix_FP_cond GE = GEU
1069 fix_FP_cond GTT = GU
1070 fix_FP_cond LTT = LU
1071 fix_FP_cond LE = LEU
1072 fix_FP_cond EQQ = EQQ
1074 -- there should be no others
1077 pprInstr g@(GABS sz src dst)
1078 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1079 pprInstr g@(GNEG sz src dst)
1080 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1082 pprInstr g@(GSQRT sz src dst)
1083 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1084 hcat [gtab, gcoerceto sz, gpop dst 1])
1085 pprInstr g@(GSIN sz src dst)
1086 = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1087 hcat [gtab, gcoerceto sz, gpop dst 1])
1088 pprInstr g@(GCOS sz src dst)
1089 = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1090 hcat [gtab, gcoerceto sz, gpop dst 1])
1091 pprInstr g@(GTAN sz src dst)
1092 = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1093 gpush src 0, text " ; fptan ; ",
1094 text " fstp %st(0)"] $$
1095 hcat [gtab, gcoerceto sz, gpop dst 1])
1097 -- In the translations for GADD, GMUL, GSUB and GDIV,
1098 -- the first two cases are mere optimisations. The otherwise clause
1099 -- generates correct code under all circumstances.
1101 pprInstr g@(GADD sz src1 src2 dst)
1103 = pprG g (text "\t#GADD-xxxcase1" $$
1104 hcat [gtab, gpush src2 0,
1105 text " ; faddp %st(0),", greg src1 1])
1107 = pprG g (text "\t#GADD-xxxcase2" $$
1108 hcat [gtab, gpush src1 0,
1109 text " ; faddp %st(0),", greg src2 1])
1111 = pprG g (hcat [gtab, gpush src1 0,
1112 text " ; fadd ", greg src2 1, text ",%st(0)",
1116 pprInstr g@(GMUL sz src1 src2 dst)
1118 = pprG g (text "\t#GMUL-xxxcase1" $$
1119 hcat [gtab, gpush src2 0,
1120 text " ; fmulp %st(0),", greg src1 1])
1122 = pprG g (text "\t#GMUL-xxxcase2" $$
1123 hcat [gtab, gpush src1 0,
1124 text " ; fmulp %st(0),", greg src2 1])
1126 = pprG g (hcat [gtab, gpush src1 0,
1127 text " ; fmul ", greg src2 1, text ",%st(0)",
1131 pprInstr g@(GSUB sz src1 src2 dst)
1133 = pprG g (text "\t#GSUB-xxxcase1" $$
1134 hcat [gtab, gpush src2 0,
1135 text " ; fsubrp %st(0),", greg src1 1])
1137 = pprG g (text "\t#GSUB-xxxcase2" $$
1138 hcat [gtab, gpush src1 0,
1139 text " ; fsubp %st(0),", greg src2 1])
1141 = pprG g (hcat [gtab, gpush src1 0,
1142 text " ; fsub ", greg src2 1, text ",%st(0)",
1146 pprInstr g@(GDIV sz src1 src2 dst)
1148 = pprG g (text "\t#GDIV-xxxcase1" $$
1149 hcat [gtab, gpush src2 0,
1150 text " ; fdivrp %st(0),", greg src1 1])
1152 = pprG g (text "\t#GDIV-xxxcase2" $$
1153 hcat [gtab, gpush src1 0,
1154 text " ; fdivp %st(0),", greg src2 1])
1156 = pprG g (hcat [gtab, gpush src1 0,
1157 text " ; fdiv ", greg src2 1, text ",%st(0)",
1162 = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1163 ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1167 pprInstr_quotRem signed isQuot sz src dst
1168 | case sz of L -> False; _ -> True
1169 = panic "pprInstr_quotRem: dunno how to do non-32bit operands"
1172 (text "\t# BEGIN " <> fakeInsn),
1173 (text "\tpushl $0; pushl %eax; pushl %edx; pushl " <> pprOperand sz src),
1174 (text "\tmovl " <> pprOperand sz dst <> text ",%eax; " <> widen_to_64),
1175 (x86op <> text " 0(%esp); movl " <> text resReg <> text ",12(%esp)"),
1176 (text "\tpopl %edx; popl %edx; popl %eax; popl " <> pprOperand sz dst),
1177 (text "\t# END " <> fakeInsn)
1180 widen_to_64 | signed = text "cltd"
1181 | not signed = text "xorl %edx,%edx"
1182 x86op = if signed then text "\tidivl" else text "\tdivl"
1183 resReg = if isQuot then "%eax" else "%edx"
1184 opStr | signed = if isQuot then "IQUOT" else "IREM"
1185 | not signed = if isQuot then "QUOT" else "REM"
1186 fakeInsn = text opStr <+> pprOperand sz src
1187 <> char ',' <+> pprOperand sz dst
1189 -- Emit code to make hi_reg:lo_reg be the 64-bit product of hi_reg and lo_reg
1190 pprInstr_imul64 hi_reg lo_reg
1191 = let fakeInsn = text "imul64" <+> pp_hi_reg <> comma <+> pp_lo_reg
1192 pp_hi_reg = pprReg L hi_reg
1193 pp_lo_reg = pprReg L lo_reg
1196 text "\t# BEGIN " <> fakeInsn,
1197 text "\tpushl" <+> pp_hi_reg <> text" ; pushl" <+> pp_lo_reg,
1198 text "\tpushl %eax ; pushl %edx",
1199 text "\tmovl 12(%esp), %eax ; imull 8(%esp)",
1200 text "\tmovl %edx, 12(%esp) ; movl %eax, 8(%esp)",
1201 text "\tpopl %edx ; popl %eax",
1202 text "\tpopl" <+> pp_lo_reg <> text " ; popl" <+> pp_hi_reg,
1203 text "\t# END " <> fakeInsn
1207 --------------------------
1209 -- coerce %st(0) to the specified size
1210 gcoerceto DF = empty
1211 gcoerceto F = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1214 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1216 = hcat [text "fstp ", greg reg offset]
1218 bogus = text "\tbogus"
1219 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1224 gregno (RealReg i) = i
1225 gregno other = --pprPanic "gregno" (ppr other)
1226 999 -- bogus; only needed for debug printing
1228 pprG :: Instr -> Doc -> Doc
1230 = (char '#' <> pprGInstr fake) $$ actual
1232 pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") DF src dst
1233 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1234 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1236 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") DF dst
1237 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") DF dst
1239 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F L src dst
1240 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") DF L src dst
1242 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") L F src dst
1243 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") L DF src dst
1245 pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") DF co src dst
1246 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1247 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1248 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1249 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1250 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1251 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1253 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1254 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1255 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1256 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1259 Continue with I386-only printing bits and bobs:
1261 pprDollImm :: Imm -> Doc
1263 pprDollImm i = ptext SLIT("$") <> pprImm i
1265 pprOperand :: Size -> Operand -> Doc
1266 pprOperand s (OpReg r) = pprReg s r
1267 pprOperand s (OpImm i) = pprDollImm i
1268 pprOperand s (OpAddr ea) = pprAddr ea
1270 pprSizeImmOp :: LitString -> Size -> Imm -> Operand -> Doc
1271 pprSizeImmOp name size imm op1
1283 pprSizeOp :: LitString -> Size -> Operand -> Doc
1284 pprSizeOp name size op1
1293 pprSizeOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1294 pprSizeOpOp name size op1 op2
1300 pprOperand size op1,
1305 pprSizeByteOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1306 pprSizeByteOpOp name size op1 op2
1317 pprSizeOpReg :: LitString -> Size -> Operand -> Reg -> Doc
1318 pprSizeOpReg name size op1 reg
1324 pprOperand size op1,
1329 pprSizeReg :: LitString -> Size -> Reg -> Doc
1330 pprSizeReg name size reg1
1339 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
1340 pprSizeRegReg name size reg1 reg2
1351 pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> Doc
1352 pprCondRegReg name size cond reg1 reg2
1363 pprSizeSizeRegReg :: LitString -> Size -> Size -> Reg -> Reg -> Doc
1364 pprSizeSizeRegReg name size1 size2 reg1 reg2
1377 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1378 pprSizeRegRegReg name size reg1 reg2 reg3
1391 pprSizeAddr :: LitString -> Size -> MachRegsAddr -> Doc
1392 pprSizeAddr name size op
1401 pprSizeAddrReg :: LitString -> Size -> MachRegsAddr -> Reg -> Doc
1402 pprSizeAddrReg name size op dst
1413 pprSizeRegAddr :: LitString -> Size -> Reg -> MachRegsAddr -> Doc
1414 pprSizeRegAddr name size src op
1425 pprOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1426 pprOpOp name size op1 op2
1430 pprOperand size op1,
1435 pprSizeOpOpCoerce :: LitString -> Size -> Size -> Operand -> Operand -> Doc
1436 pprSizeOpOpCoerce name size1 size2 op1 op2
1437 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1438 pprOperand size1 op1,
1440 pprOperand size2 op2
1443 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1444 pprCondInstr name cond arg
1445 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1447 #endif {-i386_TARGET_ARCH-}
1450 %************************************************************************
1452 \subsubsection{@pprInstr@ for a SPARC}
1454 %************************************************************************
1457 #if sparc_TARGET_ARCH
1459 -- a clumsy hack for now, to handle possible double alignment problems
1461 -- even clumsier, to allow for RegReg regs that show when doing indexed
1462 -- reads (bytearrays).
1465 -- Translate to the following:
1468 -- ld [g1+4],%f(n+1)
1469 -- sub g1,g2,g1 -- to restore g1
1470 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1472 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1473 hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1474 hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1475 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1480 -- ld [addr+4],%f(n+1)
1481 pprInstr (LD DF addr reg) | isJust off_addr
1483 hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1484 hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1487 off_addr = addrOffset addr 4
1488 addr2 = case off_addr of Just x -> x
1491 pprInstr (LD size addr reg)
1502 -- The same clumsy hack as above
1504 -- Translate to the following:
1507 -- st %f(n+1),[g1+4]
1508 -- sub g1,g2,g1 -- to restore g1
1509 pprInstr (ST DF reg (AddrRegReg g1 g2))
1511 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1512 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1514 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1515 pprReg g1, ptext SLIT("+4]")],
1516 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1521 -- st %f(n+1),[addr+4]
1522 pprInstr (ST DF reg addr) | isJust off_addr
1524 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1525 pprAddr addr, rbrack],
1526 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1527 pprAddr addr2, rbrack]
1530 off_addr = addrOffset addr 4
1531 addr2 = case off_addr of Just x -> x
1533 -- no distinction is made between signed and unsigned bytes on stores for the
1534 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1535 -- so we call a special-purpose pprSize for ST..
1537 pprInstr (ST size reg addr)
1548 pprInstr (ADD x cc reg1 ri reg2)
1549 | not x && not cc && riZero ri
1550 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1552 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1554 pprInstr (SUB x cc reg1 ri reg2)
1555 | not x && cc && reg2 == g0
1556 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1557 | not x && not cc && riZero ri
1558 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1560 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1562 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1563 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1565 pprInstr (OR b reg1 ri reg2)
1566 | not b && reg1 == g0
1567 = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1569 RIReg rrr | rrr == reg2 -> empty
1572 = pprRegRIReg SLIT("or") b reg1 ri reg2
1574 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1576 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1577 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1579 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1580 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1581 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1583 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1584 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul") b reg1 ri reg2
1585 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul") b reg1 ri reg2
1587 pprInstr (SETHI imm reg)
1589 ptext SLIT("\tsethi\t"),
1595 pprInstr NOP = ptext SLIT("\tnop")
1597 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1598 pprInstr (FABS DF reg1 reg2)
1599 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1600 (if (reg1 == reg2) then empty
1601 else (<>) (char '\n')
1602 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1604 pprInstr (FADD size reg1 reg2 reg3)
1605 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1606 pprInstr (FCMP e size reg1 reg2)
1607 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1608 pprInstr (FDIV size reg1 reg2 reg3)
1609 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1611 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1612 pprInstr (FMOV DF reg1 reg2)
1613 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1614 (if (reg1 == reg2) then empty
1615 else (<>) (char '\n')
1616 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1618 pprInstr (FMUL size reg1 reg2 reg3)
1619 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1621 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1622 pprInstr (FNEG DF reg1 reg2)
1623 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1624 (if (reg1 == reg2) then empty
1625 else (<>) (char '\n')
1626 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1628 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1629 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1630 pprInstr (FxTOy size1 size2 reg1 reg2)
1643 pprReg reg1, comma, pprReg reg2
1647 pprInstr (BI cond b lab)
1649 ptext SLIT("\tb"), pprCond cond,
1650 if b then pp_comma_a else empty,
1655 pprInstr (BF cond b lab)
1657 ptext SLIT("\tfb"), pprCond cond,
1658 if b then pp_comma_a else empty,
1663 pprInstr (JMP dsts addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1665 pprInstr (CALL (Left imm) n _)
1666 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1667 pprInstr (CALL (Right reg) n _)
1668 = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
1671 Continue with SPARC-only printing bits and bobs:
1674 pprRI (RIReg r) = pprReg r
1675 pprRI (RIImm r) = pprImm r
1677 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
1678 pprSizeRegReg name size reg1 reg2
1683 F -> ptext SLIT("s\t")
1684 DF -> ptext SLIT("d\t")),
1690 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1691 pprSizeRegRegReg name size reg1 reg2 reg3
1696 F -> ptext SLIT("s\t")
1697 DF -> ptext SLIT("d\t")),
1705 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
1706 pprRegRIReg name b reg1 ri reg2
1710 if b then ptext SLIT("cc\t") else char '\t',
1718 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
1719 pprRIReg name b ri reg1
1723 if b then ptext SLIT("cc\t") else char '\t',
1729 pp_ld_lbracket = ptext SLIT("\tld\t[")
1730 pp_rbracket_comma = text "],"
1731 pp_comma_lbracket = text ",["
1732 pp_comma_a = text ",a"
1734 #endif {-sparc_TARGET_ARCH-}
1738 #if __GLASGOW_HASKELL__ >= 504
1739 newFloatArray :: (Int,Int) -> ST s (STUArray s Int Float)
1740 newFloatArray = newArray_
1742 newDoubleArray :: (Int,Int) -> ST s (STUArray s Int Double)
1743 newDoubleArray = newArray_
1745 castFloatToCharArray :: STUArray s Int Float -> ST s (STUArray s Int Word8)
1746 castFloatToCharArray = castSTUArray
1748 castDoubleToCharArray :: STUArray s Int Double -> ST s (STUArray s Int Word8)
1749 castDoubleToCharArray = castSTUArray
1751 writeFloatArray :: STUArray s Int Float -> Int -> Float -> ST s ()
1752 writeFloatArray = writeArray
1754 writeDoubleArray :: STUArray s Int Double -> Int -> Double -> ST s ()
1755 writeDoubleArray = writeArray
1757 readCharArray :: STUArray s Int Word8 -> Int -> ST s Char
1758 readCharArray arr i = do
1759 w <- readArray arr i
1760 return $! (chr (fromIntegral w))
1764 castFloatToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
1765 castFloatToCharArray = return
1767 castDoubleToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
1768 castDoubleToCharArray = return
1772 -- floatToBytes and doubleToBytes convert to the host's byte
1773 -- order. Providing that we're not cross-compiling for a
1774 -- target with the opposite endianness, this should work ok
1777 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
1778 -- could they be merged?
1780 floatToBytes :: Float -> [Int]
1783 arr <- newFloatArray ((0::Int),3)
1784 writeFloatArray arr 0 f
1785 arr <- castFloatToCharArray arr
1786 i0 <- readCharArray arr 0
1787 i1 <- readCharArray arr 1
1788 i2 <- readCharArray arr 2
1789 i3 <- readCharArray arr 3
1790 return (map ord [i0,i1,i2,i3])
1793 doubleToBytes :: Double -> [Int]
1796 arr <- newDoubleArray ((0::Int),7)
1797 writeDoubleArray arr 0 d
1798 arr <- castDoubleToCharArray arr
1799 i0 <- readCharArray arr 0
1800 i1 <- readCharArray arr 1
1801 i2 <- readCharArray arr 2
1802 i3 <- readCharArray arr 3
1803 i4 <- readCharArray arr 4
1804 i5 <- readCharArray arr 5
1805 i6 <- readCharArray arr 6
1806 i7 <- readCharArray arr 7
1807 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])