{-# 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 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 :: ByteString -> SDoc
pprASCII :: ByteString -> SDoc
pprASCII ByteString
str
  
  
  
  
  
  
  
  = Doc -> SDoc
docToSDoc ((Word8 -> Doc -> Doc) -> Doc -> ByteString -> Doc
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 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w = String -> Doc
Pretty.text String
"\\t"
             | Word8
0x0A Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w = String -> Doc
Pretty.text String
"\\n"
             | Word8
0x22 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w = String -> Doc
Pretty.text String
"\\\""
             | Word8
0x5C Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w = String -> Doc
Pretty.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
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 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#)))
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
forall env a. OutputableP env a => env -> a -> SDoc
pdoc 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
ReadOnlyData16 | OS
OSMinGW32 <- Platform -> OS
platformOS Platform
platform
                                 -> String -> SDoc
text String
".rdata$cst16"
                     | Bool
otherwise -> String -> SDoc
text String
".rodata.cst16"
      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
_ ->
        String -> SDoc
forall a. String -> a
panic String
"PprBase.pprGNUSectionHeader: unknown section type"
    flags :: SDoc
flags = case SectionType
t of
      SectionType
Text
        | OS
OSMinGW32 <- Platform -> OS
platformOS Platform
platform, Bool
splitSections
                    -> String -> SDoc
text String
",\"xr\""
        | Bool
splitSections
                    -> String -> SDoc
text String
",\"ax\"," SDoc -> SDoc -> SDoc
<> Platform -> String -> SDoc
sectionType Platform
platform String
"progbits"
      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
ReadOnlyData16          -> String -> SDoc
text String
".csect .text[PR] # ReadOnlyData16"
  SectionType
CString                 -> String -> SDoc
text String
".csect .text[PR] # CString"
  SectionType
UninitialisedData       -> String -> SDoc
text String
".csect .data[BS]"
  SectionType
_                       -> String -> SDoc
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
ReadOnlyData16          -> String -> SDoc
text String
".const"
  SectionType
InitArray               -> String -> SDoc
text String
".section\t__DATA,__mod_init_func,mod_init_funcs"
  SectionType
FiniArray               -> String -> SDoc
forall a. String -> a
panic String
"pprDarwinSectionHeader: fini not supported"
  SectionType
CString                 -> String -> SDoc
text String
".section\t__TEXT,__cstring,cstring_literals"
  OtherSection String
_          -> String -> SDoc
forall a. String -> a
panic String
"pprDarwinSectionHeader: unknown section type"