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