{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
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
{-# INLINE word8ToWord# #-}
#endif
floatToBytes :: Float -> [Word8]
floatToBytes :: Float -> [Word8]
floatToBytes Float
f = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
STUArray s Int Float
arr <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
newArray_ ((Int
0::Int),Int
3)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Float
arr Int
0 Float
f
let cast :: STUArray s Int Float -> ST s (STUArray s Int Word8)
cast :: forall s. STUArray s Int Float -> ST s (STUArray s Int Word8)
cast = forall s ix a b. STUArray s ix a -> ST s (STUArray s ix b)
U.castSTUArray
STUArray s Int Word8
arr <- forall s. STUArray s Int Float -> ST s (STUArray s Int Word8)
cast STUArray s Int Float
arr
Word8
i0 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word8
arr Int
0
Word8
i1 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word8
arr Int
1
Word8
i2 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word8
arr Int
2
Word8
i3 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word8
arr Int
3
forall (m :: * -> *) a. Monad m => a -> m a
return [Word8
i0,Word8
i1,Word8
i2,Word8
i3]
doubleToBytes :: Double -> [Word8]
doubleToBytes :: Double -> [Word8]
doubleToBytes Double
d = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
STUArray s Int Double
arr <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
newArray_ ((Int
0::Int),Int
7)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Double
arr Int
0 Double
d
let cast :: STUArray s Int Double -> ST s (STUArray s Int Word8)
cast :: forall s. STUArray s Int Double -> ST s (STUArray s Int Word8)
cast = forall s ix a b. STUArray s ix a -> ST s (STUArray s ix b)
U.castSTUArray
STUArray s Int Word8
arr <- forall s. STUArray s Int Double -> ST s (STUArray s Int Word8)
cast STUArray s Int Double
arr
Word8
i0 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word8
arr Int
0
Word8
i1 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word8
arr Int
1
Word8
i2 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word8
arr Int
2
Word8
i3 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word8
arr Int
3
Word8
i4 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word8
arr Int
4
Word8
i5 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word8
arr Int
5
Word8
i6 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word8
arr Int
6
Word8
i7 <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word8
arr Int
7
forall (m :: * -> *) a. Monad m => a -> m a
return [Word8
i0,Word8
i1,Word8
i2,Word8
i3,Word8
i4,Word8
i5,Word8
i6,Word8
i7]
pprASCII :: ByteString -> SDoc
pprASCII :: ByteString -> SDoc
pprASCII ByteString
str
= Doc -> SDoc
docToSDoc (forall a. (Word8 -> a -> a) -> a -> ByteString -> a
BS.foldr Word8 -> Doc -> Doc
f Doc
Pretty.empty ByteString
str)
where
f :: Word8 -> Pretty.Doc -> Pretty.Doc
f :: Word8 -> Doc -> Doc
f Word8
w Doc
s = Word8 -> Doc
do1 Word8
w Doc -> Doc -> Doc
Pretty.<> Doc
s
do1 :: Word8 -> Pretty.Doc
do1 :: Word8 -> Doc
do1 Word8
w | Word8
0x09 forall a. Eq a => a -> a -> Bool
== Word8
w = String -> Doc
Pretty.text String
"\\t"
| Word8
0x0A forall a. Eq a => a -> a -> Bool
== Word8
w = String -> Doc
Pretty.text String
"\\n"
| Word8
0x22 forall a. Eq a => a -> a -> Bool
== Word8
w = String -> Doc
Pretty.text String
"\\\""
| Word8
0x5C forall a. Eq a => a -> a -> Bool
== Word8
w = String -> Doc
Pretty.text String
"\\\\"
| Word8
w forall a. Ord a => a -> a -> Bool
>= Word8
0x20 Bool -> Bool -> Bool
&& Word8
w forall a. Ord a => a -> a -> Bool
<= Word8
0x7E = Char -> Doc
Pretty.char (Word8 -> Char
chr' Word8
w)
| Bool
otherwise = Int -> String -> Doc
Pretty.sizedText Int
4 String
xs
where
!xs :: String
xs = [ Char
'\\', Char
x0, Char
x1, Char
x2]
!x0 :: Char
x0 = Word8 -> Char
chr' (Word8
ord0 forall a. Num a => a -> a -> a
+ (Word8
w forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
6) forall a. Bits a => a -> a -> a
.&. Word8
0x07)
!x1 :: Char
x1 = Word8 -> Char
chr' (Word8
ord0 forall a. Num a => a -> a -> a
+ (Word8
w forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
3) forall a. Bits a => a -> a -> a
.&. Word8
0x07)
!x2 :: Char
x2 = Word8 -> Char
chr' (Word8
ord0 forall a. Num a => a -> a -> a
+ Word8
w forall a. Bits a => a -> a -> a
.&. Word8
0x07)
!ord0 :: Word8
ord0 = Word8
0x30
chr' :: Word8 -> Char
chr' :: Word8 -> Char
chr' (W8# Word8#
w#) = Char# -> Char
C# (Int# -> Char#
chr# (Word# -> Int#
word2Int# (Word8# -> Word#
word8ToWord# Word8#
w#)))
pprString :: ByteString -> SDoc
pprString :: ByteString -> SDoc
pprString ByteString
bs = String -> SDoc
text String
"\t.string " SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
doubleQuotes (ByteString -> SDoc
pprASCII ByteString
bs)
pprFileEmbed :: FilePath -> SDoc
pprFileEmbed :: String -> SDoc
pprFileEmbed String
path
= String -> SDoc
text String
"\t.incbin "
SDoc -> SDoc -> SDoc
<> String -> SDoc
pprFilePathString String
path
SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"\n\t.byte 0"
pprSectionHeader :: NCGConfig -> Section -> SDoc
NCGConfig
config (Section SectionType
t CLabel
suffix) =
case Platform -> OS
platformOS (NCGConfig -> Platform
ncgPlatform NCGConfig
config) of
OS
OSAIX -> SectionType -> SDoc
pprXcoffSectionHeader SectionType
t
OS
OSDarwin -> SectionType -> SDoc
pprDarwinSectionHeader SectionType
t
OS
_ -> NCGConfig -> SectionType -> CLabel -> SDoc
pprGNUSectionHeader NCGConfig
config SectionType
t CLabel
suffix
pprGNUSectionHeader :: NCGConfig -> SectionType -> CLabel -> SDoc
NCGConfig
config SectionType
t CLabel
suffix =
[SDoc] -> SDoc
hcat [String -> SDoc
text String
".section ", SDoc
header, SDoc
subsection, SDoc
flags]
where
sep :: SDoc
sep
| OS
OSMinGW32 <- Platform -> OS
platformOS Platform
platform = Char -> SDoc
char Char
'$'
| Bool
otherwise = Char -> SDoc
char Char
'.'
platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
splitSections :: Bool
splitSections = NCGConfig -> Bool
ncgSplitSections NCGConfig
config
subsection :: SDoc
subsection
| Bool
splitSections = SDoc
sep SDoc -> SDoc -> SDoc
<> Platform -> CLabel -> SDoc
pprAsmLabel Platform
platform CLabel
suffix
| Bool
otherwise = SDoc
empty
header :: SDoc
header = case SectionType
t of
SectionType
Text -> String -> SDoc
text String
".text"
SectionType
Data -> String -> SDoc
text String
".data"
SectionType
ReadOnlyData | OS
OSMinGW32 <- Platform -> OS
platformOS Platform
platform
-> String -> SDoc
text String
".rdata"
| Bool
otherwise -> String -> SDoc
text String
".rodata"
SectionType
RelocatableReadOnlyData | OS
OSMinGW32 <- Platform -> OS
platformOS Platform
platform
-> String -> SDoc
text String
".rdata$rel.ro"
| Bool
otherwise -> String -> SDoc
text String
".data.rel.ro"
SectionType
UninitialisedData -> String -> SDoc
text String
".bss"
SectionType
InitArray
| OS
OSMinGW32 <- Platform -> OS
platformOS Platform
platform
-> String -> SDoc
text String
".ctors"
| Bool
otherwise -> String -> SDoc
text String
".init_array"
SectionType
FiniArray
| OS
OSMinGW32 <- Platform -> OS
platformOS Platform
platform
-> String -> SDoc
text String
".dtors"
| Bool
otherwise -> String -> SDoc
text String
".fini_array"
SectionType
CString
| OS
OSMinGW32 <- Platform -> OS
platformOS Platform
platform
-> String -> SDoc
text String
".rdata"
| Bool
otherwise -> String -> SDoc
text String
".rodata.str"
OtherSection String
_ ->
forall a. String -> a
panic String
"PprBase.pprGNUSectionHeader: unknown section type"
flags :: SDoc
flags = case SectionType
t of
SectionType
CString
| OS
OSMinGW32 <- Platform -> OS
platformOS Platform
platform
-> SDoc
empty
| Bool
otherwise -> String -> SDoc
text String
",\"aMS\"," SDoc -> SDoc -> SDoc
<> Platform -> String -> SDoc
sectionType Platform
platform String
"progbits" SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
",1"
SectionType
_ -> SDoc
empty
pprXcoffSectionHeader :: SectionType -> SDoc
SectionType
t = case SectionType
t of
SectionType
Text -> String -> SDoc
text String
".csect .text[PR]"
SectionType
Data -> String -> SDoc
text String
".csect .data[RW]"
SectionType
ReadOnlyData -> String -> SDoc
text String
".csect .text[PR] # ReadOnlyData"
SectionType
RelocatableReadOnlyData -> String -> SDoc
text String
".csect .text[PR] # RelocatableReadOnlyData"
SectionType
CString -> String -> SDoc
text String
".csect .text[PR] # CString"
SectionType
UninitialisedData -> String -> SDoc
text String
".csect .data[BS]"
SectionType
_ -> forall a. String -> a
panic String
"pprXcoffSectionHeader: unknown section type"
pprDarwinSectionHeader :: SectionType -> SDoc
SectionType
t = case SectionType
t of
SectionType
Text -> String -> SDoc
text String
".text"
SectionType
Data -> String -> SDoc
text String
".data"
SectionType
ReadOnlyData -> String -> SDoc
text String
".const"
SectionType
RelocatableReadOnlyData -> String -> SDoc
text String
".const_data"
SectionType
UninitialisedData -> String -> SDoc
text String
".data"
SectionType
InitArray -> String -> SDoc
text String
".section\t__DATA,__mod_init_func,mod_init_funcs"
SectionType
FiniArray -> forall a. String -> a
panic String
"pprDarwinSectionHeader: fini not supported"
SectionType
CString -> String -> SDoc
text String
".section\t__TEXT,__cstring,cstring_literals"
OtherSection String
_ -> forall a. String -> a
panic String
"pprDarwinSectionHeader: unknown section type"