module GHC.CmmToAsm.Ppr (
doubleToBytes,
floatToBytes,
pprASCII,
pprString,
pprFileEmbed,
pprSectionHeader
)
where
import GHC.Prelude
import GHC.Utils.Asm
import GHC.Cmm.CLabel
import GHC.Cmm
import GHC.CmmToAsm.Config
import GHC.Utils.Outputable as SDoc
import qualified GHC.Utils.Ppr as Pretty
import GHC.Utils.Panic
import GHC.Platform
import qualified Data.Array.Unsafe as U ( castSTUArray )
import Data.Array.ST
import Control.Monad.ST
import Data.Word
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import GHC.Exts
import GHC.Word
#if !MIN_VERSION_base(4,16,0)
word8ToWord# :: Word# -> Word#
word8ToWord# w = w
#endif
floatToBytes :: Float -> [Word8]
floatToBytes f = runST $ do
arr <- newArray_ ((0::Int),3)
writeArray arr 0 f
let cast :: STUArray s Int Float -> ST s (STUArray s Int Word8)
cast = U.castSTUArray
arr <- cast arr
i0 <- readArray arr 0
i1 <- readArray arr 1
i2 <- readArray arr 2
i3 <- readArray arr 3
return [i0,i1,i2,i3]
doubleToBytes :: Double -> [Word8]
doubleToBytes d = runST $ do
arr <- newArray_ ((0::Int),7)
writeArray arr 0 d
let cast :: STUArray s Int Double -> ST s (STUArray s Int Word8)
cast = U.castSTUArray
arr <- cast 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 [i0,i1,i2,i3,i4,i5,i6,i7]
pprASCII :: ByteString -> SDoc
pprASCII str
= docToSDoc (BS.foldr f Pretty.empty str)
where
f :: Word8 -> Pretty.Doc -> Pretty.Doc
f w s = do1 w Pretty.<> s
do1 :: Word8 -> Pretty.Doc
do1 w | 0x09 == w = Pretty.text "\\t"
| 0x0A == w = Pretty.text "\\n"
| 0x22 == w = Pretty.text "\\\""
| 0x5C == w = Pretty.text "\\\\"
| w >= 0x20 && w <= 0x7E = Pretty.char (chr' w)
| otherwise = Pretty.sizedText 4 xs
where
!xs = [ '\\', x0, x1, x2]
!x0 = chr' (ord0 + (w `unsafeShiftR` 6) .&. 0x07)
!x1 = chr' (ord0 + (w `unsafeShiftR` 3) .&. 0x07)
!x2 = chr' (ord0 + w .&. 0x07)
!ord0 = 0x30
chr' :: Word8 -> Char
chr' (W8# w#) = C# (chr# (word2Int# (word8ToWord# w#)))
pprString :: ByteString -> SDoc
pprString bs = text "\t.string " <> doubleQuotes (pprASCII bs)
pprFileEmbed :: FilePath -> SDoc
pprFileEmbed path
= text "\t.incbin "
<> pprFilePathString path
<> text "\n\t.byte 0"
pprSectionHeader :: NCGConfig -> Section -> SDoc
pprSectionHeader config (Section t suffix) =
case platformOS (ncgPlatform config) of
OSAIX -> pprXcoffSectionHeader t
OSDarwin -> pprDarwinSectionHeader t
_ -> pprGNUSectionHeader config t suffix
pprGNUSectionHeader :: NCGConfig -> SectionType -> CLabel -> SDoc
pprGNUSectionHeader config t suffix =
hcat [text ".section ", header, subsection, flags]
where
sep
| OSMinGW32 <- platformOS platform = char '$'
| otherwise = char '.'
platform = ncgPlatform config
splitSections = ncgSplitSections config
subsection
| splitSections = sep <> pdoc platform suffix
| otherwise = empty
header = case t of
Text -> text ".text"
Data -> text ".data"
ReadOnlyData | OSMinGW32 <- platformOS platform
-> text ".rdata"
| otherwise -> text ".rodata"
RelocatableReadOnlyData | OSMinGW32 <- platformOS platform
-> text ".rdata$rel.ro"
| otherwise -> text ".data.rel.ro"
UninitialisedData -> text ".bss"
ReadOnlyData16 | OSMinGW32 <- platformOS platform
-> text ".rdata$cst16"
| otherwise -> text ".rodata.cst16"
InitArray
| OSMinGW32 <- platformOS platform
-> text ".ctors"
| otherwise -> text ".init_array"
FiniArray
| OSMinGW32 <- platformOS platform
-> text ".dtors"
| otherwise -> text ".fini_array"
CString
| OSMinGW32 <- platformOS platform
-> text ".rdata"
| otherwise -> text ".rodata.str"
OtherSection _ ->
panic "PprBase.pprGNUSectionHeader: unknown section type"
flags = case t of
CString
| OSMinGW32 <- platformOS platform
-> empty
| otherwise -> text ",\"aMS\"," <> sectionType platform "progbits" <> text ",1"
_ -> empty
pprXcoffSectionHeader :: SectionType -> SDoc
pprXcoffSectionHeader t = case t of
Text -> text ".csect .text[PR]"
Data -> text ".csect .data[RW]"
ReadOnlyData -> text ".csect .text[PR] # ReadOnlyData"
RelocatableReadOnlyData -> text ".csect .text[PR] # RelocatableReadOnlyData"
ReadOnlyData16 -> text ".csect .text[PR] # ReadOnlyData16"
CString -> text ".csect .text[PR] # CString"
UninitialisedData -> text ".csect .data[BS]"
_ -> panic "pprXcoffSectionHeader: unknown section type"
pprDarwinSectionHeader :: SectionType -> SDoc
pprDarwinSectionHeader t = case t of
Text -> text ".text"
Data -> text ".data"
ReadOnlyData -> text ".const"
RelocatableReadOnlyData -> text ".const_data"
UninitialisedData -> text ".data"
ReadOnlyData16 -> text ".const"
InitArray -> text ".section\t__DATA,__mod_init_func,mod_init_funcs"
FiniArray -> panic "pprDarwinSectionHeader: fini not supported"
CString -> text ".section\t__TEXT,__cstring,cstring_literals"
OtherSection _ -> panic "pprDarwinSectionHeader: unknown section type"