Implement function-sections for Haskell code, #8405
[ghc.git] / compiler / llvmGen / LlvmCodeGen / Data.hs
index 3e486a5..3c1af4f 100644 (file)
@@ -1,9 +1,10 @@
+{-# LANGUAGE CPP #-}
 -- ----------------------------------------------------------------------------
 -- | Handle conversion of CmmData to LLVM code.
 --
 
 module LlvmCodeGen.Data (
-        genLlvmData, resolveLlvmDatas, resolveLlvmData
+        genLlvmData, genData
     ) where
 
 #include "HsVersions.h"
@@ -13,13 +14,11 @@ import LlvmCodeGen.Base
 
 import BlockId
 import CLabel
-import OldCmm
+import Cmm
+import DynFlags
 
 import FastString
-import qualified Outputable
-
-import Data.Maybe
-
+import Outputable
 
 -- ----------------------------------------------------------------------------
 -- * Constants
@@ -33,171 +32,122 @@ structStr = fsLit "_struct"
 -- * Top level
 --
 
--- | Pass a CmmStatic section to an equivalent Llvm code. Can't
--- complete this completely though as we need to pass all CmmStatic
--- sections before all references can be resolved. This last step is
--- done by 'resolveLlvmData'.
-genLlvmData :: (Section, [CmmStatic]) -> LlvmUnresData
-genLlvmData (sec, CmmDataLabel lbl:xs) =
-    let static  = map genData xs
-        label   = strCLabel_llvm lbl
-
-        types   = map getStatTypes static
-        getStatTypes (Left  x) = cmmToLlvmType $ cmmLitType x
-        getStatTypes (Right x) = getStatType x
+-- | Pass a CmmStatic section to an equivalent Llvm code.
+genLlvmData :: (Section, CmmStatics) -> LlvmM LlvmData
+genLlvmData (sec, Statics lbl xs) = do
+    label <- strCLabel_llvm lbl
+    static <- mapM genData xs
+    lmsec <- llvmSection sec
+    let types   = map getStatType static
 
         strucTy = LMStruct types
-        alias   = LMAlias ((label `appendFS` structStr), strucTy)
-    in (lbl, sec, alias, static)
-
-genLlvmData _ = panic "genLlvmData: CmmData section doesn't start with label!"
-
-
-resolveLlvmDatas ::  LlvmEnv -> [LlvmUnresData] -> [LlvmData]
-                 -> (LlvmEnv, [LlvmData])
-resolveLlvmDatas env [] ldata
-  = (env, ldata)
-
-resolveLlvmDatas env (udata : rest) ldata
-  = let (env', ndata) = resolveLlvmData env udata
-    in resolveLlvmDatas env' rest (ldata ++ [ndata])
+        tyAlias = LMAlias ((label `appendFS` structStr), strucTy)
 
--- | Fix up CLabel references now that we should have passed all CmmData.
-resolveLlvmData :: LlvmEnv -> LlvmUnresData -> (LlvmEnv, LlvmData)
-resolveLlvmData env (lbl, sec, alias, unres) =
-    let (env', static, refs) = resDatas env unres ([], [])
-        refs'          = catMaybes refs
-        struct         = Just $ LMStaticStruc static alias
-        label          = strCLabel_llvm lbl
+        struct         = Just $ LMStaticStruc static tyAlias
         link           = if (externallyVisibleCLabel lbl)
                             then ExternallyVisible else Internal
-        const          = isSecConstant sec
-        glob           = LMGlobalVar label alias link Nothing Nothing const
-    in (env', (refs' ++ [(glob, struct)], [alias]))
+        const          = if isSecConstant sec then Constant else Global
+        varDef         = LMGlobalVar label tyAlias link lmsec Nothing const
+        globDef        = LMGlobal varDef struct
 
+    return ([globDef], [tyAlias])
 
 -- | Should a data in this section be considered constant
 isSecConstant :: Section -> Bool
-isSecConstant Text                    = True
-isSecConstant Data                    = False
-isSecConstant ReadOnlyData            = True
-isSecConstant RelocatableReadOnlyData = True
-isSecConstant UninitialisedData       = False
-isSecConstant ReadOnlyData16          = True
-isSecConstant (OtherSection _)        = False
-
-
--- ----------------------------------------------------------------------------
--- ** Resolve Data/CLabel references
---
-
--- | Resolve data list
-resDatas :: LlvmEnv -> [UnresStatic] -> ([LlvmStatic], [Maybe LMGlobal])
-         -> (LlvmEnv, [LlvmStatic], [Maybe LMGlobal])
-
-resDatas env [] (stat, glob)
-  = (env, stat, glob)
-
-resDatas env (cmm : rest) (stats, globs)
-  = let (env', nstat, nglob) = resData env cmm
-    in resDatas env' rest (stats ++ [nstat], globs ++ nglob)
-
--- | Resolve an individual static label if it needs to be.
---
--- We check the 'LlvmEnv' to see if the reference has been defined in this
--- module. If it has we can retrieve its type and make a pointer, otherwise
--- we introduce a generic external definition for the referenced label and
--- then make a pointer.
-resData :: LlvmEnv -> UnresStatic -> (LlvmEnv, LlvmStatic, [Maybe LMGlobal])
-
-resData env (Right stat) = (env, stat, [Nothing])
-
-resData env (Left cmm@(CmmLabel l)) =
-    let label = strCLabel_llvm l
-        ty = funLookup label env
-        lmty = cmmToLlvmType $ cmmLitType cmm
-    in case ty of
-            -- Make generic external label defenition and then pointer to it
-            Nothing ->
-                let glob@(var, _) = genStringLabelRef label
-                    env' =  funInsert label (pLower $ getVarType var) env
-                    ptr  = LMStaticPointer var
-                in  (env', LMPtoI ptr lmty, [Just glob])
-            -- Referenced data exists in this module, retrieve type and make
-            -- pointer to it.
-            Just ty' ->
-                let var = LMGlobalVar label (LMPointer ty')
-                            ExternallyVisible Nothing Nothing False
-                    ptr  = LMStaticPointer var
-                in (env, LMPtoI ptr lmty, [Nothing])
-
-resData env (Left (CmmLabelOff label off)) =
-    let (env', var, glob) = resData env (Left (CmmLabel label))
-        offset = LMStaticLit $ LMIntLit (toInteger off) llvmWord
-    in (env', LMAdd var offset, glob)
-
-resData env (Left (CmmLabelDiffOff l1 l2 off)) =
-    let (env1, var1, glob1) = resData env (Left (CmmLabel l1))
-        (env2, var2, glob2) = resData env1 (Left (CmmLabel l2))
-        var = LMSub var1 var2
-        offset = LMStaticLit $ LMIntLit (toInteger off) llvmWord
-    in (env2, LMAdd var offset, glob1 ++ glob2)
-
-resData _ _ = panic "resData: Non CLabel expr as left type!"
+isSecConstant (Section t _) = case t of
+    Text                    -> True
+    ReadOnlyData            -> True
+    RelocatableReadOnlyData -> True
+    ReadOnlyData16          -> True
+    Data                    -> False
+    UninitialisedData       -> False
+    (OtherSection _)        -> False
+
+-- | Format the section type part of a Cmm Section
+llvmSectionType :: SectionType -> FastString
+llvmSectionType t = case t of
+    Text                    -> fsLit ".text"
+    ReadOnlyData            -> fsLit ".rodata"
+    RelocatableReadOnlyData -> fsLit ".data.rel.ro"
+    ReadOnlyData16          -> fsLit ".rodata.cst16"
+    Data                    -> fsLit ".data"
+    UninitialisedData       -> fsLit ".bss"
+    (OtherSection _)        -> panic "llvmSectionType: unknown section type"
+
+-- | Format a Cmm Section into a LLVM section name
+llvmSection :: Section -> LlvmM LMSection
+llvmSection (Section t suffix) = do
+  dflags <- getDynFlags
+  let splitSect = gopt Opt_SplitSections dflags
+  if not splitSect
+  then return Nothing
+  else do
+    lmsuffix <- strCLabel_llvm suffix
+    return (Just (concatFS [llvmSectionType t, fsLit ".", lmsuffix]))
 
 -- ----------------------------------------------------------------------------
 -- * Generate static data
 --
 
 -- | Handle static data
--- Don't handle 'CmmAlign' or a 'CmmDataLabel'.
-genData :: CmmStatic -> UnresStatic
+genData :: CmmStatic -> LlvmM LlvmStatic
 
-genData (CmmString str) =
+genData (CmmString str) = do
     let v  = map (\x -> LMStaticLit $ LMIntLit (fromIntegral x) i8) str
         ve = v ++ [LMStaticLit $ LMIntLit 0 i8]
-    in Right $ LMStaticArray ve (LMArray (length ve) i8)
+    return $ LMStaticArray ve (LMArray (length ve) i8)
 
 genData (CmmUninitialised bytes)
-    = Right $ LMUninitType (LMArray bytes i8)
+    = return $ LMUninitType (LMArray bytes i8)
 
 genData (CmmStaticLit lit)
     = genStaticLit lit
 
-genData (CmmAlign _)
-    = panic "genData: Can't handle CmmAlign!"
-
-genData (CmmDataLabel _)
-    = panic "genData: Can't handle data labels not at top of data!"
-
-
 -- | 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 -> UnresStatic
+genStaticLit :: CmmLit -> LlvmM LlvmStatic
 genStaticLit (CmmInt i w)
-    = Right $ LMStaticLit (LMIntLit i (LMInt $ widthInBits w))
+    = return $ LMStaticLit (LMIntLit i (LMInt $ widthInBits w))
 
 genStaticLit (CmmFloat r w)
-    = Right $ LMStaticLit (LMFloatLit (fromRational r) (widthToLlvmFloat w))
+    = return $ LMStaticLit (LMFloatLit (fromRational r) (widthToLlvmFloat w))
+
+genStaticLit (CmmVec ls)
+    = do sls <- mapM toLlvmLit ls
+         return $ LMStaticLit (LMVectorLit sls)
+  where
+    toLlvmLit :: CmmLit -> LlvmM LlvmLit
+    toLlvmLit lit = do
+      slit <- genStaticLit lit
+      case slit of
+        LMStaticLit llvmLit -> return llvmLit
+        _ -> panic "genStaticLit"
 
 -- Leave unresolved, will fix later
-genStaticLit c@(CmmLabel        _    ) = Left $ c
-genStaticLit c@(CmmLabelOff     _   _) = Left $ c
-genStaticLit c@(CmmLabelDiffOff _ _ _) = Left $ c
-
-genStaticLit (CmmBlock b) = Left $ CmmLabel $ infoTblLbl b
+genStaticLit cmm@(CmmLabel l) = do
+    var <- getGlobalPtr =<< strCLabel_llvm l
+    dflags <- getDynFlags
+    let ptr = LMStaticPointer var
+        lmty = cmmToLlvmType $ cmmLitType dflags cmm
+    return $ LMPtoI ptr lmty
+
+genStaticLit (CmmLabelOff label off) = do
+    dflags <- getDynFlags
+    var <- genStaticLit (CmmLabel label)
+    let offset = LMStaticLit $ LMIntLit (toInteger off) (llvmWord dflags)
+    return $ LMAdd var offset
+
+genStaticLit (CmmLabelDiffOff l1 l2 off) = do
+    dflags <- getDynFlags
+    var1 <- genStaticLit (CmmLabel l1)
+    var2 <- genStaticLit (CmmLabel l2)
+    let var = LMSub var1 var2
+        offset = LMStaticLit $ LMIntLit (toInteger off) (llvmWord dflags)
+    return $ LMAdd var offset
+
+genStaticLit (CmmBlock b) = genStaticLit $ CmmLabel $ infoTblLbl b
 
 genStaticLit (CmmHighStackMark)
     = panic "genStaticLit: CmmHighStackMark unsupported!"
-
-
--- -----------------------------------------------------------------------------
--- * Misc
---
-
--- | Error Function
-panic :: String -> a
-panic s = Outputable.panic $ "LlvmCodeGen.Data." ++ s
-