From: David Terei Date: Mon, 21 Jun 2010 17:49:54 +0000 (+0000) Subject: Declare some top level globals to be constant when appropriate X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=3aadff5e31bf6b665cf7ae7606c94cdab85624d2 Declare some top level globals to be constant when appropriate This involved removing the old constant handling mechanism which was fairly hard to use. Now being constant or not is simply a property of a global variable instead of a separate type. --- diff --git a/compiler/llvmGen/Llvm.hs b/compiler/llvmGen/Llvm.hs index 8291d98..907ab39 100644 --- a/compiler/llvmGen/Llvm.hs +++ b/compiler/llvmGen/Llvm.hs @@ -28,7 +28,7 @@ module Llvm ( -- * Variables and Type System LlvmVar(..), LlvmStatic(..), LlvmLit(..), LlvmType(..), - LMGlobal, LMString, LMConstant, LMSection, LMAlign, + LMGlobal, LMString, LMSection, LMAlign, -- ** Some basic types i64, i32, i16, i8, i1, i8Ptr, llvmWord, llvmWordPtr, @@ -39,10 +39,9 @@ module Llvm ( pLift, pLower, isInt, isFloat, isPointer, llvmWidthInBits, -- * Pretty Printing - ppLlvmModule, ppLlvmComments, ppLlvmComment, ppLlvmConstants, - ppLlvmConstant, ppLlvmGlobals, ppLlvmGlobal, ppLlvmFunctionDecls, - ppLlvmFunctionDecl, ppLlvmFunctions, ppLlvmFunction, ppLlvmType, - ppLlvmTypes, llvmSDoc + ppLlvmModule, ppLlvmComments, ppLlvmComment, ppLlvmGlobals, + ppLlvmGlobal, ppLlvmFunctionDecls, ppLlvmFunctionDecl, ppLlvmFunctions, + ppLlvmFunction, ppLlvmType, ppLlvmTypes, llvmSDoc ) where diff --git a/compiler/llvmGen/Llvm/AbsSyn.hs b/compiler/llvmGen/Llvm/AbsSyn.hs index 9c255ab..05a0f08 100644 --- a/compiler/llvmGen/Llvm/AbsSyn.hs +++ b/compiler/llvmGen/Llvm/AbsSyn.hs @@ -28,9 +28,6 @@ data LlvmModule = LlvmModule { -- | Comments to include at the start of the module. modComments :: [LMString], - -- | Constants to include in the module. - modConstants :: [LMConstant], - -- | Global variables to include in the module. modGlobals :: [LMGlobal], diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/llvmGen/Llvm/PpLlvm.hs index 8068247..fffb72d 100644 --- a/compiler/llvmGen/Llvm/PpLlvm.hs +++ b/compiler/llvmGen/Llvm/PpLlvm.hs @@ -8,8 +8,6 @@ module Llvm.PpLlvm ( ppLlvmModule, ppLlvmComments, ppLlvmComment, - ppLlvmConstants, - ppLlvmConstant, ppLlvmGlobals, ppLlvmGlobal, ppLlvmType, @@ -40,10 +38,9 @@ import Unique -- | Print out a whole LLVM module. ppLlvmModule :: LlvmModule -> Doc -ppLlvmModule (LlvmModule comments constants globals decls funcs) +ppLlvmModule (LlvmModule comments globals decls funcs) = ppLlvmComments comments $+$ empty - $+$ ppLlvmConstants constants $+$ ppLlvmGlobals globals $+$ empty $+$ ppLlvmFunctionDecls decls @@ -65,10 +62,7 @@ ppLlvmGlobals ls = vcat $ map ppLlvmGlobal ls -- | Print out a global mutable variable definition ppLlvmGlobal :: LMGlobal -> Doc -ppLlvmGlobal = ppLlvmGlobal' (text "global") - -ppLlvmGlobal' :: Doc -> LMGlobal -> Doc -ppLlvmGlobal' vty (var@(LMGlobalVar _ _ link x a), cont) = +ppLlvmGlobal (var@(LMGlobalVar _ _ link x a c), dat) = let sect = case x of Just x' -> text ", section" <+> doubleQuotes (ftext x') Nothing -> empty @@ -77,22 +71,15 @@ ppLlvmGlobal' vty (var@(LMGlobalVar _ _ link x a), cont) = Just a' -> text ", align" <+> int a' Nothing -> empty - rhs = case cont of + rhs = case dat of Just stat -> texts stat Nothing -> texts (pLower $ getVarType var) - in ppAssignment var $ texts link <+> vty <+> rhs <> sect <> align - -ppLlvmGlobal' _ oth = error $ "Non Global var ppr as global! " ++ show oth - + const' = if c then text "constant" else text "global" --- | Print out a list global constant variable -ppLlvmConstants :: [LMConstant] -> Doc -ppLlvmConstants cons = vcat $ map ppLlvmConstant cons + in ppAssignment var $ texts link <+> const' <+> rhs <> sect <> align --- | Print out a global constant variable -ppLlvmConstant :: LMConstant -> Doc -ppLlvmConstant (v,s) = ppLlvmGlobal' (text "constant") (v, Just s) +ppLlvmGlobal oth = error $ "Non Global var ppr as global! " ++ show oth -- | Print out a list of LLVM type aliases. @@ -196,7 +183,7 @@ ppCall ct fptr vals attrs = case fptr of LMLocalVar _ (LMPointer (LMFunction d)) -> ppCall' d -- should be function type otherwise - LMGlobalVar _ (LMFunction d) _ _ _ -> ppCall' d + LMGlobalVar _ (LMFunction d) _ _ _ _ -> ppCall' d -- not pointer or function, so error _other -> error $ "ppCall called with non LMFunction type!\nMust be " diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs index a0b0032..ac909d1 100644 --- a/compiler/llvmGen/Llvm/Types.hs +++ b/compiler/llvmGen/Llvm/Types.hs @@ -23,8 +23,6 @@ import PprBase -- | A global mutable variable. Maybe defined or external type LMGlobal = (LlvmVar, Maybe LlvmStatic) --- | A global constant variable -type LMConstant = (LlvmVar, LlvmStatic) -- | A String in LLVM type LMString = FastString @@ -69,11 +67,12 @@ instance Show LlvmType where -- | An LLVM section defenition. If Nothing then let LLVM decide the section type LMSection = Maybe LMString type LMAlign = Maybe Int +type LMConst = Bool -- ^ is a variable constant or not -- | Llvm Variables data LlvmVar -- | Variables with a global scope. - = LMGlobalVar LMString LlvmType LlvmLinkageType LMSection LMAlign + = LMGlobalVar LMString LlvmType LlvmLinkageType LMSection LMAlign LMConst -- | Variables local to a function or parameters. | LMLocalVar Unique LlvmType -- | Named local variables. Sometimes we need to be able to explicitly name @@ -176,18 +175,18 @@ commaCat x = show (head x) ++ (concat $ map (\y -> "," ++ show y) (tail x)) -- | Return the variable name or value of the 'LlvmVar' -- in Llvm IR textual representation (e.g. @\@x@, @%y@ or @42@). getName :: LlvmVar -> String -getName v@(LMGlobalVar _ _ _ _ _) = "@" ++ getPlainName v -getName v@(LMLocalVar _ _ ) = "%" ++ getPlainName v -getName v@(LMNLocalVar _ _ ) = "%" ++ getPlainName v -getName v@(LMLitVar _ ) = getPlainName v +getName v@(LMGlobalVar _ _ _ _ _ _) = "@" ++ getPlainName v +getName v@(LMLocalVar _ _ ) = "%" ++ getPlainName v +getName v@(LMNLocalVar _ _ ) = "%" ++ getPlainName v +getName v@(LMLitVar _ ) = getPlainName v -- | Return the variable name or value of the 'LlvmVar' -- in a plain textual representation (e.g. @x@, @y@ or @42@). getPlainName :: LlvmVar -> String -getPlainName (LMGlobalVar x _ _ _ _) = unpackFS x -getPlainName (LMLocalVar x _ ) = show x -getPlainName (LMNLocalVar x _ ) = unpackFS x -getPlainName (LMLitVar x ) = getLit x +getPlainName (LMGlobalVar x _ _ _ _ _) = unpackFS x +getPlainName (LMLocalVar x _ ) = show x +getPlainName (LMNLocalVar x _ ) = unpackFS x +getPlainName (LMLitVar x ) = getLit x -- | Print a literal value. No type. getLit :: LlvmLit -> String @@ -196,10 +195,10 @@ getLit (LMFloatLit r _) = dToStr r -- | Return the 'LlvmType' of the 'LlvmVar' getVarType :: LlvmVar -> LlvmType -getVarType (LMGlobalVar _ y _ _ _) = y -getVarType (LMLocalVar _ y ) = y -getVarType (LMNLocalVar _ y ) = y -getVarType (LMLitVar l ) = getLitType l +getVarType (LMGlobalVar _ y _ _ _ _) = y +getVarType (LMLocalVar _ y ) = y +getVarType (LMNLocalVar _ y ) = y +getVarType (LMLitVar l ) = getLitType l -- | Return the 'LlvmType' of a 'LlvmLit' getLitType :: LlvmLit -> LlvmType @@ -230,8 +229,8 @@ getGlobalVar (v, _) = v -- | Return the 'LlvmLinkageType' for a 'LlvmVar' getLink :: LlvmVar -> LlvmLinkageType -getLink (LMGlobalVar _ _ l _ _) = l -getLink _ = Internal +getLink (LMGlobalVar _ _ l _ _ _) = l +getLink _ = Internal -- | Add a pointer indirection to the supplied type. 'LMLabel' and 'LMVoid' -- cannot be lifted. @@ -242,10 +241,10 @@ pLift x = LMPointer x -- | Lower a variable of 'LMPointer' type. pVarLift :: LlvmVar -> LlvmVar -pVarLift (LMGlobalVar s t l x a) = LMGlobalVar s (pLift t) l x a -pVarLift (LMLocalVar s t ) = LMLocalVar s (pLift t) -pVarLift (LMNLocalVar s t ) = LMNLocalVar s (pLift t) -pVarLift (LMLitVar _ ) = error $ "Can't lower a literal type!" +pVarLift (LMGlobalVar s t l x a c) = LMGlobalVar s (pLift t) l x a c +pVarLift (LMLocalVar s t ) = LMLocalVar s (pLift t) +pVarLift (LMNLocalVar s t ) = LMNLocalVar s (pLift t) +pVarLift (LMLitVar _ ) = error $ "Can't lower a literal type!" -- | Remove the pointer indirection of the supplied type. Only 'LMPointer' -- constructors can be lowered. @@ -255,10 +254,10 @@ pLower x = error $ show x ++ " is a unlowerable type, need a pointer" -- | Lower a variable of 'LMPointer' type. pVarLower :: LlvmVar -> LlvmVar -pVarLower (LMGlobalVar s t l x a) = LMGlobalVar s (pLower t) l x a -pVarLower (LMLocalVar s t ) = LMLocalVar s (pLower t) -pVarLower (LMNLocalVar s t ) = LMNLocalVar s (pLower t) -pVarLower (LMLitVar _ ) = error $ "Can't lower a literal type!" +pVarLower (LMGlobalVar s t l x a c) = LMGlobalVar s (pLower t) l x a c +pVarLower (LMLocalVar s t ) = LMLocalVar s (pLower t) +pVarLower (LMNLocalVar s t ) = LMNLocalVar s (pLower t) +pVarLower (LMLitVar _ ) = error $ "Can't lower a literal type!" -- | Test if the given 'LlvmType' is an integer isInt :: LlvmType -> Bool @@ -280,8 +279,8 @@ isPointer _ = False -- | Test if a 'LlvmVar' is global. isGlobal :: LlvmVar -> Bool -isGlobal (LMGlobalVar _ _ _ _ _) = True -isGlobal _ = False +isGlobal (LMGlobalVar _ _ _ _ _ _) = True +isGlobal _ = False -- | Width in bits of an 'LlvmType', returns 0 if not applicable llvmWidthInBits :: LlvmType -> Int diff --git a/compiler/llvmGen/LlvmCodeGen.hs b/compiler/llvmGen/LlvmCodeGen.hs index 1b1fd96..c208006 100644 --- a/compiler/llvmGen/LlvmCodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen.hs @@ -50,7 +50,7 @@ llvmCodeGen dflags h us cmms (cdata,env) = foldr split ([],initLlvmEnv) cmm - split (CmmData _ d' ) (d,e) = (d':d,e) + split (CmmData s d' ) (d,e) = ((s,d'):d,e) split (CmmProc i l _ _) (d,e) = let lbl = strCLabel_llvm $ if not (null i) then entryLblToInfoLbl l @@ -62,7 +62,7 @@ llvmCodeGen dflags h us cmms -- ----------------------------------------------------------------------------- -- | Do llvm code generation on all these cmms data sections. -- -cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [[CmmStatic]] +cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [(Section,[CmmStatic])] -> [LlvmUnresData] -> IO ( LlvmEnv ) cmmDataLlvmGens dflags h env [] lmdata @@ -74,7 +74,7 @@ cmmDataLlvmGens dflags h env [] lmdata return env' cmmDataLlvmGens dflags h env (cmm:cmms) lmdata - = let lmdata'@(l, ty, _) = genLlvmData cmm + = let lmdata'@(l, _, ty, _) = genLlvmData cmm env' = funInsert (strCLabel_llvm l) ty env in cmmDataLlvmGens dflags h env' cmms (lmdata ++ [lmdata']) @@ -95,7 +95,7 @@ cmmProcLlvmGens _ h _ _ [] _ ivars ty = (LMArray (length ivars) i8Ptr) usedArray = LMStaticArray (map cast ivars) ty lmUsed = (LMGlobalVar (fsLit "llvm.used") ty Appending - (Just $ fsLit "llvm.metadata") Nothing, Just usedArray) + (Just $ fsLit "llvm.metadata") Nothing False, Just usedArray) in do Prt.bufLeftRender h $ pprLlvmData ([lmUsed], []) @@ -112,7 +112,6 @@ cmmProcLlvmGens dflags h us env (cmm : cmms) count ivars -- | Complete llvm code generation phase for a single top-level chunk of Cmm. cmmLlvmGen :: DynFlags -> UniqSupply -> LlvmEnv -> RawCmmTop -> IO ( UniqSupply, LlvmEnv, [LlvmCmmTop] ) - cmmLlvmGen dflags us env cmm = do -- rewrite assignments to global regs @@ -122,20 +121,10 @@ cmmLlvmGen dflags us env cmm (pprCmm $ Cmm [fixed_cmm]) -- generate llvm code from cmm - let ((env', llvmBC), usGen) = initUs us $ genLlvmCode env fixed_cmm + let ((env', llvmBC), usGen) = initUs us $ genLlvmProc env fixed_cmm dumpIfSet_dyn dflags Opt_D_dump_llvm "LLVM Code" (vcat $ map (docToSDoc . fst . pprLlvmCmmTop env' 0) llvmBC) return (usGen, env', llvmBC) - --- ----------------------------------------------------------------------------- --- | Instruction selection --- -genLlvmCode :: LlvmEnv -> RawCmmTop - -> UniqSM (LlvmEnv, [LlvmCmmTop]) -genLlvmCode env (CmmData _ _ ) = return (env, []) -genLlvmCode env (CmmProc _ _ _ (ListGraph [])) = return (env, []) -genLlvmCode env cp@(CmmProc _ _ _ _ ) = genLlvmProc env cp - diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs index 003c044..5e0df3e 100644 --- a/compiler/llvmGen/LlvmCodeGen/Base.hs +++ b/compiler/llvmGen/LlvmCodeGen/Base.hs @@ -43,7 +43,7 @@ type LlvmBasicBlock = GenBasicBlock LlvmStatement -- | Unresolved code. -- Of the form: (data label, data type, unresovled data) -type LlvmUnresData = (CLabel, LlvmType, [UnresStatic]) +type LlvmUnresData = (CLabel, Section, LlvmType, [UnresStatic]) -- | Top level LLVM Data (globals and type aliases) type LlvmData = ([LMGlobal], [LlvmType]) @@ -158,7 +158,7 @@ genCmmLabelRef = genStringLabelRef . strCLabel_llvm genStringLabelRef :: LMString -> LMGlobal genStringLabelRef cl = let ty = LMPointer $ LMArray 0 llvmWord - in (LMGlobalVar cl ty External Nothing Nothing, Nothing) + in (LMGlobalVar cl ty External Nothing Nothing False, Nothing) -- ---------------------------------------------------------------------------- diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index 13fe123..85094f7 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -156,7 +156,7 @@ genCall env (CmmPrim MO_WriteBarrier) _ _ _ = do FixedArgs (Left [i1, i1, i1, i1, i1]) llvmFunAlign let fty = LMFunction funSig - let fv = LMGlobalVar fname fty (funcLinkage funSig) Nothing Nothing + let fv = LMGlobalVar fname fty (funcLinkage funSig) Nothing Nothing False let tops = case funLookup fname env of Just _ -> [] Nothing -> [CmmData Data [([],[fty])]] @@ -238,14 +238,14 @@ genCall env target res args ret = do Just ty'@(LMFunction sig) -> do -- Function in module in right form let fun = LMGlobalVar name ty' (funcLinkage sig) - Nothing Nothing + Nothing Nothing False return (env1, fun, nilOL, []) Just _ -> do -- label in module but not function pointer, convert let fty@(LMFunction sig) = funTy name let fun = LMGlobalVar name fty (funcLinkage sig) - Nothing Nothing + Nothing Nothing False (v1, s1) <- doExpr (pLift fty) $ Cast LM_Bitcast fun (pLift fty) return (env1, v1, unitOL s1, []) @@ -254,7 +254,7 @@ genCall env target res args ret = do -- label not in module, create external reference let fty@(LMFunction sig) = funTy name let fun = LMGlobalVar name fty (funcLinkage sig) - Nothing Nothing + Nothing Nothing False let top = CmmData Data [([],[fty])] let env' = funInsert name fty env1 return (env', fun, nilOL, [top]) @@ -827,7 +827,7 @@ genLit env cmm@(CmmLabel l) -- pointer to it. Just ty' -> do let var = LMGlobalVar label (LMPointer ty') - ExternallyVisible Nothing Nothing + ExternallyVisible Nothing Nothing False (v1, s1) <- doExpr lmty $ Cast LM_Ptrtoint var llvmWord return (env, v1, unitOL s1, []) @@ -894,26 +894,26 @@ funEpilogue = do -- with foreign functions. getHsFunc :: LlvmEnv -> CLabel -> UniqSM ExprData getHsFunc env lbl - = let fname = strCLabel_llvm lbl - ty = funLookup fname env + = let fn = strCLabel_llvm lbl + ty = funLookup fn env in case ty of Just ty'@(LMFunction sig) -> do -- Function in module in right form - let fun = LMGlobalVar fname ty' (funcLinkage sig) Nothing Nothing + let fun = LMGlobalVar fn ty' (funcLinkage sig) Nothing Nothing False return (env, fun, nilOL, []) Just ty' -> do -- label in module but not function pointer, convert - let fun = LMGlobalVar fname (pLift ty') ExternallyVisible - Nothing Nothing + let fun = LMGlobalVar fn (pLift ty') ExternallyVisible + Nothing Nothing False (v1, s1) <- doExpr (pLift llvmFunTy) $ Cast LM_Bitcast fun (pLift llvmFunTy) return (env, v1, unitOL s1, []) Nothing -> do -- label not in module, create external reference let ty' = LMFunction $ llvmFunSig lbl ExternallyVisible - let fun = LMGlobalVar fname ty' ExternallyVisible Nothing Nothing + let fun = LMGlobalVar fn ty' ExternallyVisible Nothing Nothing False let top = CmmData Data [([],[ty'])] - let env' = funInsert fname ty' env + let env' = funInsert fn ty' env return (env', fun, nilOL, [top]) diff --git a/compiler/llvmGen/LlvmCodeGen/Data.hs b/compiler/llvmGen/LlvmCodeGen/Data.hs index 13da03b..3cf6cda 100644 --- a/compiler/llvmGen/LlvmCodeGen/Data.hs +++ b/compiler/llvmGen/LlvmCodeGen/Data.hs @@ -37,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 :: [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,10 +48,11 @@ genLlvmData (CmmDataLabel lbl:xs) = strucTy = LMStruct types alias = LMAlias (label `appendFS` structStr) strucTy - in (lbl, alias, static) + in (lbl, sec, alias, static) genLlvmData _ = panic "genLlvmData: CmmData section doesn't start with label!" + resolveLlvmDatas :: LlvmEnv -> [LlvmUnresData] -> [LlvmData] -> (LlvmEnv, [LlvmData]) resolveLlvmDatas env [] ldata @@ -63,17 +64,29 @@ resolveLlvmDatas env (udata : rest) ldata -- | Fix up CLabel references now that we should have passed all CmmData. resolveLlvmData :: LlvmEnv -> LlvmUnresData -> (LlvmEnv, LlvmData) -resolveLlvmData env (lbl, alias, unres) = +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 -- @@ -114,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]) diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/llvmGen/LlvmCodeGen/Ppr.hs index 5afbd17..55bb5d0 100644 --- a/compiler/llvmGen/LlvmCodeGen/Ppr.hs +++ b/compiler/llvmGen/LlvmCodeGen/Ppr.hs @@ -59,6 +59,17 @@ pprLlvmHeader :: Doc pprLlvmHeader = moduleLayout +-- | Pretty print LLVM data code +pprLlvmData :: LlvmData -> Doc +pprLlvmData (globals, types) = + let tryConst (v, Just s ) = ppLlvmGlobal (v, Just s) + tryConst g@(_, Nothing) = ppLlvmGlobal g + + types' = ppLlvmTypes types + globals' = vcat $ map tryConst globals + in types' $+$ globals' + + -- | Pretty print LLVM code pprLlvmCmmTop :: LlvmEnv -> Int -> LlvmCmmTop -> (Doc, [LlvmVar]) pprLlvmCmmTop _ _ (CmmData _ lmdata) @@ -85,24 +96,16 @@ pprLlvmCmmTop env count (CmmProc info lbl _ (ListGraph blks)) ), ivar) --- | Pretty print LLVM data code -pprLlvmData :: LlvmData -> Doc -pprLlvmData (globals, types) = - let globals' = ppLlvmGlobals globals - types' = ppLlvmTypes types - in types' $+$ globals' - - -- | Pretty print CmmStatic pprCmmStatic :: LlvmEnv -> Int -> [CmmStatic] -> (Doc, [LlvmVar]) pprCmmStatic env count stat - = let unres = genLlvmData stat + = let unres = genLlvmData (Text, stat) (_, (ldata, ltypes)) = resolveLlvmData env unres - setSection (gv@(LMGlobalVar s ty l _ _), d) + setSection (gv@(LMGlobalVar s ty l _ _ c), d) = let v = if l == Internal then [gv] else [] sec = mkLayoutSection count - in ((LMGlobalVar s ty l sec llvmInfAlign, d), v) + in ((LMGlobalVar s ty l sec llvmInfAlign c, d), v) setSection v = (v,[]) (ldata', llvmUsed) = mapAndUnzip setSection ldata