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

module LlvmCodeGen.Data (
        genLlvmData, genData
    ) where

#include "HsVersions.h"

import GhcPrelude

import Llvm
import LlvmCodeGen.Base

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

import FastString
import Outputable
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, CmmStatics) -> LlvmM LlvmData
-- See note [emit-time elimination of static indirections] in CLabel.
genLlvmData :: (Section, CmmStatics) -> LlvmM LlvmData
genLlvmData (Section
_, Statics CLabel
alias [CmmStaticLit (CmmLabel CLabel
lbl), CmmStaticLit CmmLit
ind, CmmStatic
_, CmmStatic
_])
  | CLabel
lbl CLabel -> CLabel -> Bool
forall a. Eq a => a -> a -> Bool
== CLabel
mkIndStaticInfoLabel
  , let labelInd :: CmmLit -> Maybe CLabel
labelInd (CmmLabelOff CLabel
l Int
_) = CLabel -> Maybe CLabel
forall a. a -> Maybe a
Just CLabel
l
        labelInd (CmmLabel CLabel
l) = CLabel -> Maybe CLabel
forall a. a -> Maybe a
Just CLabel
l
        labelInd CmmLit
_ = Maybe CLabel
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 LMSection
forall a. Maybe a
Nothing LMAlign
forall a. Maybe a
Nothing LMConst
Alias
        -- we don't know the type of the indirectee here
        indType :: a
indType  = String -> a
forall a. String -> a
panic String
"will be filled by 'aliasify', later"
        orig :: LlvmStatic
orig     = LlvmVar -> LlvmStatic
LMStaticPointer (LlvmVar -> LlvmStatic) -> LlvmVar -> LlvmStatic
forall a b. (a -> b) -> a -> b
$ LMString
-> LlvmType
-> LlvmLinkageType
-> LMSection
-> LMAlign
-> LMConst
-> LlvmVar
LMGlobalVar LMString
label' LlvmType
forall a. a
indType LlvmLinkageType
link' LMSection
forall a. Maybe a
Nothing LMAlign
forall a. Maybe a
Nothing LMConst
Alias

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

genLlvmData (Section
sec, Statics CLabel
lbl [CmmStatic]
xs) = do
    LMString
label <- CLabel -> LlvmM LMString
strCLabel_llvm CLabel
lbl
    [LlvmStatic]
static <- (CmmStatic -> LlvmM LlvmStatic)
-> [CmmStatic] -> LlvmM [LlvmStatic]
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
getLlvmPlatform
    let types :: [LlvmType]
types   = (LlvmStatic -> LlvmType) -> [LlvmStatic] -> [LlvmType]
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         = LlvmStatic -> Maybe LlvmStatic
forall a. a -> Maybe a
Just (LlvmStatic -> Maybe LlvmStatic) -> LlvmStatic -> Maybe LlvmStatic
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 Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== Arch
ArchS390X)
                                                    then Int -> LMAlign
forall a. a -> Maybe a
Just Int
2 else Int -> LMAlign
forall a. a -> Maybe a
Just Int
1
                            Section
_                 -> LMAlign
forall a. Maybe a
Nothing
        const :: LMConst
const          = if Section -> Bool
isSecConstant Section
sec 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

    LlvmData -> LlvmM LlvmData
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
_)        -> String -> LMString
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
  DynFlags
dflags <- LlvmM DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
  let splitSect :: Bool
splitSect = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SplitSections DynFlags
dflags
      platform :: Platform
platform  = DynFlags -> Platform
targetPlatform DynFlags
dflags
  if Bool -> Bool
not Bool
splitSect
  then LMSection -> LlvmM LMSection
forall (m :: * -> *) a. Monad m => a -> m a
return LMSection
forall a. Maybe a
Nothing
  else do
    LMString
lmsuffix <- CLabel -> LlvmM LMString
strCLabel_llvm CLabel
suffix
    let result :: String -> LMSection
result String
sep = LMString -> LMSection
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 -> LMSection -> LlvmM LMSection
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> LMSection
result String
"$")
      OS
_         -> LMSection -> LlvmM LMSection
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 (CmmString ByteString
str) = do
    let v :: [LlvmStatic]
v  = (Word8 -> LlvmStatic) -> [Word8] -> [LlvmStatic]
forall a b. (a -> b) -> [a] -> [b]
map (\Word8
x -> LlvmLit -> LlvmStatic
LMStaticLit (LlvmLit -> LlvmStatic) -> LlvmLit -> LlvmStatic
forall a b. (a -> b) -> a -> b
$ Integer -> LlvmType -> LlvmLit
LMIntLit (Word8 -> Integer
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 [LlvmStatic] -> [LlvmStatic] -> [LlvmStatic]
forall a. [a] -> [a] -> [a]
++ [LlvmLit -> LlvmStatic
LMStaticLit (LlvmLit -> LlvmStatic) -> LlvmLit -> LlvmStatic
forall a b. (a -> b) -> a -> b
$ Integer -> LlvmType -> LlvmLit
LMIntLit Integer
0 LlvmType
i8]
    LlvmStatic -> LlvmM LlvmStatic
forall (m :: * -> *) a. Monad m => a -> m a
return (LlvmStatic -> LlvmM LlvmStatic) -> LlvmStatic -> LlvmM LlvmStatic
forall a b. (a -> b) -> a -> b
$ [LlvmStatic] -> LlvmType -> LlvmStatic
LMStaticArray [LlvmStatic]
ve (Int -> LlvmType -> LlvmType
LMArray ([LlvmStatic] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LlvmStatic]
ve) LlvmType
i8)

genData (CmmUninitialised Int
bytes)
    = LlvmStatic -> LlvmM LlvmStatic
forall (m :: * -> *) a. Monad m => a -> m a
return (LlvmStatic -> LlvmM LlvmStatic) -> LlvmStatic -> LlvmM LlvmStatic
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)
    = LlvmStatic -> LlvmM LlvmStatic
forall (m :: * -> *) a. Monad m => a -> m a
return (LlvmStatic -> LlvmM LlvmStatic) -> LlvmStatic -> LlvmM LlvmStatic
forall a b. (a -> b) -> a -> b
$ LlvmLit -> LlvmStatic
LMStaticLit (Integer -> LlvmType -> LlvmLit
LMIntLit Integer
i (Int -> LlvmType
LMInt (Int -> LlvmType) -> Int -> LlvmType
forall a b. (a -> b) -> a -> b
$ Width -> Int
widthInBits Width
w))

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

genStaticLit (CmmVec [CmmLit]
ls)
    = do [LlvmLit]
sls <- (CmmLit -> LlvmM LlvmLit) -> [CmmLit] -> LlvmM [LlvmLit]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CmmLit -> LlvmM LlvmLit
toLlvmLit [CmmLit]
ls
         LlvmStatic -> LlvmM LlvmStatic
forall (m :: * -> *) a. Monad m => a -> m a
return (LlvmStatic -> LlvmM LlvmStatic) -> LlvmStatic -> LlvmM LlvmStatic
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 -> LlvmLit -> LlvmM LlvmLit
forall (m :: * -> *) a. Monad m => a -> m a
return LlvmLit
llvmLit
        LlvmStatic
_ -> String -> LlvmM LlvmLit
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 (LMString -> LlvmM LlvmVar) -> LlvmM LMString -> LlvmM LlvmVar
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CLabel -> LlvmM LMString
strCLabel_llvm CLabel
l
    DynFlags
dflags <- LlvmM DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    let ptr :: LlvmStatic
ptr = LlvmVar -> LlvmStatic
LMStaticPointer LlvmVar
var
        lmty :: LlvmType
lmty = CmmType -> LlvmType
cmmToLlvmType (CmmType -> LlvmType) -> CmmType -> LlvmType
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmLit -> CmmType
cmmLitType DynFlags
dflags CmmLit
cmm
    LlvmStatic -> LlvmM LlvmStatic
forall (m :: * -> *) a. Monad m => a -> m a
return (LlvmStatic -> LlvmM LlvmStatic) -> LlvmStatic -> LlvmM LlvmStatic
forall a b. (a -> b) -> a -> b
$ LlvmStatic -> LlvmType -> LlvmStatic
LMPtoI LlvmStatic
ptr LlvmType
lmty

genStaticLit (CmmLabelOff CLabel
label Int
off) = do
    DynFlags
dflags <- LlvmM DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    LlvmStatic
var <- CmmLit -> LlvmM LlvmStatic
genStaticLit (CLabel -> CmmLit
CmmLabel CLabel
label)
    let offset :: LlvmStatic
offset = LlvmLit -> LlvmStatic
LMStaticLit (LlvmLit -> LlvmStatic) -> LlvmLit -> LlvmStatic
forall a b. (a -> b) -> a -> b
$ Integer -> LlvmType -> LlvmLit
LMIntLit (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
off) (DynFlags -> LlvmType
llvmWord DynFlags
dflags)
    LlvmStatic -> LlvmM LlvmStatic
forall (m :: * -> *) a. Monad m => a -> m a
return (LlvmStatic -> LlvmM LlvmStatic) -> LlvmStatic -> LlvmM LlvmStatic
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
    DynFlags
dflags <- LlvmM DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    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 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== DynFlags -> Width
wordWidth DynFlags
dflags = 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 (LlvmLit -> LlvmStatic) -> LlvmLit -> LlvmStatic
forall a b. (a -> b) -> a -> b
$ Integer -> LlvmType -> LlvmLit
LMIntLit (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
off) (Int -> LlvmType
LMInt (Int -> LlvmType) -> Int -> LlvmType
forall a b. (a -> b) -> a -> b
$ Width -> Int
widthInBits Width
w)
    LlvmStatic -> LlvmM LlvmStatic
forall (m :: * -> *) a. Monad m => a -> m a
return (LlvmStatic -> LlvmM LlvmStatic) -> LlvmStatic -> LlvmM LlvmStatic
forall a b. (a -> b) -> a -> b
$ LlvmStatic -> LlvmStatic -> LlvmStatic
LMAdd LlvmStatic
var LlvmStatic
offset

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

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