+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
-----------------------------------------------------------------------------
--
-- Pretty-printing assembly language
pprInstr, pprSize, pprUserReg
) where
-
#include "HsVersions.h"
+import BlockId
import Cmm
-import MachOp ( MachRep(..), wordRep, isFloatingRep )
import MachRegs -- may differ per-platform
import MachInstrs
pprSectionHeader section $$ vcat (map pprData dats)
-- special case for split markers:
-pprNatCmmTop (CmmProc [] lbl _ []) = pprLabel lbl
+pprNatCmmTop (CmmProc [] lbl _ (ListGraph [])) = pprLabel lbl
-pprNatCmmTop (CmmProc info lbl params blocks) =
+pprNatCmmTop (CmmProc info lbl params (ListGraph blocks)) =
pprSectionHeader Text $$
- (if not (null info)
- then
+ (if null info then -- blocks guaranteed not null, so label needed
+ pprLabel lbl
+ else
#if HAVE_SUBSECTIONS_VIA_SYMBOLS
pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
<> char ':' $$
#endif
- vcat (map pprData info) $$
- pprLabel (entryLblToInfoLbl lbl)
- else empty) $$
- (case blocks of
- [] -> empty
- (BasicBlock _ instrs : rest) ->
- (if null info then pprLabel lbl else empty) $$
- -- the first block doesn't get a label:
- vcat (map pprInstr instrs) $$
- vcat (map pprBasicBlock rest)
- )
+ vcat (map pprData info) $$
+ pprLabel (entryLblToInfoLbl lbl)
+ ) $$
+ vcat (map pprBasicBlock blocks)
+ -- above: Even the first block gets a label, because with branch-chain
+ -- elimination, it might be the target of a goto.
#if HAVE_SUBSECTIONS_VIA_SYMBOLS
-- If we are using the .subsections_via_symbols directive
-- (available on recent versions of Darwin),
-- on which bit of it we care about. Yurgh.
pprUserReg :: Reg -> Doc
-pprUserReg = pprReg IF_ARCH_i386(I32,) IF_ARCH_x86_64(I64,)
+pprUserReg = pprReg IF_ARCH_i386(II32,) IF_ARCH_x86_64(II64,)
-pprReg :: IF_ARCH_i386(MachRep ->,) IF_ARCH_x86_64(MachRep ->,) Reg -> Doc
+pprReg :: IF_ARCH_i386(Size ->,) IF_ARCH_x86_64(Size ->,) Reg -> Doc
pprReg IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) r
= case r of
ppr_reg_no :: Int -> Doc
ppr_reg_no i = ptext
(case i of {
- 0 -> SLIT("$0"); 1 -> SLIT("$1");
- 2 -> SLIT("$2"); 3 -> SLIT("$3");
- 4 -> SLIT("$4"); 5 -> SLIT("$5");
- 6 -> SLIT("$6"); 7 -> SLIT("$7");
- 8 -> SLIT("$8"); 9 -> SLIT("$9");
- 10 -> SLIT("$10"); 11 -> SLIT("$11");
- 12 -> SLIT("$12"); 13 -> SLIT("$13");
- 14 -> SLIT("$14"); 15 -> SLIT("$15");
- 16 -> SLIT("$16"); 17 -> SLIT("$17");
- 18 -> SLIT("$18"); 19 -> SLIT("$19");
- 20 -> SLIT("$20"); 21 -> SLIT("$21");
- 22 -> SLIT("$22"); 23 -> SLIT("$23");
- 24 -> SLIT("$24"); 25 -> SLIT("$25");
- 26 -> SLIT("$26"); 27 -> SLIT("$27");
- 28 -> SLIT("$28"); 29 -> SLIT("$29");
- 30 -> SLIT("$30"); 31 -> SLIT("$31");
- 32 -> SLIT("$f0"); 33 -> SLIT("$f1");
- 34 -> SLIT("$f2"); 35 -> SLIT("$f3");
- 36 -> SLIT("$f4"); 37 -> SLIT("$f5");
- 38 -> SLIT("$f6"); 39 -> SLIT("$f7");
- 40 -> SLIT("$f8"); 41 -> SLIT("$f9");
- 42 -> SLIT("$f10"); 43 -> SLIT("$f11");
- 44 -> SLIT("$f12"); 45 -> SLIT("$f13");
- 46 -> SLIT("$f14"); 47 -> SLIT("$f15");
- 48 -> SLIT("$f16"); 49 -> SLIT("$f17");
- 50 -> SLIT("$f18"); 51 -> SLIT("$f19");
- 52 -> SLIT("$f20"); 53 -> SLIT("$f21");
- 54 -> SLIT("$f22"); 55 -> SLIT("$f23");
- 56 -> SLIT("$f24"); 57 -> SLIT("$f25");
- 58 -> SLIT("$f26"); 59 -> SLIT("$f27");
- 60 -> SLIT("$f28"); 61 -> SLIT("$f29");
- 62 -> SLIT("$f30"); 63 -> SLIT("$f31");
- _ -> SLIT("very naughty alpha register")
+ 0 -> sLit "$0"; 1 -> sLit "$1";
+ 2 -> sLit "$2"; 3 -> sLit "$3";
+ 4 -> sLit "$4"; 5 -> sLit "$5";
+ 6 -> sLit "$6"; 7 -> sLit "$7";
+ 8 -> sLit "$8"; 9 -> sLit "$9";
+ 10 -> sLit "$10"; 11 -> sLit "$11";
+ 12 -> sLit "$12"; 13 -> sLit "$13";
+ 14 -> sLit "$14"; 15 -> sLit "$15";
+ 16 -> sLit "$16"; 17 -> sLit "$17";
+ 18 -> sLit "$18"; 19 -> sLit "$19";
+ 20 -> sLit "$20"; 21 -> sLit "$21";
+ 22 -> sLit "$22"; 23 -> sLit "$23";
+ 24 -> sLit "$24"; 25 -> sLit "$25";
+ 26 -> sLit "$26"; 27 -> sLit "$27";
+ 28 -> sLit "$28"; 29 -> sLit "$29";
+ 30 -> sLit "$30"; 31 -> sLit "$31";
+ 32 -> sLit "$f0"; 33 -> sLit "$f1";
+ 34 -> sLit "$f2"; 35 -> sLit "$f3";
+ 36 -> sLit "$f4"; 37 -> sLit "$f5";
+ 38 -> sLit "$f6"; 39 -> sLit "$f7";
+ 40 -> sLit "$f8"; 41 -> sLit "$f9";
+ 42 -> sLit "$f10"; 43 -> sLit "$f11";
+ 44 -> sLit "$f12"; 45 -> sLit "$f13";
+ 46 -> sLit "$f14"; 47 -> sLit "$f15";
+ 48 -> sLit "$f16"; 49 -> sLit "$f17";
+ 50 -> sLit "$f18"; 51 -> sLit "$f19";
+ 52 -> sLit "$f20"; 53 -> sLit "$f21";
+ 54 -> sLit "$f22"; 55 -> sLit "$f23";
+ 56 -> sLit "$f24"; 57 -> sLit "$f25";
+ 58 -> sLit "$f26"; 59 -> sLit "$f27";
+ 60 -> sLit "$f28"; 61 -> sLit "$f29";
+ 62 -> sLit "$f30"; 63 -> sLit "$f31";
+ _ -> sLit "very naughty alpha register"
})
#endif
#if i386_TARGET_ARCH
- ppr_reg_no :: MachRep -> Int -> Doc
- ppr_reg_no I8 = ppr_reg_byte
- ppr_reg_no I16 = ppr_reg_word
+ ppr_reg_no :: Size -> Int -> Doc
+ ppr_reg_no II8 = ppr_reg_byte
+ ppr_reg_no II16 = ppr_reg_word
ppr_reg_no _ = ppr_reg_long
ppr_reg_byte i = ptext
(case i of {
- 0 -> SLIT("%al"); 1 -> SLIT("%bl");
- 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
- _ -> SLIT("very naughty I386 byte register")
+ 0 -> sLit "%al"; 1 -> sLit "%bl";
+ 2 -> sLit "%cl"; 3 -> sLit "%dl";
+ _ -> sLit "very naughty I386 byte register"
})
ppr_reg_word i = ptext
(case i of {
- 0 -> SLIT("%ax"); 1 -> SLIT("%bx");
- 2 -> SLIT("%cx"); 3 -> SLIT("%dx");
- 4 -> SLIT("%si"); 5 -> SLIT("%di");
- 6 -> SLIT("%bp"); 7 -> SLIT("%sp");
- _ -> SLIT("very naughty I386 word register")
+ 0 -> sLit "%ax"; 1 -> sLit "%bx";
+ 2 -> sLit "%cx"; 3 -> sLit "%dx";
+ 4 -> sLit "%si"; 5 -> sLit "%di";
+ 6 -> sLit "%bp"; 7 -> sLit "%sp";
+ _ -> sLit "very naughty I386 word register"
})
ppr_reg_long i = ptext
(case i of {
- 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
- 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
- 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
- 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
- 8 -> SLIT("%fake0"); 9 -> SLIT("%fake1");
- 10 -> SLIT("%fake2"); 11 -> SLIT("%fake3");
- 12 -> SLIT("%fake4"); 13 -> SLIT("%fake5");
- _ -> SLIT("very naughty I386 register")
+ 0 -> sLit "%eax"; 1 -> sLit "%ebx";
+ 2 -> sLit "%ecx"; 3 -> sLit "%edx";
+ 4 -> sLit "%esi"; 5 -> sLit "%edi";
+ 6 -> sLit "%ebp"; 7 -> sLit "%esp";
+ 8 -> sLit "%fake0"; 9 -> sLit "%fake1";
+ 10 -> sLit "%fake2"; 11 -> sLit "%fake3";
+ 12 -> sLit "%fake4"; 13 -> sLit "%fake5";
+ _ -> sLit "very naughty I386 register"
})
#endif
#if x86_64_TARGET_ARCH
- ppr_reg_no :: MachRep -> Int -> Doc
- ppr_reg_no I8 = ppr_reg_byte
- ppr_reg_no I16 = ppr_reg_word
- ppr_reg_no I32 = ppr_reg_long
+ ppr_reg_no :: Size -> Int -> Doc
+ ppr_reg_no II8 = ppr_reg_byte
+ ppr_reg_no II16 = ppr_reg_word
+ ppr_reg_no II32 = ppr_reg_long
ppr_reg_no _ = ppr_reg_quad
ppr_reg_byte i = ptext
(case i of {
- 0 -> SLIT("%al"); 1 -> SLIT("%bl");
- 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
- 4 -> SLIT("%sil"); 5 -> SLIT("%dil"); -- new 8-bit regs!
- 6 -> SLIT("%bpl"); 7 -> SLIT("%spl");
- 8 -> SLIT("%r8b"); 9 -> SLIT("%r9b");
- 10 -> SLIT("%r10b"); 11 -> SLIT("%r11b");
- 12 -> SLIT("%r12b"); 13 -> SLIT("%r13b");
- 14 -> SLIT("%r14b"); 15 -> SLIT("%r15b");
- _ -> SLIT("very naughty x86_64 byte register")
+ 0 -> sLit "%al"; 1 -> sLit "%bl";
+ 2 -> sLit "%cl"; 3 -> sLit "%dl";
+ 4 -> sLit "%sil"; 5 -> sLit "%dil"; -- new 8-bit regs!
+ 6 -> sLit "%bpl"; 7 -> sLit "%spl";
+ 8 -> sLit "%r8b"; 9 -> sLit "%r9b";
+ 10 -> sLit "%r10b"; 11 -> sLit "%r11b";
+ 12 -> sLit "%r12b"; 13 -> sLit "%r13b";
+ 14 -> sLit "%r14b"; 15 -> sLit "%r15b";
+ _ -> sLit "very naughty x86_64 byte register"
})
ppr_reg_word i = ptext
(case i of {
- 0 -> SLIT("%ax"); 1 -> SLIT("%bx");
- 2 -> SLIT("%cx"); 3 -> SLIT("%dx");
- 4 -> SLIT("%si"); 5 -> SLIT("%di");
- 6 -> SLIT("%bp"); 7 -> SLIT("%sp");
- 8 -> SLIT("%r8w"); 9 -> SLIT("%r9w");
- 10 -> SLIT("%r10w"); 11 -> SLIT("%r11w");
- 12 -> SLIT("%r12w"); 13 -> SLIT("%r13w");
- 14 -> SLIT("%r14w"); 15 -> SLIT("%r15w");
- _ -> SLIT("very naughty x86_64 word register")
+ 0 -> sLit "%ax"; 1 -> sLit "%bx";
+ 2 -> sLit "%cx"; 3 -> sLit "%dx";
+ 4 -> sLit "%si"; 5 -> sLit "%di";
+ 6 -> sLit "%bp"; 7 -> sLit "%sp";
+ 8 -> sLit "%r8w"; 9 -> sLit "%r9w";
+ 10 -> sLit "%r10w"; 11 -> sLit "%r11w";
+ 12 -> sLit "%r12w"; 13 -> sLit "%r13w";
+ 14 -> sLit "%r14w"; 15 -> sLit "%r15w";
+ _ -> sLit "very naughty x86_64 word register"
})
ppr_reg_long i = ptext
(case i of {
- 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
- 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
- 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
- 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
- 8 -> SLIT("%r8d"); 9 -> SLIT("%r9d");
- 10 -> SLIT("%r10d"); 11 -> SLIT("%r11d");
- 12 -> SLIT("%r12d"); 13 -> SLIT("%r13d");
- 14 -> SLIT("%r14d"); 15 -> SLIT("%r15d");
- _ -> SLIT("very naughty x86_64 register")
+ 0 -> sLit "%eax"; 1 -> sLit "%ebx";
+ 2 -> sLit "%ecx"; 3 -> sLit "%edx";
+ 4 -> sLit "%esi"; 5 -> sLit "%edi";
+ 6 -> sLit "%ebp"; 7 -> sLit "%esp";
+ 8 -> sLit "%r8d"; 9 -> sLit "%r9d";
+ 10 -> sLit "%r10d"; 11 -> sLit "%r11d";
+ 12 -> sLit "%r12d"; 13 -> sLit "%r13d";
+ 14 -> sLit "%r14d"; 15 -> sLit "%r15d";
+ _ -> sLit "very naughty x86_64 register"
})
ppr_reg_quad i = ptext
(case i of {
- 0 -> SLIT("%rax"); 1 -> SLIT("%rbx");
- 2 -> SLIT("%rcx"); 3 -> SLIT("%rdx");
- 4 -> SLIT("%rsi"); 5 -> SLIT("%rdi");
- 6 -> SLIT("%rbp"); 7 -> SLIT("%rsp");
- 8 -> SLIT("%r8"); 9 -> SLIT("%r9");
- 10 -> SLIT("%r10"); 11 -> SLIT("%r11");
- 12 -> SLIT("%r12"); 13 -> SLIT("%r13");
- 14 -> SLIT("%r14"); 15 -> SLIT("%r15");
- 16 -> SLIT("%xmm0"); 17 -> SLIT("%xmm1");
- 18 -> SLIT("%xmm2"); 19 -> SLIT("%xmm3");
- 20 -> SLIT("%xmm4"); 21 -> SLIT("%xmm5");
- 22 -> SLIT("%xmm6"); 23 -> SLIT("%xmm7");
- 24 -> SLIT("%xmm8"); 25 -> SLIT("%xmm9");
- 26 -> SLIT("%xmm10"); 27 -> SLIT("%xmm11");
- 28 -> SLIT("%xmm12"); 29 -> SLIT("%xmm13");
- 30 -> SLIT("%xmm14"); 31 -> SLIT("%xmm15");
- _ -> SLIT("very naughty x86_64 register")
+ 0 -> sLit "%rax"; 1 -> sLit "%rbx";
+ 2 -> sLit "%rcx"; 3 -> sLit "%rdx";
+ 4 -> sLit "%rsi"; 5 -> sLit "%rdi";
+ 6 -> sLit "%rbp"; 7 -> sLit "%rsp";
+ 8 -> sLit "%r8"; 9 -> sLit "%r9";
+ 10 -> sLit "%r10"; 11 -> sLit "%r11";
+ 12 -> sLit "%r12"; 13 -> sLit "%r13";
+ 14 -> sLit "%r14"; 15 -> sLit "%r15";
+ 16 -> sLit "%xmm0"; 17 -> sLit "%xmm1";
+ 18 -> sLit "%xmm2"; 19 -> sLit "%xmm3";
+ 20 -> sLit "%xmm4"; 21 -> sLit "%xmm5";
+ 22 -> sLit "%xmm6"; 23 -> sLit "%xmm7";
+ 24 -> sLit "%xmm8"; 25 -> sLit "%xmm9";
+ 26 -> sLit "%xmm10"; 27 -> sLit "%xmm11";
+ 28 -> sLit "%xmm12"; 29 -> sLit "%xmm13";
+ 30 -> sLit "%xmm14"; 31 -> sLit "%xmm15";
+ _ -> sLit "very naughty x86_64 register"
})
#endif
ppr_reg_no :: Int -> Doc
ppr_reg_no i = ptext
(case i of {
- 0 -> SLIT("%g0"); 1 -> SLIT("%g1");
- 2 -> SLIT("%g2"); 3 -> SLIT("%g3");
- 4 -> SLIT("%g4"); 5 -> SLIT("%g5");
- 6 -> SLIT("%g6"); 7 -> SLIT("%g7");
- 8 -> SLIT("%o0"); 9 -> SLIT("%o1");
- 10 -> SLIT("%o2"); 11 -> SLIT("%o3");
- 12 -> SLIT("%o4"); 13 -> SLIT("%o5");
- 14 -> SLIT("%o6"); 15 -> SLIT("%o7");
- 16 -> SLIT("%l0"); 17 -> SLIT("%l1");
- 18 -> SLIT("%l2"); 19 -> SLIT("%l3");
- 20 -> SLIT("%l4"); 21 -> SLIT("%l5");
- 22 -> SLIT("%l6"); 23 -> SLIT("%l7");
- 24 -> SLIT("%i0"); 25 -> SLIT("%i1");
- 26 -> SLIT("%i2"); 27 -> SLIT("%i3");
- 28 -> SLIT("%i4"); 29 -> SLIT("%i5");
- 30 -> SLIT("%i6"); 31 -> SLIT("%i7");
- 32 -> SLIT("%f0"); 33 -> SLIT("%f1");
- 34 -> SLIT("%f2"); 35 -> SLIT("%f3");
- 36 -> SLIT("%f4"); 37 -> SLIT("%f5");
- 38 -> SLIT("%f6"); 39 -> SLIT("%f7");
- 40 -> SLIT("%f8"); 41 -> SLIT("%f9");
- 42 -> SLIT("%f10"); 43 -> SLIT("%f11");
- 44 -> SLIT("%f12"); 45 -> SLIT("%f13");
- 46 -> SLIT("%f14"); 47 -> SLIT("%f15");
- 48 -> SLIT("%f16"); 49 -> SLIT("%f17");
- 50 -> SLIT("%f18"); 51 -> SLIT("%f19");
- 52 -> SLIT("%f20"); 53 -> SLIT("%f21");
- 54 -> SLIT("%f22"); 55 -> SLIT("%f23");
- 56 -> SLIT("%f24"); 57 -> SLIT("%f25");
- 58 -> SLIT("%f26"); 59 -> SLIT("%f27");
- 60 -> SLIT("%f28"); 61 -> SLIT("%f29");
- 62 -> SLIT("%f30"); 63 -> SLIT("%f31");
- _ -> SLIT("very naughty sparc register")
+ 0 -> sLit "%g0"; 1 -> sLit "%g1";
+ 2 -> sLit "%g2"; 3 -> sLit "%g3";
+ 4 -> sLit "%g4"; 5 -> sLit "%g5";
+ 6 -> sLit "%g6"; 7 -> sLit "%g7";
+ 8 -> sLit "%o0"; 9 -> sLit "%o1";
+ 10 -> sLit "%o2"; 11 -> sLit "%o3";
+ 12 -> sLit "%o4"; 13 -> sLit "%o5";
+ 14 -> sLit "%o6"; 15 -> sLit "%o7";
+ 16 -> sLit "%l0"; 17 -> sLit "%l1";
+ 18 -> sLit "%l2"; 19 -> sLit "%l3";
+ 20 -> sLit "%l4"; 21 -> sLit "%l5";
+ 22 -> sLit "%l6"; 23 -> sLit "%l7";
+ 24 -> sLit "%i0"; 25 -> sLit "%i1";
+ 26 -> sLit "%i2"; 27 -> sLit "%i3";
+ 28 -> sLit "%i4"; 29 -> sLit "%i5";
+ 30 -> sLit "%i6"; 31 -> sLit "%i7";
+ 32 -> sLit "%f0"; 33 -> sLit "%f1";
+ 34 -> sLit "%f2"; 35 -> sLit "%f3";
+ 36 -> sLit "%f4"; 37 -> sLit "%f5";
+ 38 -> sLit "%f6"; 39 -> sLit "%f7";
+ 40 -> sLit "%f8"; 41 -> sLit "%f9";
+ 42 -> sLit "%f10"; 43 -> sLit "%f11";
+ 44 -> sLit "%f12"; 45 -> sLit "%f13";
+ 46 -> sLit "%f14"; 47 -> sLit "%f15";
+ 48 -> sLit "%f16"; 49 -> sLit "%f17";
+ 50 -> sLit "%f18"; 51 -> sLit "%f19";
+ 52 -> sLit "%f20"; 53 -> sLit "%f21";
+ 54 -> sLit "%f22"; 55 -> sLit "%f23";
+ 56 -> sLit "%f24"; 57 -> sLit "%f25";
+ 58 -> sLit "%f26"; 59 -> sLit "%f27";
+ 60 -> sLit "%f28"; 61 -> sLit "%f29";
+ 62 -> sLit "%f30"; 63 -> sLit "%f31";
+ _ -> sLit "very naughty sparc register"
})
#endif
#if powerpc_TARGET_ARCH
ppr_reg_no :: Int -> Doc
ppr_reg_no i = ptext
(case i of {
- 0 -> SLIT("r0"); 1 -> SLIT("r1");
- 2 -> SLIT("r2"); 3 -> SLIT("r3");
- 4 -> SLIT("r4"); 5 -> SLIT("r5");
- 6 -> SLIT("r6"); 7 -> SLIT("r7");
- 8 -> SLIT("r8"); 9 -> SLIT("r9");
- 10 -> SLIT("r10"); 11 -> SLIT("r11");
- 12 -> SLIT("r12"); 13 -> SLIT("r13");
- 14 -> SLIT("r14"); 15 -> SLIT("r15");
- 16 -> SLIT("r16"); 17 -> SLIT("r17");
- 18 -> SLIT("r18"); 19 -> SLIT("r19");
- 20 -> SLIT("r20"); 21 -> SLIT("r21");
- 22 -> SLIT("r22"); 23 -> SLIT("r23");
- 24 -> SLIT("r24"); 25 -> SLIT("r25");
- 26 -> SLIT("r26"); 27 -> SLIT("r27");
- 28 -> SLIT("r28"); 29 -> SLIT("r29");
- 30 -> SLIT("r30"); 31 -> SLIT("r31");
- 32 -> SLIT("f0"); 33 -> SLIT("f1");
- 34 -> SLIT("f2"); 35 -> SLIT("f3");
- 36 -> SLIT("f4"); 37 -> SLIT("f5");
- 38 -> SLIT("f6"); 39 -> SLIT("f7");
- 40 -> SLIT("f8"); 41 -> SLIT("f9");
- 42 -> SLIT("f10"); 43 -> SLIT("f11");
- 44 -> SLIT("f12"); 45 -> SLIT("f13");
- 46 -> SLIT("f14"); 47 -> SLIT("f15");
- 48 -> SLIT("f16"); 49 -> SLIT("f17");
- 50 -> SLIT("f18"); 51 -> SLIT("f19");
- 52 -> SLIT("f20"); 53 -> SLIT("f21");
- 54 -> SLIT("f22"); 55 -> SLIT("f23");
- 56 -> SLIT("f24"); 57 -> SLIT("f25");
- 58 -> SLIT("f26"); 59 -> SLIT("f27");
- 60 -> SLIT("f28"); 61 -> SLIT("f29");
- 62 -> SLIT("f30"); 63 -> SLIT("f31");
- _ -> SLIT("very naughty powerpc register")
+ 0 -> sLit "r0"; 1 -> sLit "r1";
+ 2 -> sLit "r2"; 3 -> sLit "r3";
+ 4 -> sLit "r4"; 5 -> sLit "r5";
+ 6 -> sLit "r6"; 7 -> sLit "r7";
+ 8 -> sLit "r8"; 9 -> sLit "r9";
+ 10 -> sLit "r10"; 11 -> sLit "r11";
+ 12 -> sLit "r12"; 13 -> sLit "r13";
+ 14 -> sLit "r14"; 15 -> sLit "r15";
+ 16 -> sLit "r16"; 17 -> sLit "r17";
+ 18 -> sLit "r18"; 19 -> sLit "r19";
+ 20 -> sLit "r20"; 21 -> sLit "r21";
+ 22 -> sLit "r22"; 23 -> sLit "r23";
+ 24 -> sLit "r24"; 25 -> sLit "r25";
+ 26 -> sLit "r26"; 27 -> sLit "r27";
+ 28 -> sLit "r28"; 29 -> sLit "r29";
+ 30 -> sLit "r30"; 31 -> sLit "r31";
+ 32 -> sLit "f0"; 33 -> sLit "f1";
+ 34 -> sLit "f2"; 35 -> sLit "f3";
+ 36 -> sLit "f4"; 37 -> sLit "f5";
+ 38 -> sLit "f6"; 39 -> sLit "f7";
+ 40 -> sLit "f8"; 41 -> sLit "f9";
+ 42 -> sLit "f10"; 43 -> sLit "f11";
+ 44 -> sLit "f12"; 45 -> sLit "f13";
+ 46 -> sLit "f14"; 47 -> sLit "f15";
+ 48 -> sLit "f16"; 49 -> sLit "f17";
+ 50 -> sLit "f18"; 51 -> sLit "f19";
+ 52 -> sLit "f20"; 53 -> sLit "f21";
+ 54 -> sLit "f22"; 55 -> sLit "f23";
+ 56 -> sLit "f24"; 57 -> sLit "f25";
+ 58 -> sLit "f26"; 59 -> sLit "f27";
+ 60 -> sLit "f28"; 61 -> sLit "f29";
+ 62 -> sLit "f30"; 63 -> sLit "f31";
+ _ -> sLit "very naughty powerpc register"
})
#else
ppr_reg_no :: Int -> Doc
ppr_reg_no i | i <= 31 = int i -- GPRs
| i <= 63 = int (i-32) -- FPRs
- | otherwise = ptext SLIT("very naughty powerpc register")
+ | otherwise = ptext (sLit "very naughty powerpc register")
#endif
#endif
-- pprSize: print a 'Size'
#if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH || sparc_TARGET_ARCH
-pprSize :: MachRep -> Doc
+pprSize :: Size -> Doc
#else
pprSize :: Size -> Doc
#endif
pprSize x = ptext (case x of
#if alpha_TARGET_ARCH
- B -> SLIT("b")
- Bu -> SLIT("bu")
--- W -> SLIT("w") UNUSED
--- Wu -> SLIT("wu") UNUSED
- L -> SLIT("l")
- Q -> SLIT("q")
--- FF -> SLIT("f") UNUSED
--- DF -> SLIT("d") UNUSED
--- GF -> SLIT("g") UNUSED
--- SF -> SLIT("s") UNUSED
- TF -> SLIT("t")
+ B -> sLit "b"
+ Bu -> sLit "bu"
+-- W -> sLit "w" UNUSED
+-- Wu -> sLit "wu" UNUSED
+ L -> sLit "l"
+ Q -> sLit "q"
+-- FF -> sLit "f" UNUSED
+-- DF -> sLit "d" UNUSED
+-- GF -> sLit "g" UNUSED
+-- SF -> sLit "s" UNUSED
+ TF -> sLit "t"
#endif
#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
- I8 -> SLIT("b")
- I16 -> SLIT("w")
- I32 -> SLIT("l")
- I64 -> SLIT("q")
+ II8 -> sLit "b"
+ II16 -> sLit "w"
+ II32 -> sLit "l"
+ II64 -> sLit "q"
#endif
#if i386_TARGET_ARCH
- F32 -> SLIT("s")
- F64 -> SLIT("l")
- F80 -> SLIT("t")
+ FF32 -> sLit "s"
+ FF64 -> sLit "l"
+ FF80 -> sLit "t"
#endif
#if x86_64_TARGET_ARCH
- F32 -> SLIT("ss") -- "scalar single-precision float" (SSE2)
- F64 -> SLIT("sd") -- "scalar double-precision float" (SSE2)
+ FF32 -> sLit "ss" -- "scalar single-precision float" (SSE2)
+ FF64 -> sLit "sd" -- "scalar double-precision float" (SSE2)
#endif
#if sparc_TARGET_ARCH
- I8 -> SLIT("sb")
- I16 -> SLIT("sh")
- I32 -> SLIT("")
- F32 -> SLIT("")
- F64 -> SLIT("d")
+ II8 -> sLit "sb"
+ II16 -> sLit "sh"
+ II32 -> sLit ""
+ FF32 -> sLit ""
+ FF64 -> sLit "d"
)
-pprStSize :: MachRep -> Doc
+pprStSize :: Size -> Doc
pprStSize x = ptext (case x of
- I8 -> SLIT("b")
- I16 -> SLIT("h")
- I32 -> SLIT("")
- F32 -> SLIT("")
- F64 -> SLIT("d")
+ II8 -> sLit "b"
+ II16 -> sLit "h"
+ II32 -> sLit ""
+ FF32 -> sLit ""
+ FF64 -> sLit "d"
#endif
#if powerpc_TARGET_ARCH
- I8 -> SLIT("b")
- I16 -> SLIT("h")
- I32 -> SLIT("w")
- F32 -> SLIT("fs")
- F64 -> SLIT("fd")
+ II8 -> sLit "b"
+ II16 -> sLit "h"
+ II32 -> sLit "w"
+ FF32 -> sLit "fs"
+ FF64 -> sLit "fd"
#endif
)
pprCond c = ptext (case c of {
#if alpha_TARGET_ARCH
- EQQ -> SLIT("eq");
- LTT -> SLIT("lt");
- LE -> SLIT("le");
- ULT -> SLIT("ult");
- ULE -> SLIT("ule");
- NE -> SLIT("ne");
- GTT -> SLIT("gt");
- GE -> SLIT("ge")
+ EQQ -> sLit "eq";
+ LTT -> sLit "lt";
+ LE -> sLit "le";
+ ULT -> sLit "ult";
+ ULE -> sLit "ule";
+ NE -> sLit "ne";
+ GTT -> sLit "gt";
+ GE -> sLit "ge"
#endif
#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
- GEU -> SLIT("ae"); LU -> SLIT("b");
- EQQ -> SLIT("e"); GTT -> SLIT("g");
- GE -> SLIT("ge"); GU -> SLIT("a");
- LTT -> SLIT("l"); LE -> SLIT("le");
- LEU -> SLIT("be"); NE -> SLIT("ne");
- NEG -> SLIT("s"); POS -> SLIT("ns");
- CARRY -> SLIT("c"); OFLO -> SLIT("o");
- PARITY -> SLIT("p"); NOTPARITY -> SLIT("np");
- ALWAYS -> SLIT("mp") -- hack
+ GEU -> sLit "ae"; LU -> sLit "b";
+ EQQ -> sLit "e"; GTT -> sLit "g";
+ GE -> sLit "ge"; GU -> sLit "a";
+ LTT -> sLit "l"; LE -> sLit "le";
+ LEU -> sLit "be"; NE -> sLit "ne";
+ NEG -> sLit "s"; POS -> sLit "ns";
+ CARRY -> sLit "c"; OFLO -> sLit "o";
+ PARITY -> sLit "p"; NOTPARITY -> sLit "np";
+ ALWAYS -> sLit "mp" -- hack
#endif
#if sparc_TARGET_ARCH
- ALWAYS -> SLIT(""); NEVER -> SLIT("n");
- GEU -> SLIT("geu"); LU -> SLIT("lu");
- EQQ -> SLIT("e"); GTT -> SLIT("g");
- GE -> SLIT("ge"); GU -> SLIT("gu");
- LTT -> SLIT("l"); LE -> SLIT("le");
- LEU -> SLIT("leu"); NE -> SLIT("ne");
- NEG -> SLIT("neg"); POS -> SLIT("pos");
- VC -> SLIT("vc"); VS -> SLIT("vs")
+ ALWAYS -> sLit ""; NEVER -> sLit "n";
+ GEU -> sLit "geu"; LU -> sLit "lu";
+ EQQ -> sLit "e"; GTT -> sLit "g";
+ GE -> sLit "ge"; GU -> sLit "gu";
+ LTT -> sLit "l"; LE -> sLit "le";
+ LEU -> sLit "leu"; NE -> sLit "ne";
+ NEG -> sLit "neg"; POS -> sLit "pos";
+ VC -> sLit "vc"; VS -> sLit "vs"
#endif
#if powerpc_TARGET_ARCH
- ALWAYS -> SLIT("");
- EQQ -> SLIT("eq"); NE -> SLIT("ne");
- LTT -> SLIT("lt"); GE -> SLIT("ge");
- GTT -> SLIT("gt"); LE -> SLIT("le");
- LU -> SLIT("lt"); GEU -> SLIT("ge");
- GU -> SLIT("gt"); LEU -> SLIT("le");
+ ALWAYS -> sLit "";
+ EQQ -> sLit "eq"; NE -> sLit "ne";
+ LTT -> sLit "lt"; GE -> sLit "ge";
+ GTT -> sLit "gt"; LE -> sLit "le";
+ LU -> sLit "lt"; GEU -> sLit "ge";
+ GU -> sLit "gt"; LEU -> sLit "le";
#endif
})
pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
pprImm (ImmLit s) = s
-pprImm (ImmFloat _) = ptext SLIT("naughty float immediate")
-pprImm (ImmDouble _) = ptext SLIT("naughty double immediate")
+pprImm (ImmFloat _) = ptext (sLit "naughty float immediate")
+pprImm (ImmDouble _) = ptext (sLit "naughty double immediate")
pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
#if sparc_TARGET_ARCH
= let
pp_disp = ppr_disp displacement
pp_off p = pp_disp <> char '(' <> p <> char ')'
- pp_reg r = pprReg wordRep r
+ pp_reg r = pprReg wordSize r
in
case (base,index) of
(EABaseNone, EAIndexNone) -> pp_disp
(EABaseReg b, EAIndexNone) -> pp_off (pp_reg b)
- (EABaseRip, EAIndexNone) -> pp_off (ptext SLIT("%rip"))
+ (EABaseRip, EAIndexNone) -> pp_off (ptext (sLit "%rip"))
(EABaseNone, EAIndex r i) -> pp_off (comma <> pp_reg r <> comma <> int i)
(EABaseReg b, EAIndex r i) -> pp_off (pp_reg b <> comma <> pp_reg r
<> comma <> int i)
#if powerpc_TARGET_ARCH
pprAddr (AddrRegReg r1 r2)
- = pprReg r1 <+> ptext SLIT(", ") <+> pprReg r2
+ = pprReg r1 <+> ptext (sLit ", ") <+> pprReg r2
pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
pprSectionHeader Text
= ptext
- IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
- ,IF_ARCH_sparc(SLIT(".text\n\t.align 4") {-word boundary-}
- ,IF_ARCH_i386(IF_OS_darwin(SLIT(".text\n\t.align 2"),
- SLIT(".text\n\t.align 4,0x90"))
+ (IF_ARCH_alpha(sLit "\t.text\n\t.align 3" {-word boundary-}
+ ,IF_ARCH_sparc(sLit ".text\n\t.align 4" {-word boundary-}
+ ,IF_ARCH_i386(IF_OS_darwin(sLit ".text\n\t.align 2",
+ sLit ".text\n\t.align 4,0x90")
{-needs per-OS variation!-}
- ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".text\n.align 3"),
- SLIT(".text\n\t.align 8"))
- ,IF_ARCH_powerpc(SLIT(".text\n.align 2")
- ,)))))
+ ,IF_ARCH_x86_64(IF_OS_darwin(sLit ".text\n.align 3",
+ sLit ".text\n\t.align 8")
+ ,IF_ARCH_powerpc(sLit ".text\n.align 2"
+ ,))))))
pprSectionHeader Data
= ptext
- IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
- ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
- ,IF_ARCH_i386(IF_OS_darwin(SLIT(".data\n\t.align 2"),
- SLIT(".data\n\t.align 4"))
- ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".data\n.align 3"),
- SLIT(".data\n\t.align 8"))
- ,IF_ARCH_powerpc(SLIT(".data\n.align 2")
- ,)))))
+ (IF_ARCH_alpha(sLit "\t.data\n\t.align 3"
+ ,IF_ARCH_sparc(sLit ".data\n\t.align 8" {-<8 will break double constants -}
+ ,IF_ARCH_i386(IF_OS_darwin(sLit ".data\n\t.align 2",
+ sLit ".data\n\t.align 4")
+ ,IF_ARCH_x86_64(IF_OS_darwin(sLit ".data\n.align 3",
+ sLit ".data\n\t.align 8")
+ ,IF_ARCH_powerpc(sLit ".data\n.align 2"
+ ,))))))
pprSectionHeader ReadOnlyData
= ptext
- IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
- ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
- ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const\n.align 2"),
- SLIT(".section .rodata\n\t.align 4"))
- ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".const\n.align 3"),
- SLIT(".section .rodata\n\t.align 8"))
- ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 2"),
- SLIT(".section .rodata\n\t.align 2"))
- ,)))))
+ (IF_ARCH_alpha(sLit "\t.data\n\t.align 3"
+ ,IF_ARCH_sparc(sLit ".data\n\t.align 8" {-<8 will break double constants -}
+ ,IF_ARCH_i386(IF_OS_darwin(sLit ".const\n.align 2",
+ sLit ".section .rodata\n\t.align 4")
+ ,IF_ARCH_x86_64(IF_OS_darwin(sLit ".const\n.align 3",
+ sLit ".section .rodata\n\t.align 8")
+ ,IF_ARCH_powerpc(IF_OS_darwin(sLit ".const\n.align 2",
+ sLit ".section .rodata\n\t.align 2")
+ ,))))))
pprSectionHeader RelocatableReadOnlyData
= ptext
- IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
- ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
- ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const_data\n.align 2"),
- SLIT(".section .data\n\t.align 4"))
- ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".const_data\n.align 3"),
- SLIT(".section .data\n\t.align 8"))
- ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
- SLIT(".data\n\t.align 2"))
- ,)))))
+ (IF_ARCH_alpha(sLit "\t.data\n\t.align 3"
+ ,IF_ARCH_sparc(sLit ".data\n\t.align 8" {-<8 will break double constants -}
+ ,IF_ARCH_i386(IF_OS_darwin(sLit ".const_data\n.align 2",
+ sLit ".section .data\n\t.align 4")
+ ,IF_ARCH_x86_64(IF_OS_darwin(sLit ".const_data\n.align 3",
+ sLit ".section .data\n\t.align 8")
+ ,IF_ARCH_powerpc(IF_OS_darwin(sLit ".const_data\n.align 2",
+ sLit ".data\n\t.align 2")
+ ,))))))
pprSectionHeader UninitialisedData
= ptext
- IF_ARCH_alpha(SLIT("\t.bss\n\t.align 3")
- ,IF_ARCH_sparc(SLIT(".bss\n\t.align 8") {-<8 will break double constants -}
- ,IF_ARCH_i386(IF_OS_darwin(SLIT(".data\n\t.align 2"),
- SLIT(".section .bss\n\t.align 4"))
- ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".data\n\t.align 3"),
- SLIT(".section .bss\n\t.align 8"))
- ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
- SLIT(".section .bss\n\t.align 2"))
- ,)))))
+ (IF_ARCH_alpha(sLit "\t.bss\n\t.align 3"
+ ,IF_ARCH_sparc(sLit ".bss\n\t.align 8" {-<8 will break double constants -}
+ ,IF_ARCH_i386(IF_OS_darwin(sLit ".data\n\t.align 2",
+ sLit ".section .bss\n\t.align 4")
+ ,IF_ARCH_x86_64(IF_OS_darwin(sLit ".data\n\t.align 3",
+ sLit ".section .bss\n\t.align 8")
+ ,IF_ARCH_powerpc(IF_OS_darwin(sLit ".const_data\n.align 2",
+ sLit ".section .bss\n\t.align 2")
+ ,))))))
pprSectionHeader ReadOnlyData16
= ptext
- IF_ARCH_alpha(SLIT("\t.data\n\t.align 4")
- ,IF_ARCH_sparc(SLIT(".data\n\t.align 16")
- ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const\n.align 4"),
- SLIT(".section .rodata\n\t.align 16"))
- ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".const\n.align 4"),
- SLIT(".section .rodata.cst16\n\t.align 16"))
- ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 4"),
- SLIT(".section .rodata\n\t.align 4"))
- ,)))))
+ (IF_ARCH_alpha(sLit "\t.data\n\t.align 4"
+ ,IF_ARCH_sparc(sLit ".data\n\t.align 16"
+ ,IF_ARCH_i386(IF_OS_darwin(sLit ".const\n.align 4",
+ sLit ".section .rodata\n\t.align 16")
+ ,IF_ARCH_x86_64(IF_OS_darwin(sLit ".const\n.align 4",
+ sLit ".section .rodata.cst16\n\t.align 16")
+ ,IF_ARCH_powerpc(IF_OS_darwin(sLit ".const\n.align 4",
+ sLit ".section .rodata\n\t.align 4")
+ ,))))))
pprSectionHeader (OtherSection sec)
= panic "PprMach.pprSectionHeader: unknown section"
pprData (CmmAlign bytes) = pprAlign bytes
pprData (CmmDataLabel lbl) = pprLabel lbl
pprData (CmmString str) = pprASCII str
-pprData (CmmUninitialised bytes) = ptext SLIT(".space ") <> int bytes
+pprData (CmmUninitialised bytes) = ptext (sLit ".space ") <> int bytes
pprData (CmmStaticLit lit) = pprDataItem lit
pprGloblDecl :: CLabel -> Doc
pprGloblDecl lbl
| not (externallyVisibleCLabel lbl) = empty
- | otherwise = ptext IF_ARCH_sparc(SLIT(".global "),
- SLIT(".globl ")) <>
+ | otherwise = ptext IF_ARCH_sparc((sLit ".global "),
+ (sLit ".globl ")) <>
pprCLabel_asm lbl
pprTypeAndSizeDecl :: CLabel -> Doc
pprTypeAndSizeDecl lbl
#if linux_TARGET_OS
| not (externallyVisibleCLabel lbl) = empty
- | otherwise = ptext SLIT(".type ") <>
- pprCLabel_asm lbl <> ptext SLIT(", @object")
+ | otherwise = ptext (sLit ".type ") <>
+ pprCLabel_asm lbl <> ptext (sLit ", @object")
#else
= empty
#endif
= vcat (map do1 str) $$ do1 0
where
do1 :: Word8 -> Doc
- do1 w = ptext SLIT("\t.byte\t") <> int (fromIntegral w)
+ do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
pprAlign bytes =
- IF_ARCH_alpha(ptextSLIT(".align ") <> int pow2,
- IF_ARCH_i386(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes),
- IF_ARCH_x86_64(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes),
- IF_ARCH_sparc(ptext SLIT(".align ") <> int bytes,
- IF_ARCH_powerpc(ptext SLIT(".align ") <> int pow2,)))))
+ IF_ARCH_alpha(ptext (sLit ".align ") <> int pow2,
+ IF_ARCH_i386(ptext (sLit ".align ") <> int IF_OS_darwin(pow2,bytes),
+ IF_ARCH_x86_64(ptext (sLit ".align ") <> int IF_OS_darwin(pow2,bytes),
+ IF_ARCH_sparc(ptext (sLit ".align ") <> int bytes,
+ IF_ARCH_powerpc(ptext (sLit ".align ") <> int pow2,)))))
where
pow2 = log2 bytes
pprDataItem :: CmmLit -> Doc
pprDataItem lit
- = vcat (ppr_item (cmmLitRep lit) lit)
+ = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
where
imm = litToImm lit
-- These seem to be common:
- ppr_item I8 x = [ptext SLIT("\t.byte\t") <> pprImm imm]
- ppr_item I32 x = [ptext SLIT("\t.long\t") <> pprImm imm]
- ppr_item F32 (CmmFloat r _)
+ ppr_item II8 x = [ptext (sLit "\t.byte\t") <> pprImm imm]
+ ppr_item II32 x = [ptext (sLit "\t.long\t") <> pprImm imm]
+ ppr_item FF32 (CmmFloat r _)
= let bs = floatToBytes (fromRational r)
- in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
- ppr_item F64 (CmmFloat r _)
+ in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
+ ppr_item FF64 (CmmFloat r _)
= let bs = doubleToBytes (fromRational r)
- in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
+ in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
#if sparc_TARGET_ARCH
-- copy n paste of x86 version
- ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
- ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
+ ppr_item II16 x = [ptext (sLit "\t.short\t") <> pprImm imm]
+ ppr_item II64 x = [ptext (sLit "\t.quad\t") <> pprImm imm]
#endif
#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
- ppr_item I16 x = [ptext SLIT("\t.word\t") <> pprImm imm]
+ ppr_item II16 x = [ptext (sLit "\t.word\t") <> pprImm imm]
#endif
#if i386_TARGET_ARCH && darwin_TARGET_OS
- ppr_item I64 (CmmInt x _) =
- [ptext SLIT("\t.long\t")
+ ppr_item II64 (CmmInt x _) =
+ [ptext (sLit "\t.long\t")
<> int (fromIntegral (fromIntegral x :: Word32)),
- ptext SLIT("\t.long\t")
+ ptext (sLit "\t.long\t")
<> int (fromIntegral
(fromIntegral (x `shiftR` 32) :: Word32))]
#endif
#if i386_TARGET_ARCH || (darwin_TARGET_OS && x86_64_TARGET_ARCH)
- ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
+ ppr_item II64 x = [ptext (sLit "\t.quad\t") <> pprImm imm]
#endif
#if x86_64_TARGET_ARCH && !darwin_TARGET_OS
-- x86_64: binutils can't handle the R_X86_64_PC64 relocation
--
-- See Note [x86-64-relative] in includes/InfoTables.h
--
- ppr_item I64 x
+ ppr_item II64 x
| isRelativeReloc x =
- [ptext SLIT("\t.long\t") <> pprImm imm,
- ptext SLIT("\t.long\t0")]
+ [ptext (sLit "\t.long\t") <> pprImm imm,
+ ptext (sLit "\t.long\t0")]
| otherwise =
- [ptext SLIT("\t.quad\t") <> pprImm imm]
+ [ptext (sLit "\t.quad\t") <> pprImm imm]
where
isRelativeReloc (CmmLabelDiffOff _ _ _) = True
isRelativeReloc _ = False
#endif
#if powerpc_TARGET_ARCH
- ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
- ppr_item I64 (CmmInt x _) =
- [ptext SLIT("\t.long\t")
+ ppr_item II16 x = [ptext (sLit "\t.short\t") <> pprImm imm]
+ ppr_item II64 (CmmInt x _) =
+ [ptext (sLit "\t.long\t")
<> int (fromIntegral
(fromIntegral (x `shiftR` 32) :: Word32)),
- ptext SLIT("\t.long\t")
+ ptext (sLit "\t.long\t")
<> int (fromIntegral (fromIntegral x :: Word32))]
#endif
--pprInstr (COMMENT s) = empty -- nuke 'em
pprInstr (COMMENT s)
- = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
- ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ftext s))
- ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ftext s))
- ,IF_ARCH_x86_64( ((<>) (ptext SLIT("# ")) (ftext s))
+ = IF_ARCH_alpha( ((<>) (ptext (sLit "\t# ")) (ftext s))
+ ,IF_ARCH_sparc( ((<>) (ptext (sLit "! ")) (ftext s))
+ ,IF_ARCH_i386( ((<>) (ptext (sLit "# ")) (ftext s))
+ ,IF_ARCH_x86_64( ((<>) (ptext (sLit "# ")) (ftext s))
,IF_ARCH_powerpc( IF_OS_linux(
- ((<>) (ptext SLIT("# ")) (ftext s)),
- ((<>) (ptext SLIT("; ")) (ftext s)))
+ ((<>) (ptext (sLit "# ")) (ftext s)),
+ ((<>) (ptext (sLit "; ")) (ftext s)))
,)))))
pprInstr (DELTA d)
#if alpha_TARGET_ARCH
+pprInstr (SPILL reg slot)
+ = hcat [
+ ptext (sLit "\tSPILL"),
+ char '\t',
+ pprReg reg,
+ comma,
+ ptext (sLit "SLOT") <> parens (int slot)]
+
+pprInstr (RELOAD slot reg)
+ = hcat [
+ ptext (sLit "\tRELOAD"),
+ char '\t',
+ ptext (sLit "SLOT") <> parens (int slot),
+ comma,
+ pprReg reg]
+
pprInstr (LD size reg addr)
= hcat [
- ptext SLIT("\tld"),
+ ptext (sLit "\tld"),
pprSize size,
char '\t',
pprReg reg,
pprInstr (LDA reg addr)
= hcat [
- ptext SLIT("\tlda\t"),
+ ptext (sLit "\tlda\t"),
pprReg reg,
comma,
pprAddr addr
pprInstr (LDAH reg addr)
= hcat [
- ptext SLIT("\tldah\t"),
+ ptext (sLit "\tldah\t"),
pprReg reg,
comma,
pprAddr addr
pprInstr (LDGP reg addr)
= hcat [
- ptext SLIT("\tldgp\t"),
+ ptext (sLit "\tldgp\t"),
pprReg reg,
comma,
pprAddr addr
pprInstr (LDI size reg imm)
= hcat [
- ptext SLIT("\tldi"),
+ ptext (sLit "\tldi"),
pprSize size,
char '\t',
pprReg reg,
pprInstr (ST size reg addr)
= hcat [
- ptext SLIT("\tst"),
+ ptext (sLit "\tst"),
pprSize size,
char '\t',
pprReg reg,
pprInstr (CLR reg)
= hcat [
- ptext SLIT("\tclr\t"),
+ ptext (sLit "\tclr\t"),
pprReg reg
]
pprInstr (ABS size ri reg)
= hcat [
- ptext SLIT("\tabs"),
+ ptext (sLit "\tabs"),
pprSize size,
char '\t',
pprRI ri,
pprInstr (NEG size ov ri reg)
= hcat [
- ptext SLIT("\tneg"),
+ ptext (sLit "\tneg"),
pprSize size,
- if ov then ptext SLIT("v\t") else char '\t',
+ if ov then ptext (sLit "v\t") else char '\t',
pprRI ri,
comma,
pprReg reg
pprInstr (ADD size ov reg1 ri reg2)
= hcat [
- ptext SLIT("\tadd"),
+ ptext (sLit "\tadd"),
pprSize size,
- if ov then ptext SLIT("v\t") else char '\t',
+ if ov then ptext (sLit "v\t") else char '\t',
pprReg reg1,
comma,
pprRI ri,
pprInstr (SADD size scale reg1 ri reg2)
= hcat [
- ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
- ptext SLIT("add"),
+ ptext (case scale of {{-UNUSED:L -> (sLit "\ts4");-} Q -> (sLit "\ts8")}),
+ ptext (sLit "add"),
pprSize size,
char '\t',
pprReg reg1,
pprInstr (SUB size ov reg1 ri reg2)
= hcat [
- ptext SLIT("\tsub"),
+ ptext (sLit "\tsub"),
pprSize size,
- if ov then ptext SLIT("v\t") else char '\t',
+ if ov then ptext (sLit "v\t") else char '\t',
pprReg reg1,
comma,
pprRI ri,
pprInstr (SSUB size scale reg1 ri reg2)
= hcat [
- ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
- ptext SLIT("sub"),
+ ptext (case scale of {{-UNUSED:L -> (sLit "\ts4");-} Q -> (sLit "\ts8")}),
+ ptext (sLit "sub"),
pprSize size,
char '\t',
pprReg reg1,
pprInstr (MUL size ov reg1 ri reg2)
= hcat [
- ptext SLIT("\tmul"),
+ ptext (sLit "\tmul"),
pprSize size,
- if ov then ptext SLIT("v\t") else char '\t',
+ if ov then ptext (sLit "v\t") else char '\t',
pprReg reg1,
comma,
pprRI ri,
pprInstr (DIV size uns reg1 ri reg2)
= hcat [
- ptext SLIT("\tdiv"),
+ ptext (sLit "\tdiv"),
pprSize size,
- if uns then ptext SLIT("u\t") else char '\t',
+ if uns then ptext (sLit "u\t") else char '\t',
pprReg reg1,
comma,
pprRI ri,
pprInstr (REM size uns reg1 ri reg2)
= hcat [
- ptext SLIT("\trem"),
+ ptext (sLit "\trem"),
pprSize size,
- if uns then ptext SLIT("u\t") else char '\t',
+ if uns then ptext (sLit "u\t") else char '\t',
pprReg reg1,
comma,
pprRI ri,
pprInstr (NOT ri reg)
= hcat [
- ptext SLIT("\tnot"),
+ ptext (sLit "\tnot"),
char '\t',
pprRI ri,
comma,
pprReg reg
]
-pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
-pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
-pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
-pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
-pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
-pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
+pprInstr (AND reg1 ri reg2) = pprRegRIReg (sLit "and") reg1 ri reg2
+pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg (sLit "andnot") reg1 ri reg2
+pprInstr (OR reg1 ri reg2) = pprRegRIReg (sLit "or") reg1 ri reg2
+pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg (sLit "ornot") reg1 ri reg2
+pprInstr (XOR reg1 ri reg2) = pprRegRIReg (sLit "xor") reg1 ri reg2
+pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg (sLit "xornot") reg1 ri reg2
-pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
-pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
-pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
+pprInstr (SLL reg1 ri reg2) = pprRegRIReg (sLit "sll") reg1 ri reg2
+pprInstr (SRL reg1 ri reg2) = pprRegRIReg (sLit "srl") reg1 ri reg2
+pprInstr (SRA reg1 ri reg2) = pprRegRIReg (sLit "sra") reg1 ri reg2
-pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
-pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
+pprInstr (ZAP reg1 ri reg2) = pprRegRIReg (sLit "zap") reg1 ri reg2
+pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg (sLit "zapnot") reg1 ri reg2
-pprInstr (NOP) = ptext SLIT("\tnop")
+pprInstr (NOP) = ptext (sLit "\tnop")
pprInstr (CMP cond reg1 ri reg2)
= hcat [
- ptext SLIT("\tcmp"),
+ ptext (sLit "\tcmp"),
pprCond cond,
char '\t',
pprReg reg1,
pprInstr (FCLR reg)
= hcat [
- ptext SLIT("\tfclr\t"),
+ ptext (sLit "\tfclr\t"),
pprReg reg
]
pprInstr (FABS reg1 reg2)
= hcat [
- ptext SLIT("\tfabs\t"),
+ ptext (sLit "\tfabs\t"),
pprReg reg1,
comma,
pprReg reg2
pprInstr (FNEG size reg1 reg2)
= hcat [
- ptext SLIT("\tneg"),
+ ptext (sLit "\tneg"),
pprSize size,
char '\t',
pprReg reg1,
pprReg reg2
]
-pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
-pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
-pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
-pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
+pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "add") size reg1 reg2 reg3
+pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "div") size reg1 reg2 reg3
+pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "mul") size reg1 reg2 reg3
+pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "sub") size reg1 reg2 reg3
pprInstr (CVTxy size1 size2 reg1 reg2)
= hcat [
- ptext SLIT("\tcvt"),
+ ptext (sLit "\tcvt"),
pprSize size1,
- case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
+ case size2 of {Q -> ptext (sLit "qc"); _ -> pprSize size2},
char '\t',
pprReg reg1,
comma,
pprInstr (FCMP size cond reg1 reg2 reg3)
= hcat [
- ptext SLIT("\tcmp"),
+ ptext (sLit "\tcmp"),
pprSize size,
pprCond cond,
char '\t',
pprInstr (FMOV reg1 reg2)
= hcat [
- ptext SLIT("\tfmov\t"),
+ ptext (sLit "\tfmov\t"),
pprReg reg1,
comma,
pprReg reg2
pprInstr (BI cond reg lab)
= hcat [
- ptext SLIT("\tb"),
+ ptext (sLit "\tb"),
pprCond cond,
char '\t',
pprReg reg,
pprInstr (BF cond reg lab)
= hcat [
- ptext SLIT("\tfb"),
+ ptext (sLit "\tfb"),
pprCond cond,
char '\t',
pprReg reg,
]
pprInstr (BR lab)
- = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
+ = (<>) (ptext (sLit "\tbr\t")) (pprImm lab)
pprInstr (JMP reg addr hint)
= hcat [
- ptext SLIT("\tjmp\t"),
+ ptext (sLit "\tjmp\t"),
pprReg reg,
comma,
pprAddr addr,
]
pprInstr (BSR imm n)
- = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
+ = (<>) (ptext (sLit "\tbsr\t")) (pprImm imm)
pprInstr (JSR reg addr n)
= hcat [
- ptext SLIT("\tjsr\t"),
+ ptext (sLit "\tjsr\t"),
pprReg reg,
comma,
pprAddr addr
pprInstr (FUNBEGIN clab)
= hcat [
if (externallyVisibleCLabel clab) then
- hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
+ hcat [ptext (sLit "\t.globl\t"), pp_lab, char '\n']
else
empty,
- ptext SLIT("\t.ent "),
+ ptext (sLit "\t.ent "),
pp_lab,
char '\n',
pp_lab,
pp_lab = pprCLabel_asm clab
-- NEVER use commas within those string literals, cpp will ruin your day
- pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
- pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
- ptext SLIT("4240"), char ',',
- ptext SLIT("$26"), char ',',
- ptext SLIT("0\n\t.prologue 1") ]
+ pp_ldgp = hcat [ ptext (sLit ":\n\tldgp $29"), char ',', ptext (sLit "0($27)\n") ]
+ pp_frame = hcat [ ptext (sLit "..ng:\n\t.frame $30"), char ',',
+ ptext (sLit "4240"), char ',',
+ ptext (sLit "$26"), char ',',
+ ptext (sLit "0\n\t.prologue 1") ]
pprInstr (FUNEND clab)
- = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
+ = (<>) (ptext (sLit "\t.align 4\n\t.end ")) (pprCLabel_asm clab)
\end{code}
Continue with Alpha-only printing bits and bobs:
#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-{- -- BUGS: changed for coloring allocator
-pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack -- write a pass for this and patch linear allocator with it
- | src == dst
- =
-#if 0 /* #ifdef DEBUG */
- (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
-#else
- empty
-#endif
--}
+pprInstr (SPILL reg slot)
+ = hcat [
+ ptext (sLit "\tSPILL"),
+ char ' ',
+ pprUserReg reg,
+ comma,
+ ptext (sLit "SLOT") <> parens (int slot)]
+
+pprInstr (RELOAD slot reg)
+ = hcat [
+ ptext (sLit "\tRELOAD"),
+ char ' ',
+ ptext (sLit "SLOT") <> parens (int slot),
+ comma,
+ pprUserReg reg]
pprInstr (MOV size src dst)
- = pprSizeOpOp SLIT("mov") size src dst
+ = pprSizeOpOp (sLit "mov") size src dst
-pprInstr (MOVZxL I32 src dst) = pprSizeOpOp SLIT("mov") I32 src dst
+pprInstr (MOVZxL II32 src dst) = pprSizeOpOp (sLit "mov") II32 src dst
-- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
-- movl. But we represent it as a MOVZxL instruction, because
-- the reg alloc would tend to throw away a plain reg-to-reg
-- move, and we still want it to do that.
-pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes I32 src dst
+pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce (sLit "movz") sizes II32 src dst
-- zero-extension only needs to extend to 32 bits: on x86_64,
-- the remaining zero-extension to 64 bits is automatic, and the 32-bit
-- instruction is shorter.
-pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes wordRep src dst
+pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce (sLit "movs") sizes wordSize src dst
-- here we do some patching, since the physical registers are only set late
-- in the code generation.
pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
| reg1 == reg3
- = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
+ = pprSizeOpOp (sLit "add") size (OpReg reg2) dst
pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
| reg2 == reg3
- = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
+ = pprSizeOpOp (sLit "add") size (OpReg reg1) dst
pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
| reg1 == reg3
= pprInstr (ADD size (OpImm displ) dst)
-pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
+pprInstr (LEA size src dst) = pprSizeOpOp (sLit "lea") size src dst
pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
- = pprSizeOp SLIT("dec") size dst
+ = pprSizeOp (sLit "dec") size dst
pprInstr (ADD size (OpImm (ImmInt 1)) dst)
- = pprSizeOp SLIT("inc") size dst
+ = pprSizeOp (sLit "inc") size dst
pprInstr (ADD size src dst)
- = pprSizeOpOp SLIT("add") size src dst
+ = pprSizeOpOp (sLit "add") size src dst
pprInstr (ADC size src dst)
- = pprSizeOpOp SLIT("adc") size src dst
-pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
-pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
+ = pprSizeOpOp (sLit "adc") size src dst
+pprInstr (SUB size src dst) = pprSizeOpOp (sLit "sub") size src dst
+pprInstr (IMUL size op1 op2) = pprSizeOpOp (sLit "imul") size op1 op2
{- A hack. The Intel documentation says that "The two and three
operand forms [of IMUL] may also be used with unsigned operands
however, cannot be used to determine if the upper half of the
result is non-zero." So there.
-}
-pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
-pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
+pprInstr (AND size src dst) = pprSizeOpOp (sLit "and") size src dst
+pprInstr (OR size src dst) = pprSizeOpOp (sLit "or") size src dst
-pprInstr (XOR F32 src dst) = pprOpOp SLIT("xorps") F32 src dst
-pprInstr (XOR F64 src dst) = pprOpOp SLIT("xorpd") F64 src dst
-pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
+pprInstr (XOR FF32 src dst) = pprOpOp (sLit "xorps") FF32 src dst
+pprInstr (XOR FF64 src dst) = pprOpOp (sLit "xorpd") FF64 src dst
+pprInstr (XOR size src dst) = pprSizeOpOp (sLit "xor") size src dst
-pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
-pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
+pprInstr (NOT size op) = pprSizeOp (sLit "not") size op
+pprInstr (NEGI size op) = pprSizeOp (sLit "neg") size op
-pprInstr (SHL size src dst) = pprShift SLIT("shl") size src dst
-pprInstr (SAR size src dst) = pprShift SLIT("sar") size src dst
-pprInstr (SHR size src dst) = pprShift SLIT("shr") size src dst
+pprInstr (SHL size src dst) = pprShift (sLit "shl") size src dst
+pprInstr (SAR size src dst) = pprShift (sLit "sar") size src dst
+pprInstr (SHR size src dst) = pprShift (sLit "shr") size src dst
-pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src
+pprInstr (BT size imm src) = pprSizeImmOp (sLit "bt") size imm src
pprInstr (CMP size src dst)
- | isFloatingRep size = pprSizeOpOp SLIT("ucomi") size src dst -- SSE2
- | otherwise = pprSizeOpOp SLIT("cmp") size src dst
+ | is_float size = pprSizeOpOp (sLit "ucomi") size src dst -- SSE2
+ | otherwise = pprSizeOpOp (sLit "cmp") size src dst
+ where
+ -- This predicate is needed here and nowhere else
+ is_float FF32 = True
+ is_float FF64 = True
+ is_float FF80 = True
+ is_float other = False
-pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
-pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
-pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
+pprInstr (TEST size src dst) = pprSizeOpOp (sLit "test") size src dst
+pprInstr (PUSH size op) = pprSizeOp (sLit "push") size op
+pprInstr (POP size op) = pprSizeOp (sLit "pop") size op
-- both unused (SDM):
--- pprInstr PUSHA = ptext SLIT("\tpushal")
--- pprInstr POPA = ptext SLIT("\tpopal")
+-- pprInstr PUSHA = ptext (sLit "\tpushal")
+-- pprInstr POPA = ptext (sLit "\tpopal")
-pprInstr NOP = ptext SLIT("\tnop")
-pprInstr (CLTD I32) = ptext SLIT("\tcltd")
-pprInstr (CLTD I64) = ptext SLIT("\tcqto")
+pprInstr NOP = ptext (sLit "\tnop")
+pprInstr (CLTD II32) = ptext (sLit "\tcltd")
+pprInstr (CLTD II64) = ptext (sLit "\tcqto")
-pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand I8 op)
+pprInstr (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand II8 op)
pprInstr (JXX cond (BlockId id))
- = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
+ = pprCondInstr (sLit "j") cond (pprCLabel_asm lab)
where lab = mkAsmTempLabel id
-pprInstr (JXX_GBL cond imm) = pprCondInstr SLIT("j") cond (pprImm imm)
+pprInstr (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm imm)
-pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
-pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep op)
+pprInstr (JMP (OpImm imm)) = (<>) (ptext (sLit "\tjmp ")) (pprImm imm)
+pprInstr (JMP op) = (<>) (ptext (sLit "\tjmp *")) (pprOperand wordSize op)
pprInstr (JMP_TBL op ids) = pprInstr (JMP op)
-pprInstr (CALL (Left imm) _) = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
-pprInstr (CALL (Right reg) _) = (<>) (ptext SLIT("\tcall *")) (pprReg wordRep reg)
+pprInstr (CALL (Left imm) _) = (<>) (ptext (sLit "\tcall ")) (pprImm imm)
+pprInstr (CALL (Right reg) _) = (<>) (ptext (sLit "\tcall *")) (pprReg wordSize reg)
-pprInstr (IDIV sz op) = pprSizeOp SLIT("idiv") sz op
-pprInstr (DIV sz op) = pprSizeOp SLIT("div") sz op
-pprInstr (IMUL2 sz op) = pprSizeOp SLIT("imul") sz op
+pprInstr (IDIV sz op) = pprSizeOp (sLit "idiv") sz op
+pprInstr (DIV sz op) = pprSizeOp (sLit "div") sz op
+pprInstr (IMUL2 sz op) = pprSizeOp (sLit "imul") sz op
#if x86_64_TARGET_ARCH
-pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("mul") size op1 op2
+pprInstr (MUL size op1 op2) = pprSizeOpOp (sLit "mul") size op1 op2
-pprInstr (FDIV size op1 op2) = pprSizeOpOp SLIT("div") size op1 op2
+pprInstr (FDIV size op1 op2) = pprSizeOpOp (sLit "div") size op1 op2
-pprInstr (CVTSS2SD from to) = pprRegReg SLIT("cvtss2sd") from to
-pprInstr (CVTSD2SS from to) = pprRegReg SLIT("cvtsd2ss") from to
-pprInstr (CVTTSS2SIQ from to) = pprOpReg SLIT("cvttss2siq") from to
-pprInstr (CVTTSD2SIQ from to) = pprOpReg SLIT("cvttsd2siq") from to
-pprInstr (CVTSI2SS from to) = pprOpReg SLIT("cvtsi2ssq") from to
-pprInstr (CVTSI2SD from to) = pprOpReg SLIT("cvtsi2sdq") from to
+pprInstr (CVTSS2SD from to) = pprRegReg (sLit "cvtss2sd") from to
+pprInstr (CVTSD2SS from to) = pprRegReg (sLit "cvtsd2ss") from to
+pprInstr (CVTTSS2SIQ from to) = pprOpReg (sLit "cvttss2siq") from to
+pprInstr (CVTTSD2SIQ from to) = pprOpReg (sLit "cvttsd2siq") from to
+pprInstr (CVTSI2SS from to) = pprOpReg (sLit "cvtsi2ssq") from to
+pprInstr (CVTSI2SD from to) = pprOpReg (sLit "cvtsi2sdq") from to
#endif
-- FETCHGOT for PIC on ELF platforms
pprInstr (FETCHGOT reg)
- = vcat [ ptext SLIT("\tcall 1f"),
- hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ],
- hcat [ ptext SLIT("\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
- pprReg I32 reg ]
+ = vcat [ ptext (sLit "\tcall 1f"),
+ hcat [ ptext (sLit "1:\tpopl\t"), pprReg II32 reg ],
+ hcat [ ptext (sLit "\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
+ pprReg II32 reg ]
]
-- FETCHPC for PIC on Darwin/x86
-- (Terminology note: the IP is called Program Counter on PPC,
-- and it's a good thing to use the same name on both platforms)
pprInstr (FETCHPC reg)
- = vcat [ ptext SLIT("\tcall 1f"),
- hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ]
+ = vcat [ ptext (sLit "\tcall 1f"),
+ hcat [ ptext (sLit "1:\tpopl\t"), pprReg II32 reg ]
]
pprInstr g@(GFTOI src dst)
= pprInstr (GDTOI src dst)
pprInstr g@(GDTOI src dst)
- = pprG g (hcat [gtab, text "subl $4, %esp ; ",
- gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ",
- pprReg I32 dst])
+ = pprG g (vcat [
+ hcat [gtab, text "subl $8, %esp ; fnstcw 4(%esp)"],
+ hcat [gtab, gpush src 0],
+ hcat [gtab, text "movzwl 4(%esp), ", reg,
+ text " ; orl $0xC00, ", reg],
+ hcat [gtab, text "movl ", reg, text ", 0(%esp) ; fldcw 0(%esp)"],
+ hcat [gtab, text "fistpl 0(%esp)"],
+ hcat [gtab, text "fldcw 4(%esp) ; movl 0(%esp), ", reg],
+ hcat [gtab, text "addl $8, %esp"]
+ ])
+ where
+ reg = pprReg II32 dst
pprInstr g@(GITOF src dst)
= pprInstr (GITOD src dst)
pprInstr g@(GITOD src dst)
- = pprG g (hcat [gtab, text "pushl ", pprReg I32 src,
+ = pprG g (hcat [gtab, text "pushl ", pprReg II32 src,
text " ; ffree %st(7); fildl (%esp) ; ",
gpop dst 1, text " ; addl $4,%esp"])
pprInstr g@(GSQRT sz src dst)
= pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
hcat [gtab, gcoerceto sz, gpop dst 1])
-pprInstr g@(GSIN sz src dst)
- = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
- hcat [gtab, gcoerceto sz, gpop dst 1])
-pprInstr g@(GCOS sz src dst)
- = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
- hcat [gtab, gcoerceto sz, gpop dst 1])
-pprInstr g@(GTAN sz src dst)
- = pprG g (hcat [gtab, text "ffree %st(6) ; ",
- gpush src 0, text " ; fptan ; ",
- text " fstp %st(0)"] $$
- hcat [gtab, gcoerceto sz, gpop dst 1])
+pprInstr g@(GSIN sz l1 l2 src dst)
+ = pprG g (pprTrigOp "fsin" False l1 l2 src dst sz)
+pprInstr g@(GCOS sz l1 l2 src dst)
+ = pprG g (pprTrigOp "fcos" False l1 l2 src dst sz)
+pprInstr g@(GTAN sz l1 l2 src dst)
+ = pprG g (pprTrigOp "fptan" True l1 l2 src dst sz)
-- In the translations for GADD, GMUL, GSUB and GDIV,
-- the first two cases are mere optimisations. The otherwise clause
pprInstr GFREE
- = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
- ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
+ = vcat [ ptext (sLit "\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
+ ptext (sLit "\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
]
+pprTrigOp :: String -> Bool -> CLabel -> CLabel -> Reg -> Reg -> Size -> Doc
+pprTrigOp op -- fsin, fcos or fptan
+ isTan -- we need a couple of extra steps if we're doing tan
+ l1 l2 -- internal labels for us to use
+ src dst sz
+ = -- We'll be needing %eax later on
+ hcat [gtab, text "pushl %eax;"] $$
+ -- tan is going to use an extra space on the FP stack
+ (if isTan then hcat [gtab, text "ffree %st(6)"] else empty) $$
+ -- First put the value in %st(0) and try to apply the op to it
+ hcat [gpush src 0, text ("; " ++ op)] $$
+ -- Now look to see if C2 was set (overflow, |value| >= 2^63)
+ hcat [gtab, text "fnstsw %ax"] $$
+ hcat [gtab, text "test $0x400,%eax"] $$
+ -- If we were in bounds then jump to the end
+ hcat [gtab, text "je " <> pprCLabel_asm l1] $$
+ -- Otherwise we need to shrink the value. Start by
+ -- loading pi, doubleing it (by adding it to itself),
+ -- and then swapping pi with the value, so the value we
+ -- want to apply op to is in %st(0) again
+ hcat [gtab, text "ffree %st(7); fldpi"] $$
+ hcat [gtab, text "fadd %st(0),%st"] $$
+ hcat [gtab, text "fxch %st(1)"] $$
+ -- Now we have a loop in which we make the value smaller,
+ -- see if it's small enough, and loop if not
+ (pprCLabel_asm l2 <> char ':') $$
+ hcat [gtab, text "fprem1"] $$
+ -- My Debian libc uses fstsw here for the tan code, but I can't
+ -- see any reason why it should need to be different for tan.
+ hcat [gtab, text "fnstsw %ax"] $$
+ hcat [gtab, text "test $0x400,%eax"] $$
+ hcat [gtab, text "jne " <> pprCLabel_asm l2] $$
+ hcat [gtab, text "fstp %st(1)"] $$
+ hcat [gtab, text op] $$
+ (pprCLabel_asm l1 <> char ':') $$
+ -- Pop the 1.0 tan gave us
+ (if isTan then hcat [gtab, text "fstp %st(0)"] else empty) $$
+ -- Restore %eax
+ hcat [gtab, text "popl %eax;"] $$
+ -- And finally make the result the right size
+ hcat [gtab, gcoerceto sz, gpop dst 1]
+
--------------------------
-- coerce %st(0) to the specified size
-gcoerceto F64 = empty
-gcoerceto F32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
+gcoerceto FF64 = empty
+gcoerceto FF32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
gpush reg offset
= hcat [text "ffree %st(7) ; fld ", greg reg offset]
pprG fake actual
= (char '#' <> pprGInstr fake) $$ actual
-pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") F64 src dst
-pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
-pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
+pprGInstr (GMOV src dst) = pprSizeRegReg (sLit "gmov") FF64 src dst
+pprGInstr (GLD sz src dst) = pprSizeAddrReg (sLit "gld") sz src dst
+pprGInstr (GST sz src dst) = pprSizeRegAddr (sLit "gst") sz src dst
-pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") F64 dst
-pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") F64 dst
+pprGInstr (GLDZ dst) = pprSizeReg (sLit "gldz") FF64 dst
+pprGInstr (GLD1 dst) = pprSizeReg (sLit "gld1") FF64 dst
-pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F32 I32 src dst
-pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") F64 I32 src dst
+pprGInstr (GFTOI src dst) = pprSizeSizeRegReg (sLit "gftoi") FF32 II32 src dst
+pprGInstr (GDTOI src dst) = pprSizeSizeRegReg (sLit "gdtoi") FF64 II32 src dst
-pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") I32 F32 src dst
-pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") I32 F64 src dst
+pprGInstr (GITOF src dst) = pprSizeSizeRegReg (sLit "gitof") II32 FF32 src dst
+pprGInstr (GITOD src dst) = pprSizeSizeRegReg (sLit "gitod") II32 FF64 src dst
-pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") F64 co src dst
-pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
-pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
-pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
-pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
-pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
-pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
+pprGInstr (GCMP co src dst) = pprCondRegReg (sLit "gcmp_") FF64 co src dst
+pprGInstr (GABS sz src dst) = pprSizeRegReg (sLit "gabs") sz src dst
+pprGInstr (GNEG sz src dst) = pprSizeRegReg (sLit "gneg") sz src dst
+pprGInstr (GSQRT sz src dst) = pprSizeRegReg (sLit "gsqrt") sz src dst
+pprGInstr (GSIN sz _ _ src dst) = pprSizeRegReg (sLit "gsin") sz src dst
+pprGInstr (GCOS sz _ _ src dst) = pprSizeRegReg (sLit "gcos") sz src dst
+pprGInstr (GTAN sz _ _ src dst) = pprSizeRegReg (sLit "gtan") sz src dst
-pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
-pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
-pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
-pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
+pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg (sLit "gadd") sz src1 src2 dst
+pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg (sLit "gsub") sz src1 src2 dst
+pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg (sLit "gmul") sz src1 src2 dst
+pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg (sLit "gdiv") sz src1 src2 dst
#endif
#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
pprDollImm :: Imm -> Doc
-pprDollImm i = ptext SLIT("$") <> pprImm i
+pprDollImm i = ptext (sLit "$") <> pprImm i
-pprOperand :: MachRep -> Operand -> Doc
+pprOperand :: Size -> Operand -> Doc
pprOperand s (OpReg r) = pprReg s r
pprOperand s (OpImm i) = pprDollImm i
pprOperand s (OpAddr ea) = pprAddr ea
pprMnemonic_ name =
char '\t' <> ptext name <> space
-pprMnemonic :: LitString -> MachRep -> Doc
+pprMnemonic :: LitString -> Size -> Doc
pprMnemonic name size =
char '\t' <> ptext name <> pprSize size <> space
-pprSizeImmOp :: LitString -> MachRep -> Imm -> Operand -> Doc
+pprSizeImmOp :: LitString -> Size -> Imm -> Operand -> Doc
pprSizeImmOp name size imm op1
= hcat [
pprMnemonic name size,
pprOperand size op1
]
-pprSizeOp :: LitString -> MachRep -> Operand -> Doc
+pprSizeOp :: LitString -> Size -> Operand -> Doc
pprSizeOp name size op1
= hcat [
pprMnemonic name size,
pprOperand size op1
]
-pprSizeOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
+pprSizeOpOp :: LitString -> Size -> Operand -> Operand -> Doc
pprSizeOpOp name size op1 op2
= hcat [
pprMnemonic name size,
pprOperand size op2
]
-pprOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
+pprOpOp :: LitString -> Size -> Operand -> Operand -> Doc
pprOpOp name size op1 op2
= hcat [
pprMnemonic_ name,
pprOperand size op2
]
-pprSizeReg :: LitString -> MachRep -> Reg -> Doc
+pprSizeReg :: LitString -> Size -> Reg -> Doc
pprSizeReg name size reg1
= hcat [
pprMnemonic name size,
pprReg size reg1
]
-pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
+pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
pprSizeRegReg name size reg1 reg2
= hcat [
pprMnemonic name size,
pprRegReg name reg1 reg2
= hcat [
pprMnemonic_ name,
- pprReg wordRep reg1,
+ pprReg wordSize reg1,
comma,
- pprReg wordRep reg2
+ pprReg wordSize reg2
]
pprOpReg :: LitString -> Operand -> Reg -> Doc
pprOpReg name op1 reg2
= hcat [
pprMnemonic_ name,
- pprOperand wordRep op1,
+ pprOperand wordSize op1,
comma,
- pprReg wordRep reg2
+ pprReg wordSize reg2
]
-pprCondRegReg :: LitString -> MachRep -> Cond -> Reg -> Reg -> Doc
+pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> Doc
pprCondRegReg name size cond reg1 reg2
= hcat [
char '\t',
pprReg size reg2
]
-pprSizeSizeRegReg :: LitString -> MachRep -> MachRep -> Reg -> Reg -> Doc
+pprSizeSizeRegReg :: LitString -> Size -> Size -> Reg -> Reg -> Doc
pprSizeSizeRegReg name size1 size2 reg1 reg2
= hcat [
char '\t',
pprReg size2 reg2
]
-pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
+pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
pprSizeRegRegReg name size reg1 reg2 reg3
= hcat [
pprMnemonic name size,
pprReg size reg3
]
-pprSizeAddrReg :: LitString -> MachRep -> AddrMode -> Reg -> Doc
+pprSizeAddrReg :: LitString -> Size -> AddrMode -> Reg -> Doc
pprSizeAddrReg name size op dst
= hcat [
pprMnemonic name size,
pprReg size dst
]
-pprSizeRegAddr :: LitString -> MachRep -> Reg -> AddrMode -> Doc
+pprSizeRegAddr :: LitString -> Size -> Reg -> AddrMode -> Doc
pprSizeRegAddr name size src op
= hcat [
pprMnemonic name size,
pprAddr op
]
-pprShift :: LitString -> MachRep -> Operand -> Operand -> Doc
+pprShift :: LitString -> Size -> Operand -> Operand -> Doc
pprShift name size src dest
= hcat [
pprMnemonic name size,
- pprOperand I8 src, -- src is 8-bit sized
+ pprOperand II8 src, -- src is 8-bit sized
comma,
pprOperand size dest
]
-pprSizeOpOpCoerce :: LitString -> MachRep -> MachRep -> Operand -> Operand -> Doc
+pprSizeOpOpCoerce :: LitString -> Size -> Size -> Operand -> Operand -> Doc
pprSizeOpOpCoerce name size1 size2 op1 op2
= hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
pprOperand size1 op1,
-- reads (bytearrays).
--
+pprInstr (SPILL reg slot)
+ = hcat [
+ ptext (sLit "\tSPILL"),
+ char '\t',
+ pprReg reg,
+ comma,
+ ptext (sLit "SLOT") <> parens (int slot)]
+
+pprInstr (RELOAD slot reg)
+ = hcat [
+ ptext (sLit "\tRELOAD"),
+ char '\t',
+ ptext (sLit "SLOT") <> parens (int slot),
+ comma,
+ pprReg reg]
+
-- Translate to the following:
-- add g1,g2,g1
-- ld [g1],%fn
-- ld [g1+4],%f(n+1)
-- sub g1,g2,g1 -- to restore g1
-pprInstr (LD F64 (AddrRegReg g1 g2) reg)
+pprInstr (LD FF64 (AddrRegReg g1 g2) reg)
= vcat [
- hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
+ hcat [ptext (sLit "\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
- hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
- hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
+ hcat [pp_ld_lbracket, pprReg g1, ptext (sLit "+4]"), comma, pprReg (fPair reg)],
+ hcat [ptext (sLit "\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
]
-- Translate to
-- ld [addr],%fn
-- ld [addr+4],%f(n+1)
-pprInstr (LD F64 addr reg) | isJust off_addr
+pprInstr (LD FF64 addr reg) | isJust off_addr
= vcat [
hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
pprInstr (LD size addr reg)
= hcat [
- ptext SLIT("\tld"),
+ ptext (sLit "\tld"),
pprSize size,
char '\t',
lbrack,
-- st %fn,[g1]
-- st %f(n+1),[g1+4]
-- sub g1,g2,g1 -- to restore g1
-pprInstr (ST F64 reg (AddrRegReg g1 g2))
+pprInstr (ST FF64 reg (AddrRegReg g1 g2))
= vcat [
- hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
- hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
+ hcat [ptext (sLit "\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
+ hcat [ptext (sLit "\tst\t"), pprReg reg, pp_comma_lbracket,
pprReg g1, rbrack],
- hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
- pprReg g1, ptext SLIT("+4]")],
- hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
+ hcat [ptext (sLit "\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
+ pprReg g1, ptext (sLit "+4]")],
+ hcat [ptext (sLit "\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
]
-- Translate to
-- st %fn,[addr]
-- st %f(n+1),[addr+4]
-pprInstr (ST F64 reg addr) | isJust off_addr
+pprInstr (ST FF64 reg addr) | isJust off_addr
= vcat [
- hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
+ hcat [ptext (sLit "\tst\t"), pprReg reg, pp_comma_lbracket,
pprAddr addr, rbrack],
- hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
+ hcat [ptext (sLit "\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
pprAddr addr2, rbrack]
]
where
pprInstr (ST size reg addr)
= hcat [
- ptext SLIT("\tst"),
+ ptext (sLit "\tst"),
pprStSize size,
char '\t',
pprReg reg,
pprInstr (ADD x cc reg1 ri reg2)
| not x && not cc && riZero ri
- = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
+ = hcat [ ptext (sLit "\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
| otherwise
- = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
+ = pprRegRIReg (if x then sLit "addx" else sLit "add") cc reg1 ri reg2
pprInstr (SUB x cc reg1 ri reg2)
| not x && cc && reg2 == g0
- = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
+ = hcat [ ptext (sLit "\tcmp\t"), pprReg reg1, comma, pprRI ri ]
| not x && not cc && riZero ri
- = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
+ = hcat [ ptext (sLit "\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
| otherwise
- = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
+ = pprRegRIReg (if x then sLit "subx" else sLit "sub") cc reg1 ri reg2
-pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
-pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
+pprInstr (AND b reg1 ri reg2) = pprRegRIReg (sLit "and") b reg1 ri reg2
+pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg (sLit "andn") b reg1 ri reg2
pprInstr (OR b reg1 ri reg2)
| not b && reg1 == g0
- = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
+ = let doit = hcat [ ptext (sLit "\tmov\t"), pprRI ri, comma, pprReg reg2 ]
in case ri of
RIReg rrr | rrr == reg2 -> empty
other -> doit
| otherwise
- = pprRegRIReg SLIT("or") b reg1 ri reg2
+ = pprRegRIReg (sLit "or") b reg1 ri reg2
-pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
+pprInstr (ORN b reg1 ri reg2) = pprRegRIReg (sLit "orn") b reg1 ri reg2
-pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
-pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
+pprInstr (XOR b reg1 ri reg2) = pprRegRIReg (sLit "xor") b reg1 ri reg2
+pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg (sLit "xnor") b reg1 ri reg2
-pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
-pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
-pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
+pprInstr (SLL reg1 ri reg2) = pprRegRIReg (sLit "sll") False reg1 ri reg2
+pprInstr (SRL reg1 ri reg2) = pprRegRIReg (sLit "srl") False reg1 ri reg2
+pprInstr (SRA reg1 ri reg2) = pprRegRIReg (sLit "sra") False reg1 ri reg2
-pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
-pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul") b reg1 ri reg2
-pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul") b reg1 ri reg2
+pprInstr (RDY rd) = ptext (sLit "\trd\t%y,") <> pprReg rd
+pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg (sLit "smul") b reg1 ri reg2
+pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg (sLit "umul") b reg1 ri reg2
pprInstr (SETHI imm reg)
= hcat [
- ptext SLIT("\tsethi\t"),
+ ptext (sLit "\tsethi\t"),
pprImm imm,
comma,
pprReg reg
]
-pprInstr NOP = ptext SLIT("\tnop")
+pprInstr NOP = ptext (sLit "\tnop")
-pprInstr (FABS F32 reg1 reg2) = pprSizeRegReg SLIT("fabs") F32 reg1 reg2
-pprInstr (FABS F64 reg1 reg2)
- = (<>) (pprSizeRegReg SLIT("fabs") F32 reg1 reg2)
+pprInstr (FABS FF32 reg1 reg2) = pprSizeRegReg (sLit "fabs") FF32 reg1 reg2
+pprInstr (FABS FF64 reg1 reg2)
+ = (<>) (pprSizeRegReg (sLit "fabs") FF32 reg1 reg2)
(if (reg1 == reg2) then empty
else (<>) (char '\n')
- (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
+ (pprSizeRegReg (sLit "fmov") FF32 (fPair reg1) (fPair reg2)))
pprInstr (FADD size reg1 reg2 reg3)
- = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
+ = pprSizeRegRegReg (sLit "fadd") size reg1 reg2 reg3
pprInstr (FCMP e size reg1 reg2)
- = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
+ = pprSizeRegReg (if e then sLit "fcmpe" else sLit "fcmp") size reg1 reg2
pprInstr (FDIV size reg1 reg2 reg3)
- = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
+ = pprSizeRegRegReg (sLit "fdiv") size reg1 reg2 reg3
-pprInstr (FMOV F32 reg1 reg2) = pprSizeRegReg SLIT("fmov") F32 reg1 reg2
-pprInstr (FMOV F64 reg1 reg2)
- = (<>) (pprSizeRegReg SLIT("fmov") F32 reg1 reg2)
+pprInstr (FMOV FF32 reg1 reg2) = pprSizeRegReg (sLit "fmov") FF32 reg1 reg2
+pprInstr (FMOV FF64 reg1 reg2)
+ = (<>) (pprSizeRegReg (sLit "fmov") FF32 reg1 reg2)
(if (reg1 == reg2) then empty
else (<>) (char '\n')
- (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
+ (pprSizeRegReg (sLit "fmov") FF32 (fPair reg1) (fPair reg2)))
pprInstr (FMUL size reg1 reg2 reg3)
- = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
+ = pprSizeRegRegReg (sLit "fmul") size reg1 reg2 reg3
-pprInstr (FNEG F32 reg1 reg2) = pprSizeRegReg SLIT("fneg") F32 reg1 reg2
-pprInstr (FNEG F64 reg1 reg2)
- = (<>) (pprSizeRegReg SLIT("fneg") F32 reg1 reg2)
+pprInstr (FNEG FF32 reg1 reg2) = pprSizeRegReg (sLit "fneg") FF32 reg1 reg2
+pprInstr (FNEG FF64 reg1 reg2)
+ = (<>) (pprSizeRegReg (sLit "fneg") FF32 reg1 reg2)
(if (reg1 == reg2) then empty
else (<>) (char '\n')
- (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
+ (pprSizeRegReg (sLit "fmov") FF32 (fPair reg1) (fPair reg2)))
-pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
-pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
+pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg (sLit "fsqrt") size reg1 reg2
+pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "fsub") size reg1 reg2 reg3
pprInstr (FxTOy size1 size2 reg1 reg2)
= hcat [
- ptext SLIT("\tf"),
+ ptext (sLit "\tf"),
ptext
(case size1 of
- I32 -> SLIT("ito")
- F32 -> SLIT("sto")
- F64 -> SLIT("dto")),
+ II32 -> sLit "ito"
+ FF32 -> sLit "sto"
+ FF64 -> sLit "dto"),
ptext
(case size2 of
- I32 -> SLIT("i\t")
- F32 -> SLIT("s\t")
- F64 -> SLIT("d\t")),
+ II32 -> sLit "i\t"
+ FF32 -> sLit "s\t"
+ FF64 -> sLit "d\t"),
pprReg reg1, comma, pprReg reg2
]
pprInstr (BI cond b lab)
= hcat [
- ptext SLIT("\tb"), pprCond cond,
+ ptext (sLit "\tb"), pprCond cond,
if b then pp_comma_a else empty,
char '\t',
pprImm lab
pprInstr (BF cond b lab)
= hcat [
- ptext SLIT("\tfb"), pprCond cond,
+ ptext (sLit "\tfb"), pprCond cond,
if b then pp_comma_a else empty,
char '\t',
pprImm lab
]
-pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
+pprInstr (JMP addr) = (<>) (ptext (sLit "\tjmp\t")) (pprAddr addr)
pprInstr (CALL (Left imm) n _)
- = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
+ = hcat [ ptext (sLit "\tcall\t"), pprImm imm, comma, int n ]
pprInstr (CALL (Right reg) n _)
- = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
+ = hcat [ ptext (sLit "\tcall\t"), pprReg reg, comma, int n ]
pprRI :: RI -> Doc
pprRI (RIReg r) = pprReg r
pprRI (RIImm r) = pprImm r
-pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
+pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
pprSizeRegReg name size reg1 reg2
= hcat [
char '\t',
ptext name,
(case size of
- F32 -> ptext SLIT("s\t")
- F64 -> ptext SLIT("d\t")),
+ FF32 -> ptext (sLit "s\t")
+ FF64 -> ptext (sLit "d\t")),
pprReg reg1,
comma,
pprReg reg2
]
-pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
+pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
pprSizeRegRegReg name size reg1 reg2 reg3
= hcat [
char '\t',
ptext name,
(case size of
- F32 -> ptext SLIT("s\t")
- F64 -> ptext SLIT("d\t")),
+ FF32 -> ptext (sLit "s\t")
+ FF64 -> ptext (sLit "d\t")),
pprReg reg1,
comma,
pprReg reg2,
= hcat [
char '\t',
ptext name,
- if b then ptext SLIT("cc\t") else char '\t',
+ if b then ptext (sLit "cc\t") else char '\t',
pprReg reg1,
comma,
pprRI ri,
= hcat [
char '\t',
ptext name,
- if b then ptext SLIT("cc\t") else char '\t',
+ if b then ptext (sLit "cc\t") else char '\t',
pprRI ri,
comma,
pprReg reg1
]
-pp_ld_lbracket = ptext SLIT("\tld\t[")
+pp_ld_lbracket = ptext (sLit "\tld\t[")
pp_rbracket_comma = text "],"
pp_comma_lbracket = text ",["
pp_comma_a = text ",a"
-- pprInstr for PowerPC
#if powerpc_TARGET_ARCH
+
+pprInstr (SPILL reg slot)
+ = hcat [
+ ptext (sLit "\tSPILL"),
+ char '\t',
+ pprReg reg,
+ comma,
+ ptext (sLit "SLOT") <> parens (int slot)]
+
+pprInstr (RELOAD slot reg)
+ = hcat [
+ ptext (sLit "\tRELOAD"),
+ char '\t',
+ ptext (sLit "SLOT") <> parens (int slot),
+ comma,
+ pprReg reg]
+
pprInstr (LD sz reg addr) = hcat [
char '\t',
- ptext SLIT("l"),
+ ptext (sLit "l"),
ptext (case sz of
- I8 -> SLIT("bz")
- I16 -> SLIT("hz")
- I32 -> SLIT("wz")
- F32 -> SLIT("fs")
- F64 -> SLIT("fd")),
+ II8 -> sLit "bz"
+ II16 -> sLit "hz"
+ II32 -> sLit "wz"
+ FF32 -> sLit "fs"
+ FF64 -> sLit "fd"),
case addr of AddrRegImm _ _ -> empty
AddrRegReg _ _ -> char 'x',
char '\t',
pprReg reg,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprAddr addr
]
pprInstr (LA sz reg addr) = hcat [
char '\t',
- ptext SLIT("l"),
+ ptext (sLit "l"),
ptext (case sz of
- I8 -> SLIT("ba")
- I16 -> SLIT("ha")
- I32 -> SLIT("wa")
- F32 -> SLIT("fs")
- F64 -> SLIT("fd")),
+ II8 -> sLit "ba"
+ II16 -> sLit "ha"
+ II32 -> sLit "wa"
+ FF32 -> sLit "fs"
+ FF64 -> sLit "fd"),
case addr of AddrRegImm _ _ -> empty
AddrRegReg _ _ -> char 'x',
char '\t',
pprReg reg,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprAddr addr
]
pprInstr (ST sz reg addr) = hcat [
char '\t',
- ptext SLIT("st"),
+ ptext (sLit "st"),
pprSize sz,
case addr of AddrRegImm _ _ -> empty
AddrRegReg _ _ -> char 'x',
char '\t',
pprReg reg,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprAddr addr
]
pprInstr (STU sz reg addr) = hcat [
char '\t',
- ptext SLIT("st"),
+ ptext (sLit "st"),
pprSize sz,
- ptext SLIT("u\t"),
+ ptext (sLit "u\t"),
case addr of AddrRegImm _ _ -> empty
AddrRegReg _ _ -> char 'x',
pprReg reg,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprAddr addr
]
pprInstr (LIS reg imm) = hcat [
char '\t',
- ptext SLIT("lis"),
+ ptext (sLit "lis"),
char '\t',
pprReg reg,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprImm imm
]
pprInstr (LI reg imm) = hcat [
char '\t',
- ptext SLIT("li"),
+ ptext (sLit "li"),
char '\t',
pprReg reg,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprImm imm
]
pprInstr (MR reg1 reg2)
| otherwise = hcat [
char '\t',
case regClass reg1 of
- RcInteger -> ptext SLIT("mr")
- _ -> ptext SLIT("fmr"),
+ RcInteger -> ptext (sLit "mr")
+ _ -> ptext (sLit "fmr"),
char '\t',
pprReg reg1,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprReg reg2
]
pprInstr (CMP sz reg ri) = hcat [
op,
char '\t',
pprReg reg,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprRI ri
]
where
op = hcat [
- ptext SLIT("cmp"),
+ ptext (sLit "cmp"),
pprSize sz,
case ri of
RIReg _ -> empty
op,
char '\t',
pprReg reg,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprRI ri
]
where
op = hcat [
- ptext SLIT("cmpl"),
+ ptext (sLit "cmpl"),
pprSize sz,
case ri of
RIReg _ -> empty
]
pprInstr (BCC cond (BlockId id)) = hcat [
char '\t',
- ptext SLIT("b"),
+ ptext (sLit "b"),
pprCond cond,
char '\t',
pprCLabel_asm lbl
pprInstr (BCCFAR cond (BlockId id)) = vcat [
hcat [
- ptext SLIT("\tb"),
+ ptext (sLit "\tb"),
pprCond (condNegate cond),
- ptext SLIT("\t$+8")
+ ptext (sLit "\t$+8")
],
hcat [
- ptext SLIT("\tb\t"),
+ ptext (sLit "\tb\t"),
pprCLabel_asm lbl
]
]
pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
char '\t',
- ptext SLIT("b"),
+ ptext (sLit "b"),
char '\t',
pprCLabel_asm lbl
]
pprInstr (MTCTR reg) = hcat [
char '\t',
- ptext SLIT("mtctr"),
+ ptext (sLit "mtctr"),
char '\t',
pprReg reg
]
pprInstr (BCTR _) = hcat [
char '\t',
- ptext SLIT("bctr")
+ ptext (sLit "bctr")
]
pprInstr (BL lbl _) = hcat [
- ptext SLIT("\tbl\t"),
+ ptext (sLit "\tbl\t"),
pprCLabel_asm lbl
]
pprInstr (BCTRL _) = hcat [
char '\t',
- ptext SLIT("bctrl")
+ ptext (sLit "bctrl")
]
-pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
+pprInstr (ADD reg1 reg2 ri) = pprLogic (sLit "add") reg1 reg2 ri
pprInstr (ADDIS reg1 reg2 imm) = hcat [
char '\t',
- ptext SLIT("addis"),
+ ptext (sLit "addis"),
char '\t',
pprReg reg1,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprReg reg2,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprImm imm
]
-pprInstr (ADDC reg1 reg2 reg3) = pprLogic SLIT("addc") reg1 reg2 (RIReg reg3)
-pprInstr (ADDE reg1 reg2 reg3) = pprLogic SLIT("adde") reg1 reg2 (RIReg reg3)
-pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
-pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
-pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
-pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
-pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3)
+pprInstr (ADDC reg1 reg2 reg3) = pprLogic (sLit "addc") reg1 reg2 (RIReg reg3)
+pprInstr (ADDE reg1 reg2 reg3) = pprLogic (sLit "adde") reg1 reg2 (RIReg reg3)
+pprInstr (SUBF reg1 reg2 reg3) = pprLogic (sLit "subf") reg1 reg2 (RIReg reg3)
+pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic (sLit "mullw") reg1 reg2 ri
+pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic (sLit "mull") reg1 reg2 ri
+pprInstr (DIVW reg1 reg2 reg3) = pprLogic (sLit "divw") reg1 reg2 (RIReg reg3)
+pprInstr (DIVWU reg1 reg2 reg3) = pprLogic (sLit "divwu") reg1 reg2 (RIReg reg3)
pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
- hcat [ ptext SLIT("\tmullwo\t"), pprReg reg1, ptext SLIT(", "),
- pprReg reg2, ptext SLIT(", "),
+ hcat [ ptext (sLit "\tmullwo\t"), pprReg reg1, ptext (sLit ", "),
+ pprReg reg2, ptext (sLit ", "),
pprReg reg3 ],
- hcat [ ptext SLIT("\tmfxer\t"), pprReg reg1 ],
- hcat [ ptext SLIT("\trlwinm\t"), pprReg reg1, ptext SLIT(", "),
- pprReg reg1, ptext SLIT(", "),
- ptext SLIT("2, 31, 31") ]
+ hcat [ ptext (sLit "\tmfxer\t"), pprReg reg1 ],
+ hcat [ ptext (sLit "\trlwinm\t"), pprReg reg1, ptext (sLit ", "),
+ pprReg reg1, ptext (sLit ", "),
+ ptext (sLit "2, 31, 31") ]
]
-- for some reason, "andi" doesn't exist.
-- we'll use "andi." instead.
pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
char '\t',
- ptext SLIT("andi."),
+ ptext (sLit "andi."),
char '\t',
pprReg reg1,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprReg reg2,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprImm imm
]
-pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 ri
+pprInstr (AND reg1 reg2 ri) = pprLogic (sLit "and") reg1 reg2 ri
-pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 ri
-pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 ri
+pprInstr (OR reg1 reg2 ri) = pprLogic (sLit "or") reg1 reg2 ri
+pprInstr (XOR reg1 reg2 ri) = pprLogic (sLit "xor") reg1 reg2 ri
pprInstr (XORIS reg1 reg2 imm) = hcat [
char '\t',
- ptext SLIT("xoris"),
+ ptext (sLit "xoris"),
char '\t',
pprReg reg1,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprReg reg2,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprImm imm
]
pprInstr (EXTS sz reg1 reg2) = hcat [
char '\t',
- ptext SLIT("exts"),
+ ptext (sLit "exts"),
pprSize sz,
char '\t',
pprReg reg1,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprReg reg2
]
-pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2
-pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2
+pprInstr (NEG reg1 reg2) = pprUnary (sLit "neg") reg1 reg2
+pprInstr (NOT reg1 reg2) = pprUnary (sLit "not") reg1 reg2
-pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 (limitShiftRI ri)
-pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 (limitShiftRI ri)
-pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 (limitShiftRI ri)
+pprInstr (SLW reg1 reg2 ri) = pprLogic (sLit "slw") reg1 reg2 (limitShiftRI ri)
+pprInstr (SRW reg1 reg2 ri) = pprLogic (sLit "srw") reg1 reg2 (limitShiftRI ri)
+pprInstr (SRAW reg1 reg2 ri) = pprLogic (sLit "sraw") reg1 reg2 (limitShiftRI ri)
pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
- ptext SLIT("\trlwinm\t"),
+ ptext (sLit "\trlwinm\t"),
pprReg reg1,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprReg reg2,
- ptext SLIT(", "),
+ ptext (sLit ", "),
int sh,
- ptext SLIT(", "),
+ ptext (sLit ", "),
int mb,
- ptext SLIT(", "),
+ ptext (sLit ", "),
int me
]
-pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
-pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
-pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
-pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
-pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
+pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF (sLit "fadd") sz reg1 reg2 reg3
+pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF (sLit "fsub") sz reg1 reg2 reg3
+pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF (sLit "fmul") sz reg1 reg2 reg3
+pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF (sLit "fdiv") sz reg1 reg2 reg3
+pprInstr (FNEG reg1 reg2) = pprUnary (sLit "fneg") reg1 reg2
pprInstr (FCMP reg1 reg2) = hcat [
char '\t',
- ptext SLIT("fcmpu\tcr0, "),
+ ptext (sLit "fcmpu\tcr0, "),
-- Note: we're using fcmpu, not fcmpo
-- The difference is with fcmpo, compare with NaN is an invalid operation.
-- We don't handle invalid fp ops, so we don't care
pprReg reg1,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprReg reg2
]
-pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
-pprInstr (FRSP reg1 reg2) = pprUnary SLIT("frsp") reg1 reg2
+pprInstr (FCTIWZ reg1 reg2) = pprUnary (sLit "fctiwz") reg1 reg2
+pprInstr (FRSP reg1 reg2) = pprUnary (sLit "frsp") reg1 reg2
pprInstr (CRNOR dst src1 src2) = hcat [
- ptext SLIT("\tcrnor\t"),
+ ptext (sLit "\tcrnor\t"),
int dst,
- ptext SLIT(", "),
+ ptext (sLit ", "),
int src1,
- ptext SLIT(", "),
+ ptext (sLit ", "),
int src2
]
pprInstr (MFCR reg) = hcat [
char '\t',
- ptext SLIT("mfcr"),
+ ptext (sLit "mfcr"),
char '\t',
pprReg reg
]
pprInstr (MFLR reg) = hcat [
char '\t',
- ptext SLIT("mflr"),
+ ptext (sLit "mflr"),
char '\t',
pprReg reg
]
pprInstr (FETCHPC reg) = vcat [
- ptext SLIT("\tbcl\t20,31,1f"),
- hcat [ ptext SLIT("1:\tmflr\t"), pprReg reg ]
+ ptext (sLit "\tbcl\t20,31,1f"),
+ hcat [ ptext (sLit "1:\tmflr\t"), pprReg reg ]
]
-pprInstr LWSYNC = ptext SLIT("\tlwsync")
+pprInstr LWSYNC = ptext (sLit "\tlwsync")
pprInstr _ = panic "pprInstr (ppc)"
RIImm _ -> char 'i',
char '\t',
pprReg reg1,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprReg reg2,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprRI ri
]
ptext op,
char '\t',
pprReg reg1,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprReg reg2
]
pprFSize sz,
char '\t',
pprReg reg1,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprReg reg2,
- ptext SLIT(", "),
+ ptext (sLit ", "),
pprReg reg3
]
pprRI (RIReg r) = pprReg r
pprRI (RIImm r) = pprImm r
-pprFSize F64 = empty
-pprFSize F32 = char 's'
+pprFSize FF64 = empty
+pprFSize FF32 = char 's'
-- limit immediate argument for shift instruction to range 0..32
-- (yes, the maximum is really 32, not 31)
projects / ghc-hetmet.git / blobdiff