summaryrefslogtreecommitdiff
path: root/compiler/llvmGen/LlvmCodeGen/Data.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/llvmGen/LlvmCodeGen/Data.hs')
-rw-r--r--compiler/llvmGen/LlvmCodeGen/Data.hs155
1 files changed, 46 insertions, 109 deletions
diff --git a/compiler/llvmGen/LlvmCodeGen/Data.hs b/compiler/llvmGen/LlvmCodeGen/Data.hs
index 83b5453aa9..6212cfc9fb 100644
--- a/compiler/llvmGen/LlvmCodeGen/Data.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Data.hs
@@ -3,7 +3,7 @@
--
module LlvmCodeGen.Data (
- genLlvmData, resolveLlvmDatas, resolveLlvmData
+ genLlvmData
) where
#include "HsVersions.h"
@@ -18,8 +18,6 @@ import Cmm
import FastString
import qualified Outputable
-import Data.List (foldl')
-
-- ----------------------------------------------------------------------------
-- * Constants
--
@@ -32,43 +30,23 @@ 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 :: LlvmEnv -> (Section, CmmStatics) -> LlvmUnresData
-genLlvmData env (sec, Statics lbl xs) =
- let dflags = getDflags env
- static = map genData xs
- label = strCLabel_llvm env lbl
-
- types = map getStatTypes static
- getStatTypes (Left x) = cmmToLlvmType $ cmmLitType dflags 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
+ let types = map getStatType static
strucTy = LMStruct types
alias = LMAlias ((label `appendFS` structStr), strucTy)
- in (lbl, sec, alias, static)
-
-resolveLlvmDatas :: LlvmEnv -> [LlvmUnresData] -> (LlvmEnv, [LlvmData])
-resolveLlvmDatas env ldata
- = foldl' res (env, []) ldata
- where res (e, xs) ll =
- let (e', nd) = resolveLlvmData e ll
- in (e', nd:xs)
-
--- | 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 ([], [])
struct = Just $ LMStaticStruc static alias
- label = strCLabel_llvm env lbl
link = if (externallyVisibleCLabel lbl)
then ExternallyVisible else Internal
- const = isSecConstant sec
+ const = if isSecConstant sec then Constant else Global
glob = LMGlobalVar label alias link Nothing Nothing const
- in (env', ((glob,struct):refs, [alias]))
+
+ return ([LMGlobal glob struct], [alias])
-- | Should a data in this section be considered constant
isSecConstant :: Section -> Bool
@@ -82,80 +60,19 @@ isSecConstant (OtherSection _) = False
-- ----------------------------------------------------------------------------
--- ** Resolve Data/CLabel references
---
-
--- | Resolve data list
-resDatas :: LlvmEnv -> [UnresStatic] -> ([LlvmStatic], [LMGlobal])
- -> (LlvmEnv, [LlvmStatic], [LMGlobal])
-
-resDatas env [] (stats, glob)
- = (env, stats, 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, [LMGlobal])
-
-resData env (Right stat) = (env, stat, [])
-
-resData env (Left cmm@(CmmLabel l)) =
- let dflags = getDflags env
- label = strCLabel_llvm env l
- ty = funLookup label env
- lmty = cmmToLlvmType $ cmmLitType dflags cmm
- in case ty of
- -- Make generic external label defenition and then pointer to it
- Nothing ->
- let glob@(var, _) = genStringLabelRef dflags label
- env' = funInsert label (pLower $ getVarType var) env
- ptr = LMStaticPointer var
- in (env', LMPtoI ptr lmty, [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, [])
-
-resData env (Left (CmmLabelOff label off)) =
- let dflags = getDflags env
- (env', var, glob) = resData env (Left (CmmLabel label))
- offset = LMStaticLit $ LMIntLit (toInteger off) (llvmWord dflags)
- in (env', LMAdd var offset, glob)
-
-resData env (Left (CmmLabelDiffOff l1 l2 off)) =
- let dflags = getDflags env
- (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 dflags)
- in (env2, LMAdd var offset, glob1 ++ glob2)
-
-resData _ _ = panic "resData: Non CLabel expr as left type!"
-
--- ----------------------------------------------------------------------------
-- * Generate static data
--
-- | Handle static data
-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
@@ -164,27 +81,47 @@ genData (CmmStaticLit lit)
--
-- 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)
- = Right $ LMStaticLit (LMVectorLit (map toLlvmLit ls))
+ = do sls <- mapM toLlvmLit ls
+ return $ LMStaticLit (LMVectorLit sls)
where
- toLlvmLit :: CmmLit -> LlvmLit
- toLlvmLit lit = case genStaticLit lit of
- Right (LMStaticLit llvmLit) -> llvmLit
- _ -> panic "genStaticLit"
+ 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 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) = Left $ CmmLabel $ infoTblLbl b
+genStaticLit (CmmBlock b) = genStaticLit $ CmmLabel $ infoTblLbl b
genStaticLit (CmmHighStackMark)
= panic "genStaticLit: CmmHighStackMark unsupported!"
View Lorry Controller Status