    {-# LANGUAGE CPP #-}
    -- ----------------------------------------------------------------------------
    -- | Handle conversion of CmmData to LLVM code.
    --

    module GHC.CmmToLlvm.Data (
            genLlvmData, genData
        ) where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Llvm
    import GHC.CmmToLlvm.Base

    import GHC.Cmm.BlockId
    import GHC.Cmm.CLabel
    import GHC.Cmm
    import GHC.Platform

    import GHC.Data.FastString
    import GHC.Utils.Panic
    import qualified Data.ByteString as BS

    -- ----------------------------------------------------------------------------
    -- * Constants
    --

    -- | The string appended to a variable name to create its structure type alias
    structStr :: LMString
    structStr :: LMString
    structStr = String -> LMString
    fsLit String
    "_struct"

    -- | The LLVM visibility of the label
    linkage :: CLabel -> LlvmLinkageType
    linkage :: CLabel -> LlvmLinkageType
    linkage CLabel
    lbl = if CLabel -> Bool
    externallyVisibleCLabel CLabel
    lbl
                  then LlvmLinkageType
    ExternallyVisible else LlvmLinkageType
    Internal

    -- ----------------------------------------------------------------------------
    -- * Top level
    --

    -- | Pass a CmmStatic section to an equivalent Llvm code.
    genLlvmData :: (Section, RawCmmStatics) -> LlvmM LlvmData
    -- See note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
    genLlvmData :: (Section, RawCmmStatics) -> LlvmM LlvmData
    genLlvmData (Section
    _, CmmStaticsRaw CLabel
    alias [CmmStaticLit (CmmLabel CLabel
    lbl), CmmStaticLit CmmLit
    ind, CmmStatic
    _, CmmStatic
    _])
      | CLabel
    lbl forall a. Eq a => a -> a -> Bool
    == CLabel
    mkIndStaticInfoLabel
      , let labelInd :: CmmLit -> Maybe CLabel
    labelInd (CmmLabelOff CLabel
    l Int
    _) = forall a. a -> Maybe a
    Just CLabel
    l
            labelInd (CmmLabel CLabel
    l) = forall a. a -> Maybe a
    Just CLabel
    l
            labelInd CmmLit
    _ = forall a. Maybe a
    Nothing
      , Just CLabel
    ind' <- CmmLit -> Maybe CLabel
    labelInd CmmLit
    ind
      , CLabel
    alias CLabel -> CLabel -> Bool
    `mayRedirectTo` CLabel
    ind' = do
        LMString
    label <- CLabel -> LlvmM LMString
    strCLabel_llvm CLabel
    alias
        LMString
    label' <- CLabel -> LlvmM LMString
    strCLabel_llvm CLabel
    ind'
        let link :: LlvmLinkageType
    link     = CLabel -> LlvmLinkageType
    linkage CLabel
    alias
            link' :: LlvmLinkageType
    link'    = CLabel -> LlvmLinkageType
    linkage CLabel
    ind'
            -- the LLVM type we give the alias is an empty struct type
            -- but it doesn't really matter, as the pointer is only
            -- used for (bit/int)casting.
            tyAlias :: LlvmType
    tyAlias  = LlvmAlias -> LlvmType
    LMAlias (LMString
    label LMString -> LMString -> LMString
    `appendFS` LMString
    structStr, [LlvmType] -> LlvmType
    LMStructU [])

            aliasDef :: LlvmVar
    aliasDef = LMString
    -> LlvmType
    -> LlvmLinkageType
    -> LMSection
    -> LMAlign
    -> LMConst
    -> LlvmVar
    LMGlobalVar LMString
    label LlvmType
    tyAlias LlvmLinkageType
    link forall a. Maybe a
    Nothing forall a. Maybe a
    Nothing LMConst
    Alias
            -- we don't know the type of the indirectee here
            indType :: a
    indType  = forall a. String -> a
    panic String
    "will be filled by 'aliasify', later"
            orig :: LlvmStatic
    orig     = LlvmVar -> LlvmStatic
    LMStaticPointer forall a b. (a -> b) -> a -> b
    $ LMString
    -> LlvmType
    -> LlvmLinkageType
    -> LMSection
    -> LMAlign
    -> LMConst
    -> LlvmVar
    LMGlobalVar LMString
    label' forall {a}. a
    indType LlvmLinkageType
    link' forall a. Maybe a
    Nothing forall a. Maybe a
    Nothing LMConst
    Alias

        forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([LlvmVar -> Maybe LlvmStatic -> LMGlobal
    LMGlobal LlvmVar
    aliasDef forall a b. (a -> b) -> a -> b
    $ forall a. a -> Maybe a
    Just LlvmStatic
    orig], [LlvmType
    tyAlias])

    genLlvmData (Section
    sec, CmmStaticsRaw CLabel
    lbl [CmmStatic]
    xs) = do
        LMString
    label <- CLabel -> LlvmM LMString
    strCLabel_llvm CLabel
    lbl
        [LlvmStatic]
    static <- forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM CmmStatic -> LlvmM LlvmStatic
    genData [CmmStatic]
    xs
        LMSection
    lmsec <- Section -> LlvmM LMSection
    llvmSection Section
    sec
        Platform
    platform <- LlvmM Platform
    getPlatform
        let types :: [LlvmType]
    types   = forall a b. (a -> b) -> [a] -> [b]
    map LlvmStatic -> LlvmType
    getStatType [LlvmStatic]
    static

            strucTy :: LlvmType
    strucTy = [LlvmType] -> LlvmType
    LMStruct [LlvmType]
    types
            tyAlias :: LlvmType
    tyAlias = LlvmAlias -> LlvmType
    LMAlias (LMString
    label LMString -> LMString -> LMString
    `appendFS` LMString
    structStr, LlvmType
    strucTy)

            struct :: Maybe LlvmStatic
    struct         = forall a. a -> Maybe a
    Just forall a b. (a -> b) -> a -> b
    $ [LlvmStatic] -> LlvmType -> LlvmStatic
    LMStaticStruc [LlvmStatic]
    static LlvmType
    tyAlias
            link :: LlvmLinkageType
    link           = CLabel -> LlvmLinkageType
    linkage CLabel
    lbl
            align :: LMAlign
    align          = case Section
    sec of
                                Section SectionType
    CString CLabel
    _ -> if (Platform -> Arch
    platformArch Platform
    platform forall a. Eq a => a -> a -> Bool
    == Arch
    ArchS390X)
                                                        then forall a. a -> Maybe a
    Just Int
    2 else forall a. a -> Maybe a
    Just Int
    1
                                Section
    _                 -> forall a. Maybe a
    Nothing
            const :: LMConst
    const          = if Section -> SectionProtection
    sectionProtection Section
    sec forall a. Eq a => a -> a -> Bool
    == SectionProtection
    ReadOnlySection
                                then LMConst
    Constant else LMConst
    Global
            varDef :: LlvmVar
    varDef         = LMString
    -> LlvmType
    -> LlvmLinkageType
    -> LMSection
    -> LMAlign
    -> LMConst
    -> LlvmVar
    LMGlobalVar LMString
    label LlvmType
    tyAlias LlvmLinkageType
    link LMSection
    lmsec LMAlign
    align LMConst
    const
            globDef :: LMGlobal
    globDef        = LlvmVar -> Maybe LlvmStatic -> LMGlobal
    LMGlobal LlvmVar
    varDef Maybe LlvmStatic
    struct

        forall (m :: * -> *) a. Monad m => a -> m a
    return ([LMGlobal
    globDef], [LlvmType
    tyAlias])

    -- | Format the section type part of a Cmm Section
    llvmSectionType :: Platform -> SectionType -> FastString
    llvmSectionType :: Platform -> SectionType -> LMString
    llvmSectionType Platform
    p SectionType
    t = case SectionType
    t of
        SectionType
    Text                    -> String -> LMString
    fsLit String
    ".text"
        SectionType
    ReadOnlyData            -> case Platform -> OS
    platformOS Platform
    p of
                                     OS
    OSMinGW32 -> String -> LMString
    fsLit String
    ".rdata"
                                     OS
    _         -> String -> LMString
    fsLit String
    ".rodata"
        SectionType
    RelocatableReadOnlyData -> case Platform -> OS
    platformOS Platform
    p of
                                     OS
    OSMinGW32 -> String -> LMString
    fsLit String
    ".rdata$rel.ro"
                                     OS
    _         -> String -> LMString
    fsLit String
    ".data.rel.ro"
        SectionType
    ReadOnlyData16          -> case Platform -> OS
    platformOS Platform
    p of
                                     OS
    OSMinGW32 -> String -> LMString
    fsLit String
    ".rdata$cst16"
                                     OS
    _         -> String -> LMString
    fsLit String
    ".rodata.cst16"
        SectionType
    Data                    -> String -> LMString
    fsLit String
    ".data"
        SectionType
    UninitialisedData       -> String -> LMString
    fsLit String
    ".bss"
        SectionType
    CString                 -> case Platform -> OS
    platformOS Platform
    p of
                                     OS
    OSMinGW32 -> String -> LMString
    fsLit String
    ".rdata$str"
                                     OS
    _         -> String -> LMString
    fsLit String
    ".rodata.str"
        (OtherSection String
    _)        -> forall a. String -> a
    panic String
    "llvmSectionType: unknown section type"

    -- | Format a Cmm Section into a LLVM section name
    llvmSection :: Section -> LlvmM LMSection
    llvmSection :: Section -> LlvmM LMSection
    llvmSection (Section SectionType
    t CLabel
    suffix) = do
      LlvmOpts
    opts <- LlvmM LlvmOpts
    getLlvmOpts
      let splitSect :: Bool
    splitSect = LlvmOpts -> Bool
    llvmOptsSplitSections LlvmOpts
    opts
          platform :: Platform
    platform  = LlvmOpts -> Platform
    llvmOptsPlatform LlvmOpts
    opts
      if Bool -> Bool
    not Bool
    splitSect
      then forall (m :: * -> *) a. Monad m => a -> m a
    return forall a. Maybe a
    Nothing
      else do
        LMString
    lmsuffix <- CLabel -> LlvmM LMString
    strCLabel_llvm CLabel
    suffix
        let result :: String -> LMSection
    result String
    sep = forall a. a -> Maybe a
    Just ([LMString] -> LMString
    concatFS [Platform -> SectionType -> LMString
    llvmSectionType Platform
    platform SectionType
    t
                                        , String -> LMString
    fsLit String
    sep, LMString
    lmsuffix])
        case Platform -> OS
    platformOS Platform
    platform of
          OS
    OSMinGW32 -> forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> LMSection
    result String
    "$")
          OS
    _         -> forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> LMSection
    result String
    ".")

    -- ----------------------------------------------------------------------------
    -- * Generate static data
    --

    -- | Handle static data
    genData :: CmmStatic -> LlvmM LlvmStatic

    genData :: CmmStatic -> LlvmM LlvmStatic
    genData (CmmFileEmbed {}) = forall a. String -> a
    panic String
    "Unexpected CmmFileEmbed literal"
    genData (CmmString ByteString
    str) = do
        let v :: [LlvmStatic]
    v  = forall a b. (a -> b) -> [a] -> [b]
    map (\Word8
    x -> LlvmLit -> LlvmStatic
    LMStaticLit forall a b. (a -> b) -> a -> b
    $ Integer -> LlvmType -> LlvmLit
    LMIntLit (forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    x) LlvmType
    i8)
                     (ByteString -> [Word8]
    BS.unpack ByteString
    str)
            ve :: [LlvmStatic]
    ve = [LlvmStatic]
    v forall a. [a] -> [a] -> [a]
    ++ [LlvmLit -> LlvmStatic
    LMStaticLit forall a b. (a -> b) -> a -> b
    $ Integer -> LlvmType -> LlvmLit
    LMIntLit Integer
    0 LlvmType
    i8]
        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ [LlvmStatic] -> LlvmType -> LlvmStatic
    LMStaticArray [LlvmStatic]
    ve (Int -> LlvmType -> LlvmType
    LMArray (forall (t :: * -> *) a. Foldable t => t a -> Int
    length [LlvmStatic]
    ve) LlvmType
    i8)

    genData (CmmUninitialised Int
    bytes)
        = forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ LlvmType -> LlvmStatic
    LMUninitType (Int -> LlvmType -> LlvmType
    LMArray Int
    bytes LlvmType
    i8)

    genData (CmmStaticLit CmmLit
    lit)
        = CmmLit -> LlvmM LlvmStatic
    genStaticLit CmmLit
    lit

    -- | Generate Llvm code for a static literal.
    --
    -- Will either generate the code or leave it unresolved if it is a 'CLabel'
    -- which isn't yet known.
    genStaticLit :: CmmLit -> LlvmM LlvmStatic
    genStaticLit :: CmmLit -> LlvmM LlvmStatic
    genStaticLit (CmmInt Integer
    i Width
    w)
        = forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ LlvmLit -> LlvmStatic
    LMStaticLit (Integer -> LlvmType -> LlvmLit
    LMIntLit Integer
    i (Int -> LlvmType
    LMInt forall a b. (a -> b) -> a -> b
    $ Width -> Int
    widthInBits Width
    w))

    genStaticLit (CmmFloat Rational
    r Width
    w)
        = forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ LlvmLit -> LlvmStatic
    LMStaticLit (Double -> LlvmType -> LlvmLit
    LMFloatLit (forall a. Fractional a => Rational -> a
    fromRational Rational
    r) (Width -> LlvmType
    widthToLlvmFloat Width
    w))

    genStaticLit (CmmVec [CmmLit]
    ls)
        = do [LlvmLit]
    sls <- forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM CmmLit -> LlvmM LlvmLit
    toLlvmLit [CmmLit]
    ls
             forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ LlvmLit -> LlvmStatic
    LMStaticLit ([LlvmLit] -> LlvmLit
    LMVectorLit [LlvmLit]
    sls)
      where
        toLlvmLit :: CmmLit -> LlvmM LlvmLit
        toLlvmLit :: CmmLit -> LlvmM LlvmLit
    toLlvmLit CmmLit
    lit = do
          LlvmStatic
    slit <- CmmLit -> LlvmM LlvmStatic
    genStaticLit CmmLit
    lit
          case LlvmStatic
    slit of
            LMStaticLit LlvmLit
    llvmLit -> forall (m :: * -> *) a. Monad m => a -> m a
    return LlvmLit
    llvmLit
            LlvmStatic
    _ -> forall a. String -> a
    panic String
    "genStaticLit"

    -- Leave unresolved, will fix later
    genStaticLit cmm :: CmmLit
    cmm@(CmmLabel CLabel
    l) = do
        LlvmVar
    var <- LMString -> LlvmM LlvmVar
    getGlobalPtr forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< CLabel -> LlvmM LMString
    strCLabel_llvm CLabel
    l
        Platform
    platform <- LlvmM Platform
    getPlatform
        let ptr :: LlvmStatic
    ptr = LlvmVar -> LlvmStatic
    LMStaticPointer LlvmVar
    var
            lmty :: LlvmType
    lmty = CmmType -> LlvmType
    cmmToLlvmType forall a b. (a -> b) -> a -> b
    $ Platform -> CmmLit -> CmmType
    cmmLitType Platform
    platform CmmLit
    cmm
        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ LlvmStatic -> LlvmType -> LlvmStatic
    LMPtoI LlvmStatic
    ptr LlvmType
    lmty

    genStaticLit (CmmLabelOff CLabel
    label Int
    off) = do
        Platform
    platform <- LlvmM Platform
    getPlatform
        LlvmStatic
    var <- CmmLit -> LlvmM LlvmStatic
    genStaticLit (CLabel -> CmmLit
    CmmLabel CLabel
    label)
        let offset :: LlvmStatic
    offset = LlvmLit -> LlvmStatic
    LMStaticLit forall a b. (a -> b) -> a -> b
    $ Integer -> LlvmType -> LlvmLit
    LMIntLit (forall a. Integral a => a -> Integer
    toInteger Int
    off) (Platform -> LlvmType
    llvmWord Platform
    platform)
        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ LlvmStatic -> LlvmStatic -> LlvmStatic
    LMAdd LlvmStatic
    var LlvmStatic
    offset

    genStaticLit (CmmLabelDiffOff CLabel
    l1 CLabel
    l2 Int
    off Width
    w) = do
        Platform
    platform <- LlvmM Platform
    getPlatform
        LlvmStatic
    var1 <- CmmLit -> LlvmM LlvmStatic
    genStaticLit (CLabel -> CmmLit
    CmmLabel CLabel
    l1)
        LlvmStatic
    var2 <- CmmLit -> LlvmM LlvmStatic
    genStaticLit (CLabel -> CmmLit
    CmmLabel CLabel
    l2)
        let var :: LlvmStatic
    var
              | Width
    w forall a. Eq a => a -> a -> Bool
    == Platform -> Width
    wordWidth Platform
    platform = LlvmStatic -> LlvmStatic -> LlvmStatic
    LMSub LlvmStatic
    var1 LlvmStatic
    var2
              | Bool
    otherwise = LlvmStatic -> LlvmType -> LlvmStatic
    LMTrunc (LlvmStatic -> LlvmStatic -> LlvmStatic
    LMSub LlvmStatic
    var1 LlvmStatic
    var2) (Width -> LlvmType
    widthToLlvmInt Width
    w)
            offset :: LlvmStatic
    offset = LlvmLit -> LlvmStatic
    LMStaticLit forall a b. (a -> b) -> a -> b
    $ Integer -> LlvmType -> LlvmLit
    LMIntLit (forall a. Integral a => a -> Integer
    toInteger Int
    off) (Int -> LlvmType
    LMInt forall a b. (a -> b) -> a -> b
    $ Width -> Int
    widthInBits Width
    w)
        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ LlvmStatic -> LlvmStatic -> LlvmStatic
    LMAdd LlvmStatic
    var LlvmStatic
    offset

    genStaticLit (CmmBlock BlockId
    b) = CmmLit -> LlvmM LlvmStatic
    genStaticLit forall a b. (a -> b) -> a -> b
    $ CLabel -> CmmLit
    CmmLabel forall a b. (a -> b) -> a -> b
    $ BlockId -> CLabel
    infoTblLbl BlockId
    b

    genStaticLit (CmmLit
    CmmHighStackMark)
        = forall a. String -> a
    panic String
    "genStaticLit: CmmHighStackMark unsupported!"