X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FPprMach.hs;h=afa5bcd872f62c0bd58f3320ffe940ef6c0588a7;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=d1f72f11ea43c2e0e3db8dd78029e7e42d60bd51;hpb=82b583acc592617e68c96accc1145965a8b0cfbe;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/PprMach.hs b/ghc/compiler/nativeGen/PprMach.hs index d1f72f1..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 @@ -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") @@ -485,8 +482,14 @@ 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) @@ -617,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") ,))))) @@ -625,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") ,))))) @@ -633,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")) @@ -642,7 +649,8 @@ 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_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")) @@ -651,7 +659,8 @@ 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")) @@ -660,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")) @@ -687,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,))))) @@ -740,6 +744,14 @@ pprDataItem lit #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 @@ -1283,8 +1295,8 @@ 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 @@ -1303,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 ], @@ -1310,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 -- ----------------------------------------------------------------------------- @@ -1747,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], @@ -1758,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)] @@ -1786,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, @@ -1799,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], @@ -1874,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 @@ -1888,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 @@ -1912,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 ] @@ -1940,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,