Pass DynFlags down to llvmWord

6 files changed, 128 insertions, 107 deletions

diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs
index 35de40bdc4..6414501310 100644
--- a/compiler/llvmGen/Llvm/Types.hs
+++ b/compiler/llvmGen/Llvm/Types.hs
@@ -12,6 +12,7 @@ import Data.List (intercalate)
 import Numeric
 
 import Constants
+import DynFlags
 import FastString
 import Unique
 
@@ -325,21 +326,21 @@ isGlobal (LMGlobalVar _ _ _ _ _ _) = True
 isGlobal _                         = False
 
 -- | Width in bits of an 'LlvmType', returns 0 if not applicable
-llvmWidthInBits :: LlvmType -> Int
-llvmWidthInBits (LMInt n)       = n
-llvmWidthInBits (LMFloat)       = 32
-llvmWidthInBits (LMDouble)      = 64
-llvmWidthInBits (LMFloat80)     = 80
-llvmWidthInBits (LMFloat128)    = 128
+llvmWidthInBits :: DynFlags -> LlvmType -> Int
+llvmWidthInBits _      (LMInt n)       = n
+llvmWidthInBits _      (LMFloat)       = 32
+llvmWidthInBits _      (LMDouble)      = 64
+llvmWidthInBits _      (LMFloat80)     = 80
+llvmWidthInBits _      (LMFloat128)    = 128
 -- Could return either a pointer width here or the width of what
 -- it points to. We will go with the former for now.
-llvmWidthInBits (LMPointer _)   = llvmWidthInBits llvmWord
-llvmWidthInBits (LMArray _ _)   = llvmWidthInBits llvmWord
-llvmWidthInBits LMLabel         = 0
-llvmWidthInBits LMVoid          = 0
-llvmWidthInBits (LMStruct tys)  = sum $ map llvmWidthInBits tys
-llvmWidthInBits (LMFunction  _) = 0
-llvmWidthInBits (LMAlias (_,t)) = llvmWidthInBits t
+llvmWidthInBits dflags (LMPointer _)   = llvmWidthInBits dflags (llvmWord dflags)
+llvmWidthInBits dflags (LMArray _ _)   = llvmWidthInBits dflags (llvmWord dflags)
+llvmWidthInBits _      LMLabel         = 0
+llvmWidthInBits _      LMVoid          = 0
+llvmWidthInBits dflags (LMStruct tys)  = sum $ map (llvmWidthInBits dflags) tys
+llvmWidthInBits _      (LMFunction  _) = 0
+llvmWidthInBits dflags (LMAlias (_,t)) = llvmWidthInBits dflags t
 
 
 -- -----------------------------------------------------------------------------
@@ -356,9 +357,9 @@ i1    = LMInt   1
 i8Ptr = pLift i8
 
 -- | The target architectures word size
-llvmWord, llvmWordPtr :: LlvmType
-llvmWord    = LMInt (wORD_SIZE * 8)
-llvmWordPtr = pLift llvmWord
+llvmWord, llvmWordPtr :: DynFlags -> LlvmType
+llvmWord    _      = LMInt (wORD_SIZE * 8)
+llvmWordPtr dflags = pLift (llvmWord dflags)
 
 -- -----------------------------------------------------------------------------
 -- * LLVM Function Types
diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index 00c2129ed9..6996ea8f91 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -99,20 +99,19 @@ llvmFunSig env lbl link
 
 llvmFunSig' :: DynFlags -> LMString -> LlvmLinkageType -> LlvmFunctionDecl
 llvmFunSig' dflags lbl link
-  = let platform = targetPlatform dflags
-        toParams x | isPointer x = (x, [NoAlias, NoCapture])
+  = let toParams x | isPointer x = (x, [NoAlias, NoCapture])
                    | otherwise   = (x, [])
     in LlvmFunctionDecl lbl link (llvmGhcCC dflags) LMVoid FixedArgs
-                        (map (toParams . getVarType) (llvmFunArgs platform))
+                        (map (toParams . getVarType) (llvmFunArgs dflags))
                         llvmFunAlign
 
 -- | Create a Haskell function in LLVM.
 mkLlvmFunc :: LlvmEnv -> CLabel -> LlvmLinkageType -> LMSection -> LlvmBlocks
            -> LlvmFunction
 mkLlvmFunc env lbl link sec blks
-  = let platform = targetPlatform $ getDflags env
+  = let dflags = getDflags env
         funDec = llvmFunSig env lbl link
-        funArgs = map (fsLit . getPlainName) (llvmFunArgs platform)
+        funArgs = map (fsLit . getPlainName) (llvmFunArgs dflags)
     in LlvmFunction funDec funArgs llvmStdFunAttrs sec blks
 
 -- | Alignment to use for functions
@@ -124,8 +123,9 @@ llvmInfAlign :: LMAlign
 llvmInfAlign = Just wORD_SIZE
 
 -- | A Function's arguments
-llvmFunArgs :: Platform -> [LlvmVar]
-llvmFunArgs platform = map lmGlobalRegArg (activeStgRegs platform)
+llvmFunArgs :: DynFlags -> [LlvmVar]
+llvmFunArgs dflags = map (lmGlobalRegArg dflags) (activeStgRegs platform)
+    where platform = targetPlatform dflags
 
 -- | Llvm standard fun attributes
 llvmStdFunAttrs :: [LlvmFuncAttr]
@@ -169,19 +169,19 @@ type LlvmEnvMap = UniqFM LlvmType
 -- | Get initial Llvm environment.
 initLlvmEnv :: DynFlags -> LlvmEnv
 initLlvmEnv dflags = LlvmEnv (initFuncs, emptyUFM, defaultLlvmVersion, dflags)
-    where initFuncs = listToUFM $ [ (n, LMFunction ty) | (n, ty) <- ghcInternalFunctions ]
+    where initFuncs = listToUFM $ [ (n, LMFunction ty) | (n, ty) <- ghcInternalFunctions dflags ]
 
 -- | Here we pre-initialise some functions that are used internally by GHC
 -- so as to make sure they have the most general type in the case that
 -- user code also uses these functions but with a different type than GHC
 -- internally. (Main offender is treating return type as 'void' instead of
 -- 'void *'. Fixes trac #5486.
-ghcInternalFunctions :: [(LMString, LlvmFunctionDecl)]
-ghcInternalFunctions =
-    [ mk "memcpy" i8Ptr [i8Ptr, i8Ptr, llvmWord]
-    , mk "memmove" i8Ptr [i8Ptr, i8Ptr, llvmWord]
-    , mk "memset" i8Ptr [i8Ptr, llvmWord, llvmWord]
-    , mk "newSpark" llvmWord [i8Ptr, i8Ptr]
+ghcInternalFunctions :: DynFlags -> [(LMString, LlvmFunctionDecl)]
+ghcInternalFunctions dflags =
+    [ mk "memcpy" i8Ptr [i8Ptr, i8Ptr, llvmWord dflags]
+    , mk "memmove" i8Ptr [i8Ptr, i8Ptr, llvmWord dflags]
+    , mk "memset" i8Ptr [i8Ptr, llvmWord dflags, llvmWord dflags]
+    , mk "newSpark" (llvmWord dflags) [i8Ptr, i8Ptr]
     ]
   where
     mk n ret args =
@@ -244,12 +244,12 @@ strCLabel_llvm env l = {-# SCC "llvm_strCLabel" #-}
 
 -- | Create an external definition for a 'CLabel' defined in another module.
 genCmmLabelRef :: LlvmEnv -> CLabel -> LMGlobal
-genCmmLabelRef env = genStringLabelRef . strCLabel_llvm env
+genCmmLabelRef env = genStringLabelRef (getDflags env) . strCLabel_llvm env
 
 -- | As above ('genCmmLabelRef') but taking a 'LMString', not 'CLabel'.
-genStringLabelRef :: LMString -> LMGlobal
-genStringLabelRef cl
-  = let ty = LMPointer $ LMArray 0 llvmWord
+genStringLabelRef :: DynFlags -> LMString -> LMGlobal
+genStringLabelRef dflags cl
+  = let ty = LMPointer $ LMArray 0 (llvmWord dflags)
     in (LMGlobalVar cl ty External Nothing Nothing False, Nothing)
 
 -- ----------------------------------------------------------------------------
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index f80a4f2b4c..b8f41f3392 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -55,11 +55,11 @@ basicBlocksCodeGen :: LlvmEnv
                    -> ( [LlvmBasicBlock] , [LlvmCmmDecl] )
                    -> UniqSM (LlvmEnv, [LlvmBasicBlock] , [LlvmCmmDecl] )
 basicBlocksCodeGen env ([]) (blocks, tops)
-  = do let platform = targetPlatform $ getDflags env
+  = do let dflags = getDflags env
        let (blocks', allocs) = mapAndUnzip dominateAllocs blocks
        let allocs' = concat allocs
        let ((BasicBlock id fstmts):rblks) = blocks'
-       let fblocks = (BasicBlock id $ funPrologue platform ++ allocs' ++ fstmts):rblks
+       let fblocks = (BasicBlock id $ funPrologue dflags ++ allocs' ++ fstmts):rblks
        return (env, fblocks, tops)
 
 basicBlocksCodeGen env (block:blocks) (lblocks', ltops')
@@ -185,7 +185,8 @@ genCall env (CmmPrim MO_WriteBarrier _) _ _ _
 -- i8 range. So we must handle conversions from i32 to i8 explicitly as LLVM
 -- is strict about types.
 genCall env t@(CmmPrim (MO_PopCnt w) _) [CmmHinted dst _] args _ = do
-    let width = widthToLlvmInt w
+    let dflags = getDflags env
+        width = widthToLlvmInt w
         dstTy = cmmToLlvmType $ localRegType dst
         funTy = \n -> LMFunction $ LlvmFunctionDecl n ExternallyVisible
                           CC_Ccc width FixedArgs (tysToParams [width]) Nothing
@@ -193,9 +194,9 @@ genCall env t@(CmmPrim (MO_PopCnt w) _) [CmmHinted dst _] args _ = do
 
     (env2, argsV, stmts2, top2) <- arg_vars env1 args ([], nilOL, [])
     (env3, fptr, stmts3, top3)  <- getFunPtr env2 funTy t
-    (argsV', stmts4)            <- castVars $ zip argsV [width]
+    (argsV', stmts4)            <- castVars dflags $ zip argsV [width]
     (retV, s1)                  <- doExpr width $ Call StdCall fptr argsV' []
-    ([retV'], stmts5)           <- castVars [(retV,dstTy)]
+    ([retV'], stmts5)           <- castVars dflags [(retV,dstTy)]
     let s2                       = Store retV' dstV
 
     let stmts = stmts1 `appOL` stmts2 `appOL` stmts3 `appOL` stmts4 `snocOL`
@@ -208,17 +209,18 @@ genCall env t@(CmmPrim op _) [] args' CmmMayReturn
  | op == MO_Memcpy ||
    op == MO_Memset ||
    op == MO_Memmove = do
-    let (args, alignVal) = splitAlignVal args'
+    let dflags = getDflags env
+        (args, alignVal) = splitAlignVal args'
         (isVolTy, isVolVal) = if getLlvmVer env >= 28
                                  then ([i1], [mkIntLit i1 0]) else ([], [])
-        argTy | op == MO_Memset = [i8Ptr, i8,    llvmWord, i32] ++ isVolTy
-              | otherwise       = [i8Ptr, i8Ptr, llvmWord, i32] ++ isVolTy
+        argTy | op == MO_Memset = [i8Ptr, i8,    llvmWord dflags, i32] ++ isVolTy
+              | otherwise       = [i8Ptr, i8Ptr, llvmWord dflags, i32] ++ isVolTy
         funTy = \name -> LMFunction $ LlvmFunctionDecl name ExternallyVisible
                              CC_Ccc LMVoid FixedArgs (tysToParams argTy) Nothing
 
     (env1, argVars, stmts1, top1) <- arg_vars env args ([], nilOL, [])
     (env2, fptr, stmts2, top2)    <- getFunPtr env1 funTy t
-    (argVars', stmts3)            <- castVars $ zip argVars argTy
+    (argVars', stmts3)            <- castVars dflags $ zip argVars argTy
 
     let arguments = argVars' ++ (alignVal:isVolVal)
         call = Expr $ Call StdCall fptr arguments []
@@ -415,16 +417,17 @@ arg_vars env (CmmHinted e _:rest) (vars, stmts, tops)
 
 
 -- | Cast a collection of LLVM variables to specific types.
-castVars :: [(LlvmVar, LlvmType)]
+castVars :: DynFlags -> [(LlvmVar, LlvmType)]
          -> UniqSM ([LlvmVar], LlvmStatements)
-castVars vars = do
-                done <- mapM (uncurry castVar) vars
+castVars dflags vars = do
+                done <- mapM (uncurry (castVar dflags)) vars
                 let (vars', stmts) = unzip done
                 return (vars', toOL stmts)
 
 -- | Cast an LLVM variable to a specific type, panicing if it can't be done.
-castVar :: LlvmVar -> LlvmType -> UniqSM (LlvmVar, LlvmStatement)
-castVar v t | getVarType v == t
+castVar :: DynFlags -> LlvmVar -> LlvmType -> UniqSM (LlvmVar, LlvmStatement)
+castVar dflags v t
+            | getVarType v == t
             = return (v, Nop)
 
             | otherwise
@@ -432,7 +435,7 @@ castVar v t | getVarType v == t
                       (LMInt n, LMInt m)
                           -> if n < m then LM_Sext else LM_Trunc
                       (vt, _) | isFloat vt && isFloat t
-                          -> if llvmWidthInBits vt < llvmWidthInBits t
+                          -> if llvmWidthInBits dflags vt < llvmWidthInBits dflags t
                                 then LM_Fpext else LM_Fptrunc
                       (vt, _) | isInt vt && isFloat t       -> LM_Sitofp
                       (vt, _) | isFloat vt && isInt t       -> LM_Fptosi
@@ -498,10 +501,11 @@ cmmPrimOpFunctions env mop
     MO_Touch         -> unsupported
 
     where
+        dflags = getDflags env
         intrinTy1 = (if getLlvmVer env >= 28
-                       then "p0i8.p0i8." else "") ++ show llvmWord
+                       then "p0i8.p0i8." else "") ++ show (llvmWord dflags)
         intrinTy2 = (if getLlvmVer env >= 28
-                       then "p0i8." else "") ++ show llvmWord
+                       then "p0i8." else "") ++ show (llvmWord dflags)
         unsupported = panic ("cmmPrimOpFunctions: " ++ show mop
                           ++ " not supported here")
 
@@ -543,12 +547,13 @@ genJump env expr live = do
 -- these with registers when possible.
 genAssign :: LlvmEnv -> CmmReg -> CmmExpr -> UniqSM StmtData
 genAssign env reg val = do
-    let (env1, vreg, stmts1, top1) = getCmmReg env reg
+    let dflags = getDflags env
+        (env1, vreg, stmts1, top1) = getCmmReg env reg
     (env2, vval, stmts2, top2) <- exprToVar env1 val
     let stmts = stmts1 `appOL` stmts2
 
     let ty = (pLower . getVarType) vreg
-    case isPointer ty && getVarType vval == llvmWord of
+    case isPointer ty && getVarType vval == llvmWord dflags of
          -- Some registers are pointer types, so need to cast value to pointer
          True -> do
              (v, s1) <- doExpr ty $ Cast LM_Inttoptr vval ty
@@ -594,10 +599,11 @@ genStore env addr val = genStore_slow env addr val [other]
 genStore_fast :: LlvmEnv -> CmmExpr -> GlobalReg -> Int -> CmmExpr
               -> UniqSM StmtData
 genStore_fast env addr r n val
-  = let gr   = lmGlobalRegVar r
+  = let dflags = getDflags env
+        gr   = lmGlobalRegVar (getDflags env) r
         meta = [getTBAA r]
         grt  = (pLower . getVarType) gr
-        (ix,rem) = n `divMod` ((llvmWidthInBits . pLower) grt  `div` 8)
+        (ix,rem) = n `divMod` ((llvmWidthInBits dflags . pLower) grt  `div` 8)
     in case isPointer grt && rem == 0 of
             True -> do
                 (env', vval,  stmts, top) <- exprToVar env val
@@ -634,7 +640,7 @@ genStore_slow env addr val meta = do
     let stmts = stmts1 `appOL` stmts2
     case getVarType vaddr of
         -- sometimes we need to cast an int to a pointer before storing
-        LMPointer ty@(LMPointer _) | getVarType vval == llvmWord -> do
+        LMPointer ty@(LMPointer _) | getVarType vval == llvmWord dflags -> do
             (v, s1) <- doExpr ty $ Cast LM_Inttoptr vval ty
             let s2 = MetaStmt meta $ Store v vaddr
             return (env2, stmts `snocOL` s1 `snocOL` s2, top1 ++ top2)
@@ -643,7 +649,7 @@ genStore_slow env addr val meta = do
             let s1 = MetaStmt meta $ Store vval vaddr
             return (env2, stmts `snocOL` s1, top1 ++ top2)
 
-        i@(LMInt _) | i == llvmWord -> do
+        i@(LMInt _) | i == llvmWord dflags -> do
             let vty = pLift $ getVarType vval
             (vptr, s1) <- doExpr vty $ Cast LM_Inttoptr vaddr vty
             let s2 = MetaStmt meta $ Store vval vptr
@@ -653,7 +659,7 @@ genStore_slow env addr val meta = do
             pprPanic "genStore: ptr not right type!"
                     (PprCmm.pprExpr addr <+> text (
                         "Size of Ptr: " ++ show (llvmPtrBits dflags) ++
-                        ", Size of var: " ++ show (llvmWidthInBits other) ++
+                        ", Size of var: " ++ show (llvmWidthInBits dflags other) ++
                         ", Var: " ++ show vaddr))
     where dflags = getDflags env
 
@@ -723,14 +729,14 @@ data EOption = EOption {
 i1Option :: EOption
 i1Option = EOption (Just i1)
 
-wordOption :: EOption
-wordOption = EOption (Just llvmWord)
+wordOption :: DynFlags -> EOption
+wordOption dflags = EOption (Just (llvmWord dflags))
 
 
 -- | Convert a CmmExpr to a list of LlvmStatements with the result of the
 -- expression being stored in the returned LlvmVar.
 exprToVar :: LlvmEnv -> CmmExpr -> UniqSM ExprData
-exprToVar env = exprToVarOpt env wordOption
+exprToVar env = exprToVarOpt env (wordOption (getDflags env))
 
 exprToVarOpt :: LlvmEnv -> EOption -> CmmExpr -> UniqSM ExprData
 exprToVarOpt env opt e = case e of
@@ -749,7 +755,7 @@ exprToVarOpt env opt e = case e of
         case (isPointer . getVarType) v1 of
              True  -> do
                  -- Cmm wants the value, so pointer types must be cast to ints
-                 (v2, s2) <- doExpr llvmWord $ Cast LM_Ptrtoint v1 llvmWord
+                 (v2, s2) <- doExpr (llvmWord dflags) $ Cast LM_Ptrtoint v1 (llvmWord dflags)
                  return (env', v2, stmts `snocOL` s1 `snocOL` s2, top)
 
              False -> return (env', v1, stmts `snocOL` s1, top)
@@ -837,6 +843,8 @@ genMachOp env _ op [x] = case op of
     MO_S_Shr        _ -> panicOp
 
     where
+        dflags = getDflags env
+
         negate ty v2 negOp = do
             (env', vx, stmts, top) <- exprToVar env x
             (v1, s1) <- doExpr ty $ LlvmOp negOp v2 vx
@@ -852,7 +860,7 @@ genMachOp env _ op [x] = case op of
             let sameConv' op = do
                 (v1, s1) <- doExpr ty $ Cast op vx ty
                 return (env', v1, stmts `snocOL` s1, top)
-            let toWidth = llvmWidthInBits ty
+            let toWidth = llvmWidthInBits dflags ty
             -- LLVM doesn't like trying to convert to same width, so
             -- need to check for that as we do get Cmm code doing it.
             case widthInBits from  of
@@ -880,14 +888,15 @@ genMachOp env opt op e = genMachOp_slow env opt op e
 genMachOp_fast :: LlvmEnv -> EOption -> MachOp -> GlobalReg -> Int -> [CmmExpr]
                -> UniqSM ExprData
 genMachOp_fast env opt op r n e
-  = let gr   = lmGlobalRegVar r
+  = let dflags = getDflags env
+        gr   = lmGlobalRegVar dflags r
         grt  = (pLower . getVarType) gr
-        (ix,rem) = n `divMod` ((llvmWidthInBits . pLower) grt  `div` 8)
+        (ix,rem) = n `divMod` ((llvmWidthInBits dflags . pLower) grt  `div` 8)
     in case isPointer grt && rem == 0 of
             True -> do
                 (gv,  s1) <- doExpr grt $ Load gr
                 (ptr, s2) <- doExpr grt $ GetElemPtr True gv [toI32 ix]
-                (var, s3) <- doExpr llvmWord $ Cast LM_Ptrtoint ptr llvmWord
+                (var, s3) <- doExpr (llvmWord dflags) $ Cast LM_Ptrtoint ptr (llvmWord dflags)
                 return (env, var, unitOL s1 `snocOL` s2 `snocOL` s3, [])
 
             False -> genMachOp_slow env opt op e
@@ -957,6 +966,8 @@ genMachOp_slow env opt op [x, y] = case op of
     MO_FF_Conv _ _ -> panicOp
 
     where
+        dflags = getDflags env
+
         binLlvmOp ty binOp = do
             (env1, vx, stmts1, top1) <- exprToVar env x
             (env2, vy, stmts2, top2) <- exprToVar env1 y
@@ -1017,10 +1028,10 @@ genMachOp_slow env opt op [x, y] = case op of
             (env2, vy, stmts2, top2) <- exprToVar env1 y
 
             let word  = getVarType vx
-            let word2 = LMInt $ 2 * (llvmWidthInBits $ getVarType vx)
-            let shift = llvmWidthInBits word
-            let shift1 = toIWord (shift - 1)
-            let shift2 = toIWord shift
+            let word2 = LMInt $ 2 * (llvmWidthInBits dflags $ getVarType vx)
+            let shift = llvmWidthInBits dflags word
+            let shift1 = toIWord dflags (shift - 1)
+            let shift2 = toIWord dflags shift
 
             if isInt word
                 then do
@@ -1081,11 +1092,12 @@ genLoad env e ty = genLoad_slow env e ty [other]
 genLoad_fast :: LlvmEnv -> CmmExpr -> GlobalReg -> Int -> CmmType
                 -> UniqSM ExprData
 genLoad_fast env e r n ty =
-    let gr   = lmGlobalRegVar r
+    let dflags = getDflags env
+        gr   = lmGlobalRegVar dflags r
         meta = [getTBAA r]
         grt  = (pLower . getVarType) gr
         ty'  = cmmToLlvmType ty
-        (ix,rem) = n `divMod` ((llvmWidthInBits . pLower) grt  `div` 8)
+        (ix,rem) = n `divMod` ((llvmWidthInBits dflags . pLower) grt  `div` 8)
     in case isPointer grt && rem == 0 of
             True  -> do
                 (gv,  s1) <- doExpr grt $ Load gr
@@ -1122,7 +1134,7 @@ genLoad_slow env e ty meta = do
                                            (MetaExpr meta $ Load iptr)
                     return (env', dvar, stmts `snocOL` load, tops)
 
-         i@(LMInt _) | i == llvmWord -> do
+         i@(LMInt _) | i == llvmWord dflags -> do
                     let pty = LMPointer $ cmmToLlvmType ty
                     (ptr, cast)  <- doExpr pty $ Cast LM_Inttoptr iptr pty
                     (dvar, load) <- doExpr (cmmToLlvmType ty)
@@ -1132,7 +1144,7 @@ genLoad_slow env e ty meta = do
          other -> pprPanic "exprToVar: CmmLoad expression is not right type!"
                         (PprCmm.pprExpr e <+> text (
                             "Size of Ptr: " ++ show (llvmPtrBits dflags) ++
-                            ", Size of var: " ++ show (llvmWidthInBits other) ++
+                            ", Size of var: " ++ show (llvmWidthInBits dflags other) ++
                             ", Var: " ++ show iptr))
     where dflags = getDflags env
 
@@ -1150,7 +1162,7 @@ getCmmReg env r@(CmmLocal (LocalReg un _))
             Just ety -> (env, (LMLocalVar un $ pLift ety), nilOL, [])
             Nothing  -> (nenv, newv, stmts, [])
 
-getCmmReg env (CmmGlobal g) = (env, lmGlobalRegVar g, nilOL, [])
+getCmmReg env (CmmGlobal g) = (env, lmGlobalRegVar (getDflags env) g, nilOL, [])
 
 
 -- | Allocate a CmmReg on the stack
@@ -1182,10 +1194,10 @@ genLit env cmm@(CmmLabel l)
     in case ty of
             -- Make generic external label definition and then pointer to it
             Nothing -> do
-                let glob@(var, _) = genStringLabelRef label
+                let glob@(var, _) = genStringLabelRef dflags label
                 let ldata = [CmmData Data [([glob], [])]]
                 let env' = funInsert label (pLower $ getVarType var) env
-                (v1, s1) <- doExpr lmty $ Cast LM_Ptrtoint var llvmWord
+                (v1, s1) <- doExpr lmty $ Cast LM_Ptrtoint var (llvmWord dflags)
                 return (env', v1, unitOL s1, ldata)
 
             -- Referenced data exists in this module, retrieve type and make
@@ -1193,23 +1205,25 @@ genLit env cmm@(CmmLabel l)
             Just ty' -> do
                 let var = LMGlobalVar label (LMPointer ty')
                             ExternallyVisible Nothing Nothing False
-                (v1, s1) <- doExpr lmty $ Cast LM_Ptrtoint var llvmWord
+                (v1, s1) <- doExpr lmty $ Cast LM_Ptrtoint var (llvmWord dflags)
                 return (env, v1, unitOL s1, [])
 
 genLit env (CmmLabelOff label off) = do
+    let dflags = getDflags env
     (env', vlbl, stmts, stat) <- genLit env (CmmLabel label)
-    let voff = toIWord off
+    let voff = toIWord dflags off
     (v1, s1) <- doExpr (getVarType vlbl) $ LlvmOp LM_MO_Add vlbl voff
     return (env', v1, stmts `snocOL` s1, stat)
 
 genLit env (CmmLabelDiffOff l1 l2 off) = do
+    let dflags = getDflags env
     (env1, vl1, stmts1, stat1) <- genLit env (CmmLabel l1)
     (env2, vl2, stmts2, stat2) <- genLit env1 (CmmLabel l2)
-    let voff = toIWord off
+    let voff = toIWord dflags off
     let ty1 = getVarType vl1
     let ty2 = getVarType vl2
     if (isInt ty1) && (isInt ty2)
-       && (llvmWidthInBits ty1 == llvmWidthInBits ty2)
+       && (llvmWidthInBits dflags ty1 == llvmWidthInBits dflags ty2)
 
        then do
             (v1, s1) <- doExpr (getVarType vl1) $ LlvmOp LM_MO_Sub vl1 vl2
@@ -1232,11 +1246,12 @@ genLit _ CmmHighStackMark
 --
 
 -- | Function prologue. Load STG arguments into variables for function.
-funPrologue :: Platform -> [LlvmStatement]
-funPrologue platform = concat $ map getReg $ activeStgRegs platform
-    where getReg rr =
-            let reg   = lmGlobalRegVar rr
-                arg   = lmGlobalRegArg rr
+funPrologue :: DynFlags -> [LlvmStatement]
+funPrologue dflags = concat $ map getReg $ activeStgRegs platform
+    where platform = targetPlatform dflags
+          getReg rr =
+            let reg   = lmGlobalRegVar dflags rr
+                arg   = lmGlobalRegArg dflags rr
                 alloc = Assignment reg $ Alloca (pLower $ getVarType reg) 1
             in [alloc, Store arg reg]
 
@@ -1254,11 +1269,11 @@ funEpilogue env (Just live) | dopt Opt_RegLiveness dflags = do
     dflags = getDflags env
     platform = targetPlatform dflags
     loadExpr r | r `elem` alwaysLive || r `elem` live = do
-        let reg  = lmGlobalRegVar r
+        let reg  = lmGlobalRegVar dflags r
         (v,s) <- doExpr (pLower $ getVarType reg) $ Load reg
         return (v, unitOL s)
     loadExpr r = do
-        let ty = (pLower . getVarType $ lmGlobalRegVar r)
+        let ty = (pLower . getVarType $ lmGlobalRegVar dflags r)
         return (LMLitVar $ LMUndefLit ty, unitOL Nop)
 
 -- don't do liveness optimisation
@@ -1270,7 +1285,7 @@ funEpilogue env _ = do
     dflags = getDflags env
     platform = targetPlatform dflags
     loadExpr r = do
-        let reg  = lmGlobalRegVar r
+        let reg  = lmGlobalRegVar dflags r
         (v,s) <- doExpr (pLower $ getVarType reg) $ Load reg
         return (v, unitOL s)
 
@@ -1290,7 +1305,7 @@ trashStmts :: DynFlags -> LlvmStatements
 trashStmts dflags = concatOL $ map trashReg $ activeStgRegs platform
     where platform = targetPlatform dflags
           trashReg r =
-            let reg   = lmGlobalRegVar r
+            let reg   = lmGlobalRegVar dflags r
                 ty    = (pLower . getVarType) reg
                 trash = unitOL $ Store (LMLitVar $ LMUndefLit ty) reg
             in case callerSaves (targetPlatform dflags) r of
@@ -1361,9 +1376,11 @@ mkIntLit :: Integral a => LlvmType -> a -> LlvmVar
 mkIntLit ty i = LMLitVar $ LMIntLit (toInteger i) ty
 
 -- | Convert int type to a LLvmVar of word or i32 size
-toI32, toIWord :: Integral a => a -> LlvmVar
+toI32 :: Integral a => a -> LlvmVar
 toI32 = mkIntLit i32
-toIWord = mkIntLit llvmWord
+
+toIWord :: Integral a => DynFlags -> a -> LlvmVar
+toIWord dflags = mkIntLit (llvmWord dflags)
 
 
 -- | Error functions
diff --git a/compiler/llvmGen/LlvmCodeGen/Data.hs b/compiler/llvmGen/LlvmCodeGen/Data.hs
index eae8246138..9c57ab3cd4 100644
--- a/compiler/llvmGen/LlvmCodeGen/Data.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Data.hs
@@ -114,7 +114,7 @@ resData env (Left cmm@(CmmLabel l)) =
     in case ty of
             -- Make generic external label defenition and then pointer to it
             Nothing ->
-                let glob@(var, _) = genStringLabelRef label
+                let glob@(var, _) = genStringLabelRef dflags label
                     env' =  funInsert label (pLower $ getVarType var) env
                     ptr  = LMStaticPointer var
                 in  (env', LMPtoI ptr lmty, [glob])
@@ -127,15 +127,17 @@ resData env (Left cmm@(CmmLabel l)) =
                 in (env, LMPtoI ptr lmty, [])
 
 resData env (Left (CmmLabelOff label off)) =
-    let (env', var, glob) = resData env (Left (CmmLabel label))
-        offset = LMStaticLit $ LMIntLit (toInteger off) llvmWord
+    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 (env1, var1, glob1) = resData env (Left (CmmLabel l1))
+    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
+        offset = LMStaticLit $ LMIntLit (toInteger off) (llvmWord dflags)
     in (env2, LMAdd var offset, glob1 ++ glob2)
 
 resData _ _ = panic "resData: Non CLabel expr as left type!"
diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/llvmGen/LlvmCodeGen/Ppr.hs
index cf78b3730a..d73b2eb76c 100644
--- a/compiler/llvmGen/LlvmCodeGen/Ppr.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Ppr.hs
@@ -28,10 +28,10 @@ import Unique
 
 -- | Header code for LLVM modules
 pprLlvmHeader :: SDoc
-pprLlvmHeader =
+pprLlvmHeader = sdocWithDynFlags $ \dflags ->
     moduleLayout
     $+$ text ""
-    $+$ ppLlvmFunctionDecls (map snd ghcInternalFunctions)
+    $+$ ppLlvmFunctionDecls (map snd (ghcInternalFunctions dflags))
     $+$ ppLlvmMetas stgTBAA
     $+$ text ""
 
diff --git a/compiler/llvmGen/LlvmCodeGen/Regs.hs b/compiler/llvmGen/LlvmCodeGen/Regs.hs
index b7ff9f008e..49c900d5e0 100644
--- a/compiler/llvmGen/LlvmCodeGen/Regs.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Regs.hs
@@ -12,23 +12,24 @@ module LlvmCodeGen.Regs (
 import Llvm
 
 import CmmExpr
+import DynFlags
 import FastString
 import Outputable ( panic )
 
 -- | Get the LlvmVar function variable storing the real register
-lmGlobalRegVar :: GlobalReg -> LlvmVar
-lmGlobalRegVar = (pVarLift . lmGlobalReg "_Var")
+lmGlobalRegVar :: DynFlags -> GlobalReg -> LlvmVar
+lmGlobalRegVar dflags = pVarLift . lmGlobalReg dflags "_Var"
 
 -- | Get the LlvmVar function argument storing the real register
-lmGlobalRegArg :: GlobalReg -> LlvmVar
-lmGlobalRegArg = lmGlobalReg "_Arg"
+lmGlobalRegArg :: DynFlags -> GlobalReg -> LlvmVar
+lmGlobalRegArg dflags = lmGlobalReg dflags "_Arg"
 
 {- Need to make sure the names here can't conflict with the unique generated
    names. Uniques generated names containing only base62 chars. So using say
    the '_' char guarantees this.
 -}
-lmGlobalReg :: String -> GlobalReg -> LlvmVar
-lmGlobalReg suf reg
+lmGlobalReg :: DynFlags -> String -> GlobalReg -> LlvmVar
+lmGlobalReg dflags suf reg
   = case reg of
         BaseReg        -> ptrGlobal $ "Base" ++ suf
         Sp             -> ptrGlobal $ "Sp" ++ suf
@@ -53,8 +54,8 @@ lmGlobalReg suf reg
         -- LongReg, HpLim, CCSS, CurrentTSO, CurrentNusery, HpAlloc
         -- EagerBlackholeInfo, GCEnter1, GCFun, BaseReg, PicBaseReg
     where
-        wordGlobal   name = LMNLocalVar (fsLit name) llvmWord
-        ptrGlobal    name = LMNLocalVar (fsLit name) llvmWordPtr
+        wordGlobal   name = LMNLocalVar (fsLit name) (llvmWord dflags)
+        ptrGlobal    name = LMNLocalVar (fsLit name) (llvmWordPtr dflags)
         floatGlobal  name = LMNLocalVar (fsLit name) LMFloat
         doubleGlobal name = LMNLocalVar (fsLit name) LMDouble