X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FnativeGen%2FX86%2FPpr.hs;h=769057ae024a28f911ce0c3fa3cdf26794b2a26a;hp=5182f7c0b65ec4f8c8580dcd0e212ec90a05a433;hb=7867349134ee26e4276ff04ace7c815c1de43338;hpb=b1f453e16f0ce11a2ab18cc4c350bdcbd36299a6 diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 5182f7c..769057a 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -12,7 +12,6 @@ module X86.Ppr ( pprSectionHeader, pprData, pprInstr, - pprUserReg, pprSize, pprImm, pprDataItem, @@ -34,7 +33,6 @@ import PprBase import OldCmm import CLabel -import Config import Unique ( pprUnique, Uniquable(..) ) import Pretty import FastString @@ -42,7 +40,6 @@ import qualified Outputable import Outputable (panic, Outputable) import Data.Word -import Distribution.System #if i386_TARGET_ARCH && darwin_TARGET_OS import Data.Bits @@ -56,19 +53,19 @@ pprNatCmmTop (CmmData section dats) = pprSectionHeader section $$ vcat (map pprData dats) -- special case for split markers: -pprNatCmmTop (CmmProc [] lbl (ListGraph [])) = pprLabel True lbl +pprNatCmmTop (CmmProc [] lbl (ListGraph [])) = pprLabel lbl pprNatCmmTop (CmmProc info lbl (ListGraph blocks)) = pprSectionHeader Text $$ (if null info then -- blocks guaranteed not null, so label needed - pprLabel True lbl + pprLabel lbl else #if HAVE_SUBSECTIONS_VIA_SYMBOLS pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl) <> char ':' $$ #endif vcat (map pprData info) $$ - pprLabel True (entryLblToInfoLbl lbl) + pprLabel (entryLblToInfoLbl lbl) ) $$ vcat (map pprBasicBlock blocks) -- above: Even the first block gets a label, because with branch-chain @@ -87,18 +84,27 @@ pprNatCmmTop (CmmProc info lbl (ListGraph blocks)) = <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl) else empty #endif - $$ pprSizeDecl (if null info then lbl else entryLblToInfoLbl lbl) + $$ pprSizeDecl (if null info then lbl else entryLblToInfoLbl lbl) +-- | Output the ELF .size directive. +pprSizeDecl :: CLabel -> Doc +#if elf_OBJ_FORMAT +pprSizeDecl lbl = + ptext (sLit "\t.size") <+> pprCLabel_asm lbl + <> ptext (sLit ", .-") <> pprCLabel_asm lbl +#else +pprSizeDecl _ = empty +#endif pprBasicBlock :: NatBasicBlock Instr -> Doc pprBasicBlock (BasicBlock blockid instrs) = - pprCLabel_asm (mkAsmTempLabel (getUnique blockid)) <> char ':' $$ + pprLabel (mkAsmTempLabel (getUnique blockid)) $$ vcat (map pprInstr instrs) pprData :: CmmStatic -> Doc pprData (CmmAlign bytes) = pprAlign bytes -pprData (CmmDataLabel lbl) = pprLabel False lbl +pprData (CmmDataLabel lbl) = pprLabel lbl pprData (CmmString str) = pprASCII str #if darwin_TARGET_OS @@ -112,33 +118,21 @@ pprData (CmmStaticLit lit) = pprDataItem lit pprGloblDecl :: CLabel -> Doc pprGloblDecl lbl | not (externallyVisibleCLabel lbl) = empty - | otherwise = ptext IF_ARCH_sparc((sLit ".global "), - (sLit ".globl ")) <> - pprCLabel_asm lbl + | otherwise = ptext (sLit ".globl ") <> pprCLabel_asm lbl -pprTypeDecl :: Bool -> CLabel -> Doc +pprTypeAndSizeDecl :: CLabel -> Doc #if elf_OBJ_FORMAT -pprTypeDecl isCode lbl = - ptext (sLit "\t.type ") <> pprCLabel_asm lbl - <> ptext (sLit (if isCode then ", @function" else ", @object")) +pprTypeAndSizeDecl lbl + | not (externallyVisibleCLabel lbl) = empty + | otherwise = ptext (sLit ".type ") <> + pprCLabel_asm lbl <> ptext (sLit ", @object") #else -pprTypeDecl _ _ +pprTypeAndSizeDecl _ = empty #endif --- | Output the ELF .size directive. -pprSizeDecl :: CLabel -> Doc -#if elf_OBJ_FORMAT -pprSizeDecl lbl = - ptext (sLit "\t.size") <+> pprCLabel_asm lbl - <> ptext (sLit ", .-") <> pprCLabel_asm lbl -#else -pprSizeDecl _ = empty -#endif - -pprLabel :: Bool -> CLabel -> Doc -pprLabel isCode lbl = pprGloblDecl lbl $$ pprTypeDecl isCode lbl - $$ (pprCLabel_asm lbl <> char ':') +pprLabel :: CLabel -> Doc +pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':') pprASCII :: [Word8] -> Doc @@ -173,12 +167,6 @@ instance Outputable Instr where ppr instr = Outputable.docToSDoc $ pprInstr instr -pprUserReg :: Reg -> Doc -pprUserReg - | cTargetArch == I386 = pprReg II32 - | cTargetArch == X86_64 = pprReg II64 - | otherwise = panic "X86.Ppr.pprUserReg: not defined" - pprReg :: Size -> Reg -> Doc pprReg s r @@ -502,15 +490,7 @@ pprInstr :: Instr -> Doc pprInstr (COMMENT _) = 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_powerpc( IF_OS_linux( - ((<>) (ptext (sLit "# ")) (ftext s)), - ((<>) (ptext (sLit "; ")) (ftext s))) - ,))))) +pprInstr (COMMENT s) = ptext (sLit "# ") <> ftext s -} pprInstr (DELTA d) = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d))) @@ -637,7 +617,7 @@ 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 archWordSize op) -pprInstr (JMP_TBL op _) = pprInstr (JMP op) +pprInstr (JMP_TBL op _ _ _) = pprInstr (JMP op) pprInstr (CALL (Left imm) _) = (<>) (ptext (sLit "\tcall ")) (pprImm imm) pprInstr (CALL (Right reg) _) = (<>) (ptext (sLit "\tcall *")) (pprReg archWordSize reg) @@ -652,8 +632,8 @@ 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 sz from to) = pprSizeOpReg (sLit "cvttss2si") sz from to -pprInstr (CVTTSD2SIQ sz from to) = pprSizeOpReg (sLit "cvttsd2si") sz from to +pprInstr (CVTTSS2SIQ sz from to) = pprSizeSizeOpReg (sLit "cvttss2si") FF32 sz from to +pprInstr (CVTTSD2SIQ sz from to) = pprSizeSizeOpReg (sLit "cvttsd2si") FF64 sz from to pprInstr (CVTSI2SS sz from to) = pprSizeOpReg (sLit "cvtsi2ss") sz from to pprInstr (CVTSI2SD sz from to) = pprSizeOpReg (sLit "cvtsi2sd") sz from to @@ -1104,7 +1084,6 @@ pprSizeOpReg name size op1 reg2 pprReg archWordSize reg2 ] - pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> Doc pprCondRegReg name size cond reg1 reg2 = hcat [ @@ -1126,11 +1105,18 @@ pprSizeSizeRegReg name size1 size2 reg1 reg2 pprSize size2, space, pprReg size1 reg1, - comma, pprReg size2 reg2 ] +pprSizeSizeOpReg :: LitString -> Size -> Size -> Operand -> Reg -> Doc +pprSizeSizeOpReg name size1 size2 op1 reg2 + = hcat [ + pprMnemonic name size2, + pprOperand size1 op1, + comma, + pprReg size2 reg2 + ] pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc pprSizeRegRegReg name size reg1 reg2 reg3