{-# LANGUAGE CPP #-}
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
structStr :: LMString
structStr :: LMString
structStr = String -> LMString
fsLit String
"_struct"
linkage :: CLabel -> LlvmLinkageType
linkage :: CLabel -> LlvmLinkageType
linkage CLabel
lbl = if CLabel -> Bool
externallyVisibleCLabel CLabel
lbl
then LlvmLinkageType
ExternallyVisible else LlvmLinkageType
Internal
genLlvmData :: (Section, RawCmmStatics) -> LlvmM LlvmData
genLlvmData :: (Section, RawCmmStatics) -> LlvmM LlvmData
genLlvmData (Section
_, CmmStaticsRaw 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'
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
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, CmmStaticsRaw 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
getPlatform
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 -> SectionProtection
sectionProtection Section
sec SectionProtection -> SectionProtection -> Bool
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
LlvmData -> LlvmM LlvmData
forall (m :: * -> *) a. Monad m => a -> m a
return ([LMGlobal
globDef], [LlvmType
tyAlias])
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"
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 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
".")
genData :: CmmStatic -> LlvmM LlvmStatic
genData :: CmmStatic -> LlvmM LlvmStatic
genData (CmmFileEmbed {}) = String -> LlvmM LlvmStatic
forall a. String -> a
panic String
"Unexpected CmmFileEmbed literal"
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
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"
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
Platform
platform <- LlvmM Platform
getPlatform
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
$ Platform -> CmmLit -> CmmType
cmmLitType Platform
platform 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
Platform
platform <- LlvmM Platform
getPlatform
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) (Platform -> LlvmType
llvmWord Platform
platform)
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
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 Width -> Width -> Bool
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 (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!"