{-# 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 Platform

import FastString
import Outputable

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

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

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

-- | Pass a CmmStatic section to an equivalent Llvm code.
genLlvmData :: (Section, CmmStatics) -> LlvmM LlvmData
genLlvmData :: (Section, CmmStatics) -> LlvmM LlvmData
genLlvmData (sec :: Section
sec, Statics lbl :: CLabel
lbl xs :: [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
    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           = if (CLabel -> Bool
externallyVisibleCLabel CLabel
lbl)
                            then LlvmLinkageType
ExternallyVisible else LlvmLinkageType
Internal
        align :: Maybe Int
align          = case Section
sec of
                            Section CString _ -> Int -> Maybe Int
forall a. a -> Maybe a
Just 1
                            _                 -> Maybe Int
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
-> Maybe Int
-> LMConst
-> LlvmVar
LMGlobalVar LMString
label LlvmType
tyAlias LlvmLinkageType
link LMSection
lmsec Maybe Int
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 p :: Platform
p t :: SectionType
t = case SectionType
t of
    Text                    -> String -> LMString
fsLit ".text"
    ReadOnlyData            -> case Platform -> OS
platformOS Platform
p of
                                 OSMinGW32 -> String -> LMString
fsLit ".rdata"
                                 _         -> String -> LMString
fsLit ".rodata"
    RelocatableReadOnlyData -> case Platform -> OS
platformOS Platform
p of
                                 OSMinGW32 -> String -> LMString
fsLit ".rdata$rel.ro"
                                 _         -> String -> LMString
fsLit ".data.rel.ro"
    ReadOnlyData16          -> case Platform -> OS
platformOS Platform
p of
                                 OSMinGW32 -> String -> LMString
fsLit ".rdata$cst16"
                                 _         -> String -> LMString
fsLit ".rodata.cst16"
    Data                    -> String -> LMString
fsLit ".data"
    UninitialisedData       -> String -> LMString
fsLit ".bss"
    CString                 -> case Platform -> OS
platformOS Platform
p of
                                 OSMinGW32 -> String -> LMString
fsLit ".rdata$str"
                                 _         -> String -> LMString
fsLit ".rodata.str"
    (OtherSection _)        -> String -> LMString
forall a. String -> a
panic "llvmSectionType: unknown section type"

-- | Format a Cmm Section into a LLVM section name
llvmSection :: Section -> LlvmM LMSection
llvmSection :: Section -> LlvmM LMSection
llvmSection (Section t :: SectionType
t suffix :: 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 sep :: 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
      OSMinGW32 -> LMSection -> LlvmM LMSection
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> LMSection
result "$")
      _         -> LMSection -> LlvmM LMSection
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> LMSection
result ".")

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

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

genData :: CmmStatic -> LlvmM LlvmStatic
genData (CmmString str :: [Word8]
str) = do
    let v :: [LlvmStatic]
v  = (Word8 -> LlvmStatic) -> [Word8] -> [LlvmStatic]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: 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) [Word8]
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 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 bytes :: 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 lit :: 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 i :: Integer
i w :: 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 r :: Rational
r w :: 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 ls :: [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 lit :: CmmLit
lit = do
      LlvmStatic
slit <- CmmLit -> LlvmM LlvmStatic
genStaticLit CmmLit
lit
      case LlvmStatic
slit of
        LMStaticLit llvmLit :: LlvmLit
llvmLit -> LlvmLit -> LlvmM LlvmLit
forall (m :: * -> *) a. Monad m => a -> m a
return LlvmLit
llvmLit
        _ -> String -> LlvmM LlvmLit
forall a. String -> a
panic "genStaticLit"

-- Leave unresolved, will fix later
genStaticLit cmm :: CmmLit
cmm@(CmmLabel l :: 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 label :: CLabel
label off :: 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 l1 :: CLabel
l1 l2 :: CLabel
l2 off :: Int
off w :: 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 b :: 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 "genStaticLit: CmmHighStackMark unsupported!"