X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FPprMach.hs;h=ba8a5d9bf66f923128dc4b23e2201e9e91228674;hb=3b2fc9e1d79acff6a09dc1477d3e4bfe3bb3ad55;hp=6ca3bde880bb7e6ccb4672c6b994c49f81339530;hpb=16dbc25769d2c23314a97be10a824b7bb921ae49;p=ghc-hetmet.git diff --git a/compiler/nativeGen/PprMach.hs b/compiler/nativeGen/PprMach.hs index 6ca3bde..ba8a5d9 100644 --- a/compiler/nativeGen/PprMach.hs +++ b/compiler/nativeGen/PprMach.hs @@ -37,8 +37,6 @@ import Pretty import FastString import qualified Outputable -import StaticFlags ( opt_PIC, opt_Static ) - import Data.Array.ST import Data.Word ( Word8 ) import Control.Monad.ST @@ -618,7 +616,8 @@ pprSectionHeader Text ,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_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 @@ -627,7 +626,8 @@ pprSectionHeader Data ,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(SLIT(".data\n\t.align 8") + ,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 @@ -636,7 +636,8 @@ pprSectionHeader ReadOnlyData ,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(SLIT(".section .rodata\n\t.align 8") + ,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")) ,))))) @@ -645,8 +646,9 @@ pprSectionHeader RelocatableReadOnlyData 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") + 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")) ,))))) @@ -654,9 +656,10 @@ 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(".const_data\n\t.align 2"), + ,IF_ARCH_i386(IF_OS_darwin(SLIT(".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_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")) ,))))) @@ -666,7 +669,8 @@ pprSectionHeader ReadOnlyData16 ,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_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")) ,))))) @@ -688,8 +692,18 @@ pprGloblDecl lbl SLIT(".globl ")) <> pprCLabel_asm lbl +pprTypeAndSizeDecl :: CLabel -> Doc +pprTypeAndSizeDecl lbl +#if mingw32_TARGET_OS + = empty +#else + | not (externallyVisibleCLabel lbl) = empty + | otherwise = ptext SLIT(".type ") <> + pprCLabel_asm lbl <> ptext SLIT(", @object") +#endif + pprLabel :: CLabel -> Doc -pprLabel lbl = pprGloblDecl lbl $$ (pprCLabel_asm lbl <> char ':') +pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':') pprASCII str @@ -701,7 +715,7 @@ pprASCII str 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 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 @@ -747,16 +761,17 @@ pprDataItem lit <> int (fromIntegral (fromIntegral (x `shiftR` 32) :: Word32))] #endif -#if i386_TARGET_ARCH +#if i386_TARGET_ARCH || (darwin_TARGET_OS && x86_64_TARGET_ARCH) ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm] #endif -#if x86_64_TARGET_ARCH +#if x86_64_TARGET_ARCH && !darwin_TARGET_OS -- 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). + -- + -- See Note [x86-64-relative] in includes/InfoTables.h -- ppr_item I64 x | isRelativeReloc x = @@ -765,7 +780,6 @@ pprDataItem lit | otherwise = [ptext SLIT("\t.quad\t") <> pprImm imm] where - isRelativeReloc (CmmLabelOff _ _) = True isRelativeReloc (CmmLabelDiffOff _ _ _) = True isRelativeReloc _ = False #endif @@ -1287,6 +1301,8 @@ pprInstr (JXX cond (BlockId id)) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab) where lab = mkAsmTempLabel id +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_TBL op ids) = pprInstr (JMP op) @@ -1302,12 +1318,12 @@ 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("cvtss2siq") from to -pprInstr (CVTSD2SI from to) = pprOpReg SLIT("cvtsd2siq") 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 @@ -2158,6 +2174,19 @@ pprInstr (BCC cond (BlockId id)) = hcat [ ] where lbl = mkAsmTempLabel id +pprInstr (BCCFAR cond (BlockId id)) = vcat [ + hcat [ + ptext SLIT("\tb"), + pprCond (condNegate cond), + ptext SLIT("\t$+8") + ], + hcat [ + ptext SLIT("\tb\t"), + pprCLabel_asm lbl + ] + ] + where lbl = mkAsmTempLabel id + pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel char '\t', ptext SLIT("b"), @@ -2318,6 +2347,8 @@ pprInstr (FETCHPC reg) = vcat [ hcat [ ptext SLIT("1:\tmflr\t"), pprReg reg ] ] +pprInstr LWSYNC = ptext SLIT("\tlwsync") + pprInstr _ = panic "pprInstr (ppc)" pprLogic op reg1 reg2 ri = hcat [ @@ -2374,41 +2405,11 @@ limitShiftRI x = x -- ----------------------------------------------------------------------------- -- Converting floating-point literals to integrals for printing -#if __GLASGOW_HASKELL__ >= 504 -newFloatArray :: (Int,Int) -> ST s (STUArray s Int Float) -newFloatArray = newArray_ +castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8) +castFloatToWord8Array = castSTUArray -newDoubleArray :: (Int,Int) -> ST s (STUArray s Int Double) -newDoubleArray = newArray_ - -castFloatToCharArray :: STUArray s Int Float -> ST s (STUArray s Int Word8) -castFloatToCharArray = castSTUArray - -castDoubleToCharArray :: STUArray s Int Double -> ST s (STUArray s Int Word8) -castDoubleToCharArray = castSTUArray - -writeFloatArray :: STUArray s Int Float -> Int -> Float -> ST s () -writeFloatArray = writeArray - -writeDoubleArray :: STUArray s Int Double -> Int -> Double -> ST s () -writeDoubleArray = writeArray - -readCharArray :: STUArray s Int Word8 -> Int -> ST s Char -readCharArray arr i = do - w <- readArray arr i - return $! (chr (fromIntegral w)) - -#else - -castFloatToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t) -castFloatToCharArray = return - -castDoubleToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t) - - -castDoubleToCharArray = return - -#endif +castDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8) +castDoubleToWord8Array = castSTUArray -- floatToBytes and doubleToBytes convert to the host's byte -- order. Providing that we're not cross-compiling for a @@ -2421,29 +2422,29 @@ castDoubleToCharArray = return floatToBytes :: Float -> [Int] floatToBytes f = runST (do - arr <- newFloatArray ((0::Int),3) - writeFloatArray arr 0 f - arr <- castFloatToCharArray arr - i0 <- readCharArray arr 0 - i1 <- readCharArray arr 1 - i2 <- readCharArray arr 2 - i3 <- readCharArray arr 3 - return (map ord [i0,i1,i2,i3]) + arr <- newArray_ ((0::Int),3) + writeArray arr 0 f + arr <- castFloatToWord8Array arr + i0 <- readArray arr 0 + i1 <- readArray arr 1 + i2 <- readArray arr 2 + i3 <- readArray arr 3 + return (map fromIntegral [i0,i1,i2,i3]) ) doubleToBytes :: Double -> [Int] doubleToBytes d = runST (do - arr <- newDoubleArray ((0::Int),7) - writeDoubleArray arr 0 d - arr <- castDoubleToCharArray arr - i0 <- readCharArray arr 0 - i1 <- readCharArray arr 1 - i2 <- readCharArray arr 2 - i3 <- readCharArray arr 3 - i4 <- readCharArray arr 4 - i5 <- readCharArray arr 5 - i6 <- readCharArray arr 6 - i7 <- readCharArray arr 7 - return (map ord [i0,i1,i2,i3,i4,i5,i6,i7]) + arr <- newArray_ ((0::Int),7) + writeArray arr 0 d + arr <- castDoubleToWord8Array arr + i0 <- readArray arr 0 + i1 <- readArray arr 1 + i2 <- readArray arr 2 + i3 <- readArray arr 3 + i4 <- readArray arr 4 + i5 <- readArray arr 5 + i6 <- readArray arr 6 + i7 <- readArray arr 7 + return (map fromIntegral [i0,i1,i2,i3,i4,i5,i6,i7]) )