X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FPprMach.hs;h=afa5bcd872f62c0bd58f3320ffe940ef6c0588a7;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=b1547f1c707abe00e018cbc6ca3b8a928660f0a1;hpb=7a1b0a6cba556511688cb1824f48e31fe6c4cc07;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/PprMach.hs b/ghc/compiler/nativeGen/PprMach.hs index b1547f1..afa5bcd 100644 --- a/ghc/compiler/nativeGen/PprMach.hs +++ b/ghc/compiler/nativeGen/PprMach.hs @@ -2,8 +2,8 @@ -- -- Pretty-printing assembly language -- - -- (c) The University of Glasgow 1993-2004 - -- +-- (c) The University of Glasgow 1993-2005 +-- ----------------------------------------------------------------------------- -- We start with the @pprXXX@s with some cross-platform commonality @@ -21,12 +21,15 @@ module PprMach ( #include "HsVersions.h" import Cmm -import MachOp ( MachRep(..) ) +import MachOp ( MachRep(..), wordRep, isFloatingRep ) import MachRegs -- may differ per-platform import MachInstrs import CLabel ( CLabel, pprCLabel, externallyVisibleCLabel, labelDynamic, mkAsmTempLabel, entryLblToInfoLbl ) +#if HAVE_SUBSECTIONS_VIA_SYMBOLS +import CLabel ( mkDeadStripPreventer ) +#endif import Panic ( panic ) import Unique ( pprUnique ) @@ -34,7 +37,7 @@ import Pretty import FastString import qualified Outputable -import CmdLineOpts ( opt_PIC, opt_Static ) +import StaticFlags ( opt_PIC, opt_Static ) #if __GLASGOW_HASKELL__ >= 504 import Data.Array.ST @@ -45,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 @@ -68,8 +72,13 @@ pprNatCmmTop (CmmProc [] lbl _ []) = pprLabel lbl pprNatCmmTop (CmmProc info lbl params blocks) = pprSectionHeader Text $$ (if not (null info) - then vcat (map pprData info) - $$ pprLabel (entryLblToInfoLbl lbl) + then +#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 @@ -77,7 +86,22 @@ pprNatCmmTop (CmmProc info lbl params blocks) = (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 pprBasicBlock rest) + ) +#if HAVE_SUBSECTIONS_VIA_SYMBOLS + -- If we are using the .subsections_via_symbols directive + -- (available on recent versions of Darwin), + -- we have to make sure that there is some kind of reference + -- from the entry code to a label on the _top_ of of the info table, + -- so that the linker will not think it is unreferenced and dead-strip + -- it. That's why the label is called a DeadStripPreventer (_dsp). + $$ if not (null info) + then text "\t.long " + <+> pprCLabel_asm (entryLblToInfoLbl lbl) + <+> char '-' + <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl) + else empty +#endif pprBasicBlock :: NatBasicBlock -> Doc @@ -92,13 +116,13 @@ pprBasicBlock (BasicBlock (BlockId id) instrs) = -- on which bit of it we care about. Yurgh. pprUserReg :: Reg -> Doc -pprUserReg = pprReg IF_ARCH_i386(I32,) +pprUserReg = pprReg IF_ARCH_i386(I32,) IF_ARCH_x86_64(I64,) -pprReg :: IF_ARCH_i386(MachRep ->,) Reg -> Doc +pprReg :: IF_ARCH_i386(MachRep ->,) IF_ARCH_x86_64(MachRep ->,) Reg -> Doc -pprReg IF_ARCH_i386(s,) r +pprReg IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) r = case r of - RealReg i -> ppr_reg_no IF_ARCH_i386(s,) i + RealReg i -> ppr_reg_no IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) i VirtualRegI u -> text "%vI_" <> asmSDoc (pprUnique u) VirtualRegHi u -> text "%vHi_" <> asmSDoc (pprUnique u) VirtualRegF u -> text "%vF_" <> asmSDoc (pprUnique u) @@ -177,6 +201,75 @@ pprReg IF_ARCH_i386(s,) r _ -> 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 _ = 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") + }) + + 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") + }) + + 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") + }) + + 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") + }) +#endif + #if sparc_TARGET_ARCH ppr_reg_no :: Int -> Doc ppr_reg_no i = ptext @@ -267,7 +360,7 @@ pprReg IF_ARCH_i386(s,) r -- ----------------------------------------------------------------------------- -- pprSize: print a 'Size' -#if powerpc_TARGET_ARCH || i386_TARGET_ARCH +#if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH || sparc_TARGET_ARCH pprSize :: MachRep -> Doc #else pprSize :: Size -> Doc @@ -287,32 +380,35 @@ pprSize x = ptext (case x of -- SF -> SLIT("s") UNUSED TF -> SLIT("t") #endif -#if i386_TARGET_ARCH +#if i386_TARGET_ARCH || x86_64_TARGET_ARCH I8 -> SLIT("b") I16 -> SLIT("w") I32 -> SLIT("l") + I64 -> SLIT("q") +#endif +#if i386_TARGET_ARCH F32 -> SLIT("s") F64 -> SLIT("l") F80 -> SLIT("t") #endif +#if x86_64_TARGET_ARCH + F32 -> SLIT("ss") -- "scalar single-precision float" (SSE2) + 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") @@ -339,14 +435,15 @@ pprCond c = ptext (case c of { GTT -> SLIT("gt"); GE -> SLIT("ge") #endif -#if i386_TARGET_ARCH +#if i386_TARGET_ARCH || x86_64_TARGET_ARCH GEU -> SLIT("ae"); LU -> SLIT("b"); - EQQ -> SLIT("e"); GTT -> SLIT("g"); + 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 @@ -381,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) @@ -443,7 +546,7 @@ pprAddr (AddrRegImm r1 i) ------------------- -#if i386_TARGET_ARCH +#if i386_TARGET_ARCH || x86_64_TARGET_ARCH pprAddr (ImmAddr imm off) = let pp_imm = pprImm imm in @@ -458,13 +561,14 @@ pprAddr (AddrBaseIndex base index displacement) = let pp_disp = ppr_disp displacement pp_off p = pp_disp <> char '(' <> p <> char ')' - pp_reg r = pprReg I32 r + 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 @@ -512,45 +616,66 @@ pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ] -- ----------------------------------------------------------------------------- -- pprData: print a 'CmmStatic' -#if defined(linux_TARGET_OS) -#if defined(powerpc_TARGET_ARCH) || defined(i386_TARGET_ARCH) - -- Hack to make dynamic linking work -pprSectionHeader ReadOnlyData - | not opt_PIC && not opt_Static - = pprSectionHeader Data -#endif -#endif - 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") - ,)))) + ,))))) 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") - ,)))) + ,))))) 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_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"), + ,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")) - ,)))) + ,))))) +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 .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")) + ,))))) 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")) - ,)))) + ,))))) +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(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" @@ -564,34 +689,26 @@ pprData (CmmStaticLit lit) = pprDataItem lit pprGloblDecl :: CLabel -> Doc pprGloblDecl lbl | not (externallyVisibleCLabel lbl) = empty - | otherwise = ptext IF_ARCH_alpha(SLIT(".globl ") - ,IF_ARCH_i386(SLIT(".globl ") - ,IF_ARCH_sparc(SLIT(".global ") - ,IF_ARCH_powerpc(SLIT(".globl ") - ,)))) <> + | otherwise = ptext IF_ARCH_sparc(SLIT(".global "), + SLIT(".globl ")) <> pprCLabel_asm lbl 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,)))) + IF_ARCH_powerpc(ptext SLIT(".align ") <> int pow2,))))) where pow2 = log2 bytes @@ -624,10 +741,39 @@ pprDataItem lit ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm] ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm] #endif -#if i386_TARGET_ARCH +#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 _) = @@ -650,10 +796,11 @@ 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_powerpc( IF_OS_linux( ((<>) (ptext SLIT("# ")) (ftext s)), ((<>) (ptext SLIT("; ")) (ftext s))) - ,)))) + ,))))) pprInstr (DELTA d) = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d))) @@ -1049,7 +1196,7 @@ pprSizeRegRegReg name size reg1 reg2 reg3 -- ----------------------------------------------------------------------------- -- pprInstr for an x86 -#if i386_TARGET_ARCH +#if i386_TARGET_ARCH || x86_64_TARGET_ARCH pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack | src == dst @@ -1059,20 +1206,32 @@ pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack #else empty #endif + pprInstr (MOV size src dst) = pprSizeOpOp SLIT("mov") size src dst + +pprInstr (MOVZxL I32 src dst) = pprSizeOpOp SLIT("mov") I32 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 (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") 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 @@ -1095,11 +1254,13 @@ pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2 however, cannot be used to determine if the upper half of the result is non-zero." So there. -} -pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2 - 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 (NOT size op) = pprSizeOp SLIT("not") size op pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op @@ -1109,7 +1270,10 @@ pprInstr (SHR size src dst) = pprShift SLIT("shr") size src dst pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src -pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst +pprInstr (CMP size src dst) + | isFloatingRep size = pprSizeOpOp SLIT("ucomi") size src dst -- SSE2 + | otherwise = pprSizeOpOp SLIT("cmp") size src dst + 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 @@ -1119,7 +1283,8 @@ pprInstr (POP size op) = pprSizeOp SLIT("pop") size op -- pprInstr POPA = ptext SLIT("\tpopal") pprInstr NOP = ptext SLIT("\tnop") -pprInstr CLTD = ptext SLIT("\tcltd") +pprInstr (CLTD I32) = ptext SLIT("\tcltd") +pprInstr (CLTD I64) = ptext SLIT("\tcqto") pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand I8 op) @@ -1128,17 +1293,53 @@ pprInstr (JXX cond (BlockId id)) where lab = mkAsmTempLabel id pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm) -pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand I32 op) +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 I32 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 (IMUL2 sz op) = pprSizeOp SLIT("imul") sz op -pprInstr (IMUL64 sd_hi sd_lo) = pprInstr_imul64 sd_hi sd_lo +#if x86_64_TARGET_ARCH +pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("mul") 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 (CVTSS2SI from to) = pprOpReg SLIT("cvtss2si") from to +pprInstr (CVTSD2SI from to) = pprOpReg SLIT("cvtsd2si") from to +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 ], + hcat [ ptext SLIT("\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "), + 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 + +-- ----------------------------------------------------------------------------- +-- i386 floating-point + +#if i386_TARGET_ARCH -- Simulating a flat register set on the x86 FP stack is tricky. -- you have to free %st(7) before pushing anything on the FP reg stack -- so as to preclude the possibility of a FP stack overflow exception. @@ -1335,31 +1536,6 @@ pprInstr GFREE ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)") ] -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 ] - ] - --- 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 I32 hi_reg - pp_lo_reg = pprReg I32 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 - ] - - -------------------------- -- coerce %st(0) to the specified size @@ -1409,6 +1585,9 @@ pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 d 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 -- Continue with I386-only printing bits and bobs: @@ -1421,6 +1600,10 @@ pprOperand s (OpReg r) = pprReg s r pprOperand s (OpImm i) = pprDollImm i pprOperand s (OpAddr ea) = pprAddr ea +pprMnemonic_ :: LitString -> Doc +pprMnemonic_ name = + char '\t' <> ptext name <> space + pprMnemonic :: LitString -> MachRep -> Doc pprMnemonic name size = char '\t' <> ptext name <> pprSize size <> space @@ -1451,6 +1634,15 @@ pprSizeOpOp name size op1 op2 pprOperand size op2 ] +pprOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc +pprOpOp name size op1 op2 + = hcat [ + pprMnemonic_ name, + pprOperand size op1, + comma, + pprOperand size op2 + ] + pprSizeReg :: LitString -> MachRep -> Reg -> Doc pprSizeReg name size reg1 = hcat [ @@ -1467,6 +1659,24 @@ pprSizeRegReg name size reg1 reg2 pprReg size reg2 ] +pprRegReg :: LitString -> Reg -> Reg -> Doc +pprRegReg name reg1 reg2 + = hcat [ + pprMnemonic_ name, + pprReg wordRep reg1, + comma, + pprReg wordRep reg2 + ] + +pprOpReg :: LitString -> Operand -> Reg -> Doc +pprOpReg name op1 reg2 + = hcat [ + pprMnemonic_ name, + pprOperand wordRep op1, + comma, + pprReg wordRep reg2 + ] + pprCondRegReg :: LitString -> MachRep -> Cond -> Reg -> Reg -> Doc pprCondRegReg name size cond reg1 reg2 = hcat [ @@ -1561,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], @@ -1572,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)] @@ -1600,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, @@ -1613,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], @@ -1688,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 @@ -1702,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 @@ -1726,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 ] @@ -1754,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,