X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FllvmGen%2FLlvmCodeGen%2FData.hs;h=3e486a544f33e9d087bcd46d10a6abd208a1300a;hp=69cd0e7c2b613d24525d1c7107213ed6f3f51fcd;hb=c5b178be60a5a44abd2f4ddf8c399857678326e2;hpb=24a3fee9f3ff6cef6fe471ab6f0a7ba9ac001faf

diff --git a/compiler/llvmGen/LlvmCodeGen/Data.hs b/compiler/llvmGen/LlvmCodeGen/Data.hs
index 69cd0e7..3e486a5 100644
--- a/compiler/llvmGen/LlvmCodeGen/Data.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Data.hs
@@ -13,9 +13,8 @@ import LlvmCodeGen.Base
 
 import BlockId
 import CLabel
-import Cmm
+import OldCmm
 
-import DynFlags
 import FastString
 import qualified Outputable
 
@@ -38,8 +37,8 @@ structStr = fsLit "_struct"
 -- 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 :: DynFlags -> (Section, [CmmStatic]) -> LlvmUnresData
-genLlvmData _ ( _ , (CmmDataLabel lbl):xs) =
+genLlvmData :: (Section, [CmmStatic]) -> LlvmUnresData
+genLlvmData (sec, CmmDataLabel lbl:xs) =
     let static  = map genData xs
         label   = strCLabel_llvm lbl
 
@@ -48,33 +47,46 @@ genLlvmData _ ( _ , (CmmDataLabel lbl):xs) =
         getStatTypes (Right x) = getStatType x
 
         strucTy = LMStruct types
-        alias   = LMAlias (label `appendFS` structStr) strucTy
-    in (lbl, alias, static)
+        alias   = LMAlias ((label `appendFS` structStr), strucTy)
+    in (lbl, sec, alias, static)
 
-genLlvmData _ _ = panic "genLlvmData: CmmData section doesn't start with label!"
+genLlvmData _ = panic "genLlvmData: CmmData section doesn't start with label!"
 
-resolveLlvmDatas :: DynFlags -> LlvmEnv -> [LlvmUnresData] -> [LlvmData]
+
+resolveLlvmDatas ::  LlvmEnv -> [LlvmUnresData] -> [LlvmData]
                  -> (LlvmEnv, [LlvmData])
-resolveLlvmDatas _ env [] ldata
+resolveLlvmDatas env [] ldata
   = (env, ldata)
 
-resolveLlvmDatas dflags env (udata : rest) ldata
-  = let (env', ndata) = resolveLlvmData dflags env udata
-    in resolveLlvmDatas dflags env' rest (ldata ++ [ndata])
+resolveLlvmDatas env (udata : rest) ldata
+  = let (env', ndata) = resolveLlvmData env udata
+    in resolveLlvmDatas env' rest (ldata ++ [ndata])
 
 -- | Fix up CLabel references now that we should have passed all CmmData.
-resolveLlvmData :: DynFlags -> LlvmEnv -> LlvmUnresData -> (LlvmEnv, LlvmData)
-resolveLlvmData _ env (lbl, alias, unres) =
+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
         link           = if (externallyVisibleCLabel lbl)
                             then ExternallyVisible else Internal
-        glob           = LMGlobalVar label alias link Nothing Nothing
+        const          = isSecConstant sec
+        glob           = LMGlobalVar label alias link Nothing Nothing const
     in (env', (refs' ++ [(glob, struct)], [alias]))
 
 
+-- | 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
 --
@@ -94,7 +106,7 @@ resDatas env (cmm : rest) (stats, globs)
 --
 -- 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 defenition for the referenced label and
+-- we introduce a generic external definition for the referenced label and
 -- then make a pointer.
 resData :: LlvmEnv -> UnresStatic -> (LlvmEnv, LlvmStatic, [Maybe LMGlobal])
 
@@ -115,7 +127,7 @@ resData env (Left cmm@(CmmLabel l)) =
             -- pointer to it.
             Just ty' ->
                 let var = LMGlobalVar label (LMPointer ty')
-                            ExternallyVisible Nothing Nothing
+                            ExternallyVisible Nothing Nothing False
                     ptr  = LMStaticPointer var
                 in (env, LMPtoI ptr lmty, [Nothing])
 
@@ -168,7 +180,7 @@ genStaticLit (CmmInt i w)
     = Right $ LMStaticLit (LMIntLit i (LMInt $ widthInBits w))
 
 genStaticLit (CmmFloat r w)
-    = Right $ LMStaticLit (LMFloatLit r (widthToLlvmFloat w))
+    = Right $ LMStaticLit (LMFloatLit (fromRational r) (widthToLlvmFloat w))
 
 -- Leave unresolved, will fix later
 genStaticLit c@(CmmLabel        _    ) = Left $ c