    {-# LANGUAGE CPP, MagicHash #-}

    -----------------------------------------------------------------------------
    --
    -- Pretty-printing assembly language
    --
    -- (c) The University of Glasgow 1993-2005
    --
    -----------------------------------------------------------------------------

    module GHC.CmmToAsm.Ppr (
            doubleToBytes,
            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.Data.FastString
    import GHC.Utils.Outputable
    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

    -- -----------------------------------------------------------------------------
    -- Converting floating-point literals to integrals for printing

    -- ToDo: this code is currently shared between SPARC and LLVM.
    --       Similar functions for (single precision) floats are
    --       present in the SPARC backend only. We need to fix both
    --       LLVM and SPARC.

    castDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8)
    castDoubleToWord8Array :: forall s. STUArray s Int Double -> ST s (STUArray s Int Word8)
    castDoubleToWord8Array = 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

    -- floatToBytes and doubleToBytes convert to the host's byte
    -- order.  Providing that we're not cross-compiling for a
    -- target with the opposite endianness, this should work ok
    -- on all targets.

    -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
    -- could they be merged?

    doubleToBytes :: Double -> [Int]
    doubleToBytes :: Double -> [Int]
    doubleToBytes Double
    d
       = (forall s. ST s [Int]) -> [Int]
    forall a. (forall s. ST s a) -> a
    runST (do
            STUArray s Int Double
    arr <- (Int, Int) -> ST s (STUArray s Int 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
            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)
    castDoubleToWord8Array 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
            [Int] -> ST s [Int]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Word8 -> Int) -> [Word8] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral [Word8
    i0,Word8
    i1,Word8
    i2,Word8
    i3,Word8
    i4,Word8
    i5,Word8
    i6,Word8
    i7])
         )

    -- ---------------------------------------------------------------------------
    -- Printing ASCII strings.
    --
    -- Print as a string and escape non-printable characters.
    -- This is similar to charToC in GHC.Utils.Misc

    pprASCII :: ByteString -> SDoc
    pprASCII :: ByteString -> SDoc
    pprASCII ByteString
    str
      -- Transform this given literal bytestring to escaped string and construct
      -- the literal SDoc directly.
      -- See #14741
      -- and Note [Pretty print ASCII when AsmCodeGen]
      = String -> SDoc
    text (String -> SDoc) -> String -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (Word8 -> String -> String) -> String -> ByteString -> String
    forall a. (Word8 -> a -> a) -> a -> ByteString -> a
    BS.foldr (\Word8
    w String
    s -> Word8 -> String
    do1 Word8
    w String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s) String
    "" ByteString
    str
        where
           do1 :: Word8 -> String
           do1 :: Word8 -> String
    do1 Word8
    w | Word8
    0x09 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    w = String
    "\\t"
                 | Word8
    0x0A Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    w = String
    "\\n"
                 | Word8
    0x22 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    w = String
    "\\\""
                 | Word8
    0x5C Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    w = String
    "\\\\"
                   -- ASCII printable characters range
                 | 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 = [Word8 -> Char
    chr' Word8
    w]
                 | Bool
    otherwise = Char
    '\\' Char -> String -> String
    forall a. a -> [a] -> [a]
    : Word8 -> String
    octal Word8
    w

           -- we know that the Chars we create are in the ASCII range
           -- so we bypass the check in "chr"
           chr' :: Word8 -> Char
           chr' :: Word8 -> Char
    chr' (W8# Word8#
    w#) = Char# -> Char
    C# (Int# -> Char#
    chr# (Word# -> Int#
    word2Int# (Word8# -> Word#
    word8ToWord# Word8#
    w#)))

           octal :: Word8 -> String
           octal :: Word8 -> String
    octal Word8
    w = [ 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)
                     , 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)
                     , 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 -- = ord '0'

    -- | Emit a ".string" directive
    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)

    -- | Emit a ".incbin" directive
    --
    -- A NULL byte is added after the binary data.
    pprFileEmbed :: FilePath -> SDoc
    pprFileEmbed :: String -> SDoc
    pprFileEmbed String
    path
       = String -> SDoc
    text String
    "\t.incbin "
         SDoc -> SDoc -> SDoc
    <> String -> SDoc
    pprFilePathString String
    path -- proper escape (see #16389)
         SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    "\n\t.byte 0"

    {-
    Note [Embedding large binary blobs]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    To embed a blob of binary data (e.g. an UTF-8 encoded string) into the generated
    code object, we have several options:

       1. Generate a ".byte" directive for each byte. This is what was done in the past
          (see Note [Pretty print ASCII when AsmCodeGen]).

       2. Generate a single ".string"/".asciz" directive for the whole sequence of
          bytes. Bytes in the ASCII printable range are rendered as characters and
          other values are escaped (e.g., "\t", "\077", etc.).

       3. Create a temporary file into which we dump the binary data and generate a
          single ".incbin" directive. The assembler will include the binary file for
          us in the generated output object.

    Now the code generator uses either (2) or (3), depending on the binary blob
    size.  Using (3) for small blobs adds too much overhead (see benchmark results
    in #16190), so we only do it when the size is above a threshold (500K at the
    time of writing).

    The threshold is configurable via the `-fbinary-blob-threshold` flag.

    -}

    {-
    Note [Pretty print ASCII when AsmCodeGen]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Previously, when generating assembly code, we created SDoc with
    `(ptext . sLit)` for every bytes in literal bytestring, then
    combine them using `hcat`.

    When handling literal bytestrings with millions of bytes,
    millions of SDoc would be created and to combine, leading to
    high memory usage.

    Now we escape the given bytestring to string directly and construct
    SDoc only once. This improvement could dramatically decrease the
    memory allocation from 4.7GB to 1.3GB when embedding a 3MB literal
    string in source code. See #14741 for profiling results.
    -}

    -- ----------------------------------------------------------------------------
    -- Printing section headers.
    --
    -- If -split-section was specified, include the suffix label, otherwise just
    -- print the section type. For Darwin, where subsections-for-symbols are
    -- used instead, only print section type.
    --
    -- For string literals, additional flags are specified to enable merging of
    -- identical strings in the linker. With -split-sections each string also gets
    -- a unique section to allow strings from unused code to be GC'd.

    pprSectionHeader :: NCGConfig -> Section -> SDoc
    pprSectionHeader :: NCGConfig -> Section -> SDoc
    pprSectionHeader 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
    OSMinGW32 -> NCGConfig -> SDoc -> SectionType -> CLabel -> SDoc
    pprGNUSectionHeader NCGConfig
    config (Char -> SDoc
    char Char
    '$') SectionType
    t CLabel
    suffix
       OS
    _         -> NCGConfig -> SDoc -> SectionType -> CLabel -> SDoc
    pprGNUSectionHeader NCGConfig
    config (Char -> SDoc
    char Char
    '.') SectionType
    t CLabel
    suffix

    pprGNUSectionHeader :: NCGConfig -> SDoc -> SectionType -> CLabel -> SDoc
    pprGNUSectionHeader :: NCGConfig -> SDoc -> SectionType -> CLabel -> SDoc
    pprGNUSectionHeader NCGConfig
    config SDoc
    sep SectionType
    t CLabel
    suffix =
      String -> SDoc
    text String
    ".section " SDoc -> SDoc -> SDoc
    <> PtrString -> SDoc
    ptext PtrString
    header SDoc -> SDoc -> SDoc
    <> SDoc
    subsection SDoc -> SDoc -> SDoc
    <> SDoc
    flags
      where
        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 :: PtrString
    header = case SectionType
    t of
          SectionType
    Text -> String -> PtrString
    sLit String
    ".text"
          SectionType
    Data -> String -> PtrString
    sLit String
    ".data"
          SectionType
    ReadOnlyData  | OS
    OSMinGW32 <- Platform -> OS
    platformOS Platform
    platform
                                    -> String -> PtrString
    sLit String
    ".rdata"
                        | Bool
    otherwise -> String -> PtrString
    sLit String
    ".rodata"
          SectionType
    RelocatableReadOnlyData | OS
    OSMinGW32 <- Platform -> OS
    platformOS Platform
    platform
                                    -- Concept does not exist on Windows,
                                    -- So map these to R/O data.
                                              -> String -> PtrString
    sLit String
    ".rdata$rel.ro"
                                  | Bool
    otherwise -> String -> PtrString
    sLit String
    ".data.rel.ro"
          SectionType
    UninitialisedData -> String -> PtrString
    sLit String
    ".bss"
          SectionType
    ReadOnlyData16 | OS
    OSMinGW32 <- Platform -> OS
    platformOS Platform
    platform
                                     -> String -> PtrString
    sLit String
    ".rdata$cst16"
                         | Bool
    otherwise -> String -> PtrString
    sLit String
    ".rodata.cst16"
          SectionType
    CString
            | OS
    OSMinGW32 <- Platform -> OS
    platformOS Platform
    platform
                        -> String -> PtrString
    sLit String
    ".rdata"
            | Bool
    otherwise -> String -> PtrString
    sLit String
    ".rodata.str"
          OtherSection String
    _ ->
            String -> PtrString
    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

    -- XCOFF doesn't support relocating label-differences, so we place all
    -- RO sections into .text[PR] sections
    pprXcoffSectionHeader :: SectionType -> SDoc
    pprXcoffSectionHeader :: SectionType -> SDoc
    pprXcoffSectionHeader SectionType
    t = String -> SDoc
    text (String -> SDoc) -> String -> SDoc
    forall a b. (a -> b) -> a -> b
    $ case SectionType
    t of
         SectionType
    Text                    -> String
    ".csect .text[PR]"
         SectionType
    Data                    -> String
    ".csect .data[RW]"
         SectionType
    ReadOnlyData            -> String
    ".csect .text[PR] # ReadOnlyData"
         SectionType
    RelocatableReadOnlyData -> String
    ".csect .text[PR] # RelocatableReadOnlyData"
         SectionType
    ReadOnlyData16          -> String
    ".csect .text[PR] # ReadOnlyData16"
         SectionType
    CString                 -> String
    ".csect .text[PR] # CString"
         SectionType
    UninitialisedData       -> String
    ".csect .data[BS]"
         OtherSection String
    _          ->
           String -> String
    forall a. String -> a
    panic String
    "PprBase.pprXcoffSectionHeader: unknown section type"

    pprDarwinSectionHeader :: SectionType -> SDoc
    pprDarwinSectionHeader :: SectionType -> SDoc
    pprDarwinSectionHeader SectionType
    t =
      PtrString -> SDoc
    ptext (PtrString -> SDoc) -> PtrString -> SDoc
    forall a b. (a -> b) -> a -> b
    $ case SectionType
    t of
         SectionType
    Text -> String -> PtrString
    sLit String
    ".text"
         SectionType
    Data -> String -> PtrString
    sLit String
    ".data"
         SectionType
    ReadOnlyData -> String -> PtrString
    sLit String
    ".const"
         SectionType
    RelocatableReadOnlyData -> String -> PtrString
    sLit String
    ".const_data"
         SectionType
    UninitialisedData -> String -> PtrString
    sLit String
    ".data"
         SectionType
    ReadOnlyData16 -> String -> PtrString
    sLit String
    ".const"
         SectionType
    CString -> String -> PtrString
    sLit String
    ".section\t__TEXT,__cstring,cstring_literals"
         OtherSection String
    _ ->
           String -> PtrString
    forall a. String -> a
    panic String
    "PprBase.pprDarwinSectionHeader: unknown section type"