X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FPprMach.hs;h=afa5bcd872f62c0bd58f3320ffe940ef6c0588a7;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=9fb21236046de3b4df2c8896ed0d4b12b77b6797;hpb=e5e35249333a513f5462a482820ac30b421784bf;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/PprMach.hs b/ghc/compiler/nativeGen/PprMach.hs index 9fb2123..afa5bcd 100644 --- a/ghc/compiler/nativeGen/PprMach.hs +++ b/ghc/compiler/nativeGen/PprMach.hs @@ -48,8 +48,9 @@ import MutableArray import MONAD_ST import Char ( chr, ord ) +import Maybe ( isJust ) -#if powerpc_TARGET_ARCH +#if powerpc_TARGET_ARCH || darwin_TARGET_OS import DATA_WORD(Word32) import DATA_BITS #endif @@ -359,7 +360,7 @@ pprReg IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) r -- ----------------------------------------------------------------------------- -- pprSize: print a 'Size' -#if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH +#if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH || sparc_TARGET_ARCH pprSize :: MachRep -> Doc #else pprSize :: Size -> Doc @@ -386,8 +387,8 @@ pprSize x = ptext (case x of I64 -> SLIT("q") #endif #if i386_TARGET_ARCH - F32 -> SLIT("l") - F64 -> SLIT("q") + F32 -> SLIT("s") + F64 -> SLIT("l") F80 -> SLIT("t") #endif #if x86_64_TARGET_ARCH @@ -395,23 +396,19 @@ pprSize x = ptext (case x of F64 -> SLIT("sd") -- "scalar double-precision float" (SSE2) #endif #if sparc_TARGET_ARCH - B -> SLIT("sb") - Bu -> SLIT("ub") - H -> SLIT("sh") - Hu -> SLIT("uh") - W -> SLIT("") - F -> SLIT("") - DF -> SLIT("d") + I8 -> SLIT("sb") + I16 -> SLIT("sh") + I32 -> SLIT("") + F32 -> SLIT("") + F64 -> SLIT("d") ) -pprStSize :: Size -> Doc +pprStSize :: MachRep -> Doc pprStSize x = ptext (case x of - B -> SLIT("b") - Bu -> SLIT("b") - H -> SLIT("h") - Hu -> SLIT("h") - W -> SLIT("") - F -> SLIT("") - DF -> SLIT("d") + I8 -> SLIT("b") + I16 -> SLIT("h") + I32 -> SLIT("") + F32 -> SLIT("") + F64 -> SLIT("d") #endif #if powerpc_TARGET_ARCH I8 -> SLIT("b") @@ -446,6 +443,7 @@ pprCond c = ptext (case c of { 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 @@ -480,12 +478,18 @@ pprImm (ImmCLbl l) = pprCLabel_asm l pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i pprImm (ImmLit s) = s -pprImm (ImmFloat _) = panic "pprImm:ImmFloat" -pprImm (ImmDouble _) = panic "pprImm:ImmDouble" +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 +-- ToDo: This should really be fixed in the PIC support, but only +-- print a for now. +pprImm (ImmConstantDiff a b) = pprImm a +#else pprImm (ImmConstantDiff a b) = pprImm a <> char '-' <> lparen <> pprImm b <> rparen +#endif #if sparc_TARGET_ARCH pprImm (LO i) @@ -560,10 +564,11 @@ pprAddr (AddrBaseIndex base index displacement) pp_reg r = pprReg wordRep r in case (base,index) of - (Nothing, Nothing) -> pp_disp - (Just b, Nothing) -> pp_off (pp_reg b) - (Nothing, Just (r,i)) -> pp_off (comma <> pp_reg r <> comma <> int i) - (Just b, Just (r,i)) -> pp_off (pp_reg b <> comma <> pp_reg r + (EABaseNone, EAIndexNone) -> pp_disp + (EABaseReg b, EAIndexNone) -> pp_off (pp_reg b) + (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) where ppr_disp (ImmInt 0) = empty @@ -615,7 +620,9 @@ 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(SLIT(".text\n\t.align 4,0x90") {-needs per-OS variation!-} + ,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(SLIT(".text\n\t.align 8") {-needs per-OS variation!-} ,IF_ARCH_powerpc(SLIT(".text\n.align 2") ,))))) @@ -623,7 +630,8 @@ 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(SLIT(".data\n\t.align 4") + ,IF_ARCH_i386(IF_OS_darwin(SLIT(".data\n\t.align 2"), + SLIT(".data\n\t.align 4")) ,IF_ARCH_x86_64(SLIT(".data\n\t.align 8") ,IF_ARCH_powerpc(SLIT(".data\n.align 2") ,))))) @@ -631,7 +639,8 @@ 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(SLIT(".section .rodata\n\t.align 4") + ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const\n.align 2"), + SLIT(".section .rodata\n\t.align 4")) ,IF_ARCH_x86_64(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")) @@ -640,21 +649,18 @@ 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(SLIT(".section .rodata\n\t.align 4") - ,IF_ARCH_x86_64(SLIT(".text\n\t.align 8") + ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const_data\n.align 2"), + SLIT(".section .rodata\n\t.align 4")) + ,IF_ARCH_x86_64(SLIT(".section .rodata\n\t.align 8") ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"), SLIT(".data\n\t.align 2")) ,))))) - -- the assembler on x86_64/Linux refuses to generate code for - -- .quad x - y - -- where x is in the text section and y in the rodata section. - -- It works if y is in the text section, though. This is probably - -- going to cause difficulties for PIC, I imagine. 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(SLIT(".section .bss\n\t.align 4") + ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const_data\n\t.align 2"), + SLIT(".section .bss\n\t.align 4")) ,IF_ARCH_x86_64(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")) @@ -663,7 +669,8 @@ 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(SLIT(".section .rodata\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(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")) @@ -690,21 +697,15 @@ pprLabel :: CLabel -> Doc pprLabel lbl = pprGloblDecl lbl $$ (pprCLabel_asm lbl <> char ':') --- Assume we want to backslash-convert the string pprASCII str - = vcat (map do1 (str ++ [chr 0])) + = vcat (map do1 str) $$ do1 0 where - do1 :: Char -> Doc - do1 c = ptext SLIT("\t.byte\t0x") <> hshow (ord c) - - hshow :: Int -> Doc - hshow n | n >= 0 && n <= 255 - = char (tab !! (n `div` 16)) <> char (tab !! (n `mod` 16)) - tab = "0123456789ABCDEF" + do1 :: Word8 -> Doc + 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 bytes, + IF_ARCH_i386(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes), IF_ARCH_x86_64(ptext SLIT(".align ") <> int bytes, IF_ARCH_sparc(ptext SLIT(".align ") <> int bytes, IF_ARCH_powerpc(ptext SLIT(".align ") <> int pow2,))))) @@ -742,8 +743,37 @@ pprDataItem lit #endif #if i386_TARGET_ARCH || x86_64_TARGET_ARCH ppr_item I16 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") + <> int (fromIntegral (fromIntegral x :: Word32)), + ptext SLIT("\t.long\t") + <> int (fromIntegral + (fromIntegral (x `shiftR` 32) :: Word32))] +#endif +#if i386_TARGET_ARCH ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm] #endif +#if x86_64_TARGET_ARCH + -- x86_64: binutils can't handle the R_X86_64_PC64 relocation + -- type, which means we can't do pc-relative 64-bit addresses. + -- Fortunately we're assuming the small memory model, in which + -- all such offsets will fit into 32 bits, so we have to stick + -- to 32-bit offset fields and modify the RTS appropriately + -- (see InfoTables.h). + -- + ppr_item I64 x + | isRelativeReloc x = + [ptext SLIT("\t.long\t") <> pprImm imm, + ptext SLIT("\t.long\t0")] + | otherwise = + [ptext SLIT("\t.quad\t") <> pprImm imm] + where + isRelativeReloc (CmmLabelOff _ _) = True + 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 _) = @@ -1186,18 +1216,22 @@ pprInstr (MOVZxL I32 src dst) = pprSizeOpOp SLIT("mov") I32 src dst -- 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 wordRep src dst +pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes I32 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 -- here we do some patching, since the physical registers are only set late -- in the code generation. -pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3)) +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 -pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3)) +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 -pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3)) +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 @@ -1261,13 +1295,12 @@ pprInstr (JXX cond (BlockId id)) pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm) pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep 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 wordRep reg) pprInstr (IDIV sz op) = pprSizeOp SLIT("idiv") sz op pprInstr (DIV sz op) = pprSizeOp SLIT("div") sz op - -pprInstr (IMUL64 sd_hi sd_lo) = pprInstr_imul64 sd_hi sd_lo +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 @@ -1282,6 +1315,7 @@ pprInstr (CVTSI2SS from to) = pprOpReg SLIT("cvtsi2ss") from to pprInstr (CVTSI2SD from to) = pprOpReg SLIT("cvtsi2sd") 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 ], @@ -1289,6 +1323,17 @@ pprInstr (FETCHGOT reg) pprReg I32 reg ] ] + -- FETCHPC for PIC on Darwin/x86 + -- get the instruction pointer into a register + -- (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 ] + ] + + + #endif -- ----------------------------------------------------------------------------- @@ -1544,22 +1589,6 @@ pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 d #if i386_TARGET_ARCH || x86_64_TARGET_ARCH --- Emit code to make hi_reg:lo_reg be the 64-bit product of hi_reg and lo_reg -pprInstr_imul64 hi_reg lo_reg - = let fakeInsn = text "imul64" <+> pp_hi_reg <> comma <+> pp_lo_reg - pp_hi_reg = pprReg wordRep hi_reg - pp_lo_reg = pprReg wordRep lo_reg - in - vcat [ - text "\t# BEGIN " <> fakeInsn, - text "\tpushl" <+> pp_hi_reg <> text" ; pushl" <+> pp_lo_reg, - text "\tpushl %eax ; pushl %edx", - text "\tmovl 12(%esp), %eax ; imull 8(%esp)", - text "\tmovl %edx, 12(%esp) ; movl %eax, 8(%esp)", - text "\tpopl %edx ; popl %eax", - text "\tpopl" <+> pp_lo_reg <> text " ; popl" <+> pp_hi_reg, - text "\t# END " <> fakeInsn - ] -- Continue with I386-only printing bits and bobs: pprDollImm :: Imm -> Doc @@ -1742,7 +1771,8 @@ pprCondInstr name cond arg -- ld [g1],%fn -- ld [g1+4],%f(n+1) -- sub g1,g2,g1 -- to restore g1 -pprInstr (LD DF (AddrRegReg g1 g2) reg) + +pprInstr (LD F64 (AddrRegReg g1 g2) reg) = vcat [ hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1], hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg], @@ -1753,7 +1783,7 @@ pprInstr (LD DF (AddrRegReg g1 g2) reg) -- Translate to -- ld [addr],%fn -- ld [addr+4],%f(n+1) -pprInstr (LD DF addr reg) | isJust off_addr +pprInstr (LD F64 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)] @@ -1781,7 +1811,7 @@ pprInstr (LD size addr reg) -- st %fn,[g1] -- st %f(n+1),[g1+4] -- sub g1,g2,g1 -- to restore g1 -pprInstr (ST DF reg (AddrRegReg g1 g2)) +pprInstr (ST F64 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, @@ -1794,7 +1824,7 @@ pprInstr (ST DF reg (AddrRegReg g1 g2)) -- Translate to -- st %fn,[addr] -- st %f(n+1),[addr+4] -pprInstr (ST DF reg addr) | isJust off_addr +pprInstr (ST F64 reg addr) | isJust off_addr = vcat [ hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket, pprAddr addr, rbrack], @@ -1869,12 +1899,12 @@ pprInstr (SETHI imm reg) pprInstr NOP = ptext SLIT("\tnop") -pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2 -pprInstr (FABS DF reg1 reg2) - = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2) +pprInstr (FABS F32 reg1 reg2) = pprSizeRegReg SLIT("fabs") F32 reg1 reg2 +pprInstr (FABS F64 reg1 reg2) + = (<>) (pprSizeRegReg SLIT("fabs") F32 reg1 reg2) (if (reg1 == reg2) then empty else (<>) (char '\n') - (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2))) + (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2))) pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3 @@ -1883,22 +1913,22 @@ pprInstr (FCMP e size reg1 reg2) pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3 -pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2 -pprInstr (FMOV DF reg1 reg2) - = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2) +pprInstr (FMOV F32 reg1 reg2) = pprSizeRegReg SLIT("fmov") F32 reg1 reg2 +pprInstr (FMOV F64 reg1 reg2) + = (<>) (pprSizeRegReg SLIT("fmov") F32 reg1 reg2) (if (reg1 == reg2) then empty else (<>) (char '\n') - (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2))) + (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2))) pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3 -pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2 -pprInstr (FNEG DF reg1 reg2) - = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2) +pprInstr (FNEG F32 reg1 reg2) = pprSizeRegReg SLIT("fneg") F32 reg1 reg2 +pprInstr (FNEG F64 reg1 reg2) + = (<>) (pprSizeRegReg SLIT("fneg") F32 reg1 reg2) (if (reg1 == reg2) then empty else (<>) (char '\n') - (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2))) + (pprSizeRegReg SLIT("fmov") F32 (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 @@ -1907,14 +1937,14 @@ pprInstr (FxTOy size1 size2 reg1 reg2) ptext SLIT("\tf"), ptext (case size1 of - W -> SLIT("ito") - F -> SLIT("sto") - DF -> SLIT("dto")), + I32 -> SLIT("ito") + F32 -> SLIT("sto") + F64 -> SLIT("dto")), ptext (case size2 of - W -> SLIT("i\t") - F -> SLIT("s\t") - DF -> SLIT("d\t")), + I32 -> SLIT("i\t") + F32 -> SLIT("s\t") + F64 -> SLIT("d\t")), pprReg reg1, comma, pprReg reg2 ] @@ -1935,41 +1965,38 @@ pprInstr (BF cond b lab) pprImm lab ] -pprInstr (JMP dsts 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 ] pprInstr (CALL (Right reg) n _) = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ] -\end{code} -Continue with SPARC-only printing bits and bobs: -\begin{code} pprRI :: RI -> Doc pprRI (RIReg r) = pprReg r pprRI (RIImm r) = pprImm r -pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc +pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc pprSizeRegReg name size reg1 reg2 = hcat [ char '\t', ptext name, (case size of - F -> ptext SLIT("s\t") - DF -> ptext SLIT("d\t")), + F32 -> ptext SLIT("s\t") + F64 -> ptext SLIT("d\t")), pprReg reg1, comma, pprReg reg2 ] -pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc +pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc pprSizeRegRegReg name size reg1 reg2 reg3 = hcat [ char '\t', ptext name, (case size of - F -> ptext SLIT("s\t") - DF -> ptext SLIT("d\t")), + F32 -> ptext SLIT("s\t") + F64 -> ptext SLIT("d\t")), pprReg reg1, comma, pprReg reg2,