module PprBase (
castFloatToWord8Array,
castDoubleToWord8Array,
floatToBytes,
doubleToBytes,
pprASCII,
pprBytes,
pprSectionHeader
)
where
import GhcPrelude
import AsmUtils
import CLabel
import Cmm
import DynFlags
import FastString
import Outputable
import GHC.Platform
import FileCleanup
import qualified Data.Array.Unsafe as U ( castSTUArray )
import Data.Array.ST
import Control.Monad.ST
import Data.Word
import Data.Bits
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import GHC.Exts
import GHC.Word
import System.IO.Unsafe
castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)
castFloatToWord8Array = U.castSTUArray
castDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8)
castDoubleToWord8Array = U.castSTUArray
floatToBytes :: Float -> [Int]
floatToBytes f
= runST (do
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 <- 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])
)
pprASCII :: ByteString -> SDoc
pprASCII str
= text $ BS.foldr (\w s -> do1 w ++ s) "" str
where
do1 :: Word8 -> String
do1 w | 0x09 == w = "\\t"
| 0x0A == w = "\\n"
| 0x22 == w = "\\\""
| 0x5C == w = "\\\\"
| w >= 0x20 && w <= 0x7E = [chr' w]
| otherwise = '\\' : octal w
chr' :: Word8 -> Char
chr' (W8# w#) = C# (chr# (word2Int# w#))
octal :: Word8 -> String
octal w = [ chr' (ord0 + (w `unsafeShiftR` 6) .&. 0x07)
, chr' (ord0 + (w `unsafeShiftR` 3) .&. 0x07)
, chr' (ord0 + w .&. 0x07)
]
ord0 = 0x30
pprBytes :: ByteString -> SDoc
pprBytes bs = sdocWithDynFlags $ \dflags ->
if binBlobThreshold dflags == 0
|| fromIntegral (BS.length bs) <= binBlobThreshold dflags
then text "\t.string " <> doubleQuotes (pprASCII bs)
else unsafePerformIO $ do
bFile <- newTempName dflags TFL_CurrentModule ".dat"
BS.writeFile bFile bs
return $ text "\t.incbin "
<> pprFilePathString bFile
<> text "\n\t.byte 0"
pprSectionHeader :: Platform -> Section -> SDoc
pprSectionHeader platform (Section t suffix) =
case platformOS platform of
OSAIX -> pprXcoffSectionHeader t
OSDarwin -> pprDarwinSectionHeader t
OSMinGW32 -> pprGNUSectionHeader (char '$') t suffix
_ -> pprGNUSectionHeader (char '.') t suffix
pprGNUSectionHeader :: SDoc -> SectionType -> CLabel -> SDoc
pprGNUSectionHeader sep t suffix = sdocWithDynFlags $ \dflags ->
let splitSections = gopt Opt_SplitSections dflags
subsection | splitSections = sep <> ppr suffix
| otherwise = empty
in text ".section " <> ptext (header dflags) <> subsection <>
flags dflags
where
header dflags = case t of
Text -> sLit ".text"
Data -> sLit ".data"
ReadOnlyData | OSMinGW32 <- platformOS (targetPlatform dflags)
-> sLit ".rdata"
| otherwise -> sLit ".rodata"
RelocatableReadOnlyData | OSMinGW32 <- platformOS (targetPlatform dflags)
-> sLit ".rdata$rel.ro"
| otherwise -> sLit ".data.rel.ro"
UninitialisedData -> sLit ".bss"
ReadOnlyData16 | OSMinGW32 <- platformOS (targetPlatform dflags)
-> sLit ".rdata$cst16"
| otherwise -> sLit ".rodata.cst16"
CString
| OSMinGW32 <- platformOS (targetPlatform dflags)
-> sLit ".rdata"
| otherwise -> sLit ".rodata.str"
OtherSection _ ->
panic "PprBase.pprGNUSectionHeader: unknown section type"
flags dflags = case t of
CString
| OSMinGW32 <- platformOS (targetPlatform dflags)
-> empty
| otherwise -> text ",\"aMS\"," <> sectionType "progbits" <> text ",1"
_ -> empty
pprXcoffSectionHeader :: SectionType -> SDoc
pprXcoffSectionHeader t = text $ case t of
Text -> ".csect .text[PR]"
Data -> ".csect .data[RW]"
ReadOnlyData -> ".csect .text[PR] # ReadOnlyData"
RelocatableReadOnlyData -> ".csect .text[PR] # RelocatableReadOnlyData"
ReadOnlyData16 -> ".csect .text[PR] # ReadOnlyData16"
CString -> ".csect .text[PR] # CString"
UninitialisedData -> ".csect .data[BS]"
OtherSection _ ->
panic "PprBase.pprXcoffSectionHeader: unknown section type"
pprDarwinSectionHeader :: SectionType -> SDoc
pprDarwinSectionHeader t =
ptext $ case t of
Text -> sLit ".text"
Data -> sLit ".data"
ReadOnlyData -> sLit ".const"
RelocatableReadOnlyData -> sLit ".const_data"
UninitialisedData -> sLit ".data"
ReadOnlyData16 -> sLit ".const"
CString -> sLit ".section\t__TEXT,__cstring,cstring_literals"
OtherSection _ ->
panic "PprBase.pprDarwinSectionHeader: unknown section type"