X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FPprMach.hs;h=02ab265371311e043d0446185a40248e484234bf;hb=8a2809c29de9f23eba7ca682b48390033a9d40f6;hp=5c731f1b359cc054d27ed036c89640817b7f8481;hpb=22bbcd1dcd94851b8f9409310cf95f3b9332850c;p=ghc-hetmet.git diff --git a/compiler/nativeGen/PprMach.hs b/compiler/nativeGen/PprMach.hs index 5c731f1..02ab265 100644 --- a/compiler/nativeGen/PprMach.hs +++ b/compiler/nativeGen/PprMach.hs @@ -646,9 +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")) + SLIT(".section .data\n\t.align 4")) ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".const_data\n.align 3"), - SLIT(".section .rodata\n\t.align 8")) + 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")) ,))))) @@ -692,8 +692,18 @@ pprGloblDecl lbl SLIT(".globl ")) <> pprCLabel_asm lbl +pprTypeAndSizeDecl :: CLabel -> Doc +pprTypeAndSizeDecl lbl +#if linux_TARGET_OS + | not (externallyVisibleCLabel lbl) = empty + | otherwise = ptext SLIT(".type ") <> + pprCLabel_asm lbl <> ptext SLIT(", @object") +#else + = empty +#endif + pprLabel :: CLabel -> Doc -pprLabel lbl = pprGloblDecl lbl $$ (pprCLabel_asm lbl <> char ':') +pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':') pprASCII str @@ -760,7 +770,8 @@ pprDataItem lit -- 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 = @@ -769,7 +780,6 @@ pprDataItem lit | otherwise = [ptext SLIT("\t.quad\t") <> pprImm imm] where - isRelativeReloc (CmmLabelOff _ _) = True isRelativeReloc (CmmLabelDiffOff _ _ _) = True isRelativeReloc _ = False #endif @@ -1308,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 @@ -2395,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_ - -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 +castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8) +castFloatToWord8Array = castSTUArray -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 @@ -2442,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]) )