summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorIan Lynagh <ian@well-typed.com>2012-09-12 12:37:01 +0100
committerIan Lynagh <ian@well-typed.com>2012-09-12 12:37:01 +0100
commit44b5f471a314d964948c38684ce74b7a87df4ed8 (patch)
tree075f88991983d976ad13714da61b9773a6ca0a02
parentf611396a581e733c41cee41750c95675bdb64961 (diff)
downloadhaskell-44b5f471a314d964948c38684ce74b7a87df4ed8.tar.gz
Pass DynFlags down to gcWord
-rw-r--r--compiler/cmm/CmmExpr.hs7
-rw-r--r--compiler/cmm/CmmLayoutStack.hs4
-rw-r--r--compiler/cmm/CmmParse.y2
-rw-r--r--compiler/cmm/CmmType.hs4
-rw-r--r--compiler/cmm/CmmUtils.hs2
-rw-r--r--compiler/cmm/MkGraph.hs2
-rw-r--r--compiler/codeGen/CgForeignCall.hs2
-rw-r--r--compiler/codeGen/CgPrimOp.hs4
-rw-r--r--compiler/codeGen/CgUtils.hs2
-rw-r--r--compiler/codeGen/ClosureInfo.lhs2
-rw-r--r--compiler/codeGen/StgCmmEnv.hs5
-rw-r--r--compiler/codeGen/StgCmmForeign.hs6
-rw-r--r--compiler/codeGen/StgCmmPrim.hs4
-rw-r--r--compiler/llvmGen/LlvmCodeGen/Base.hs4
-rw-r--r--compiler/llvmGen/LlvmCodeGen/CodeGen.hs7
15 files changed, 30 insertions, 27 deletions
diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index 3387b3f470..128eb1ca62 100644
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -133,7 +133,7 @@ cmmLitType dflags (CmmHighStackMark) = bWord dflags
cmmLabelType :: DynFlags -> CLabel -> CmmType
cmmLabelType dflags lbl
- | isGcPtrLabel lbl = gcWord
+ | isGcPtrLabel lbl = gcWord dflags
| otherwise = bWord dflags
cmmExprWidth :: DynFlags -> CmmExpr -> Width
@@ -415,11 +415,12 @@ node :: GlobalReg
node = VanillaReg 1 VGcPtr
globalRegType :: DynFlags -> GlobalReg -> CmmType
-globalRegType _ (VanillaReg _ VGcPtr) = gcWord
+globalRegType dflags (VanillaReg _ VGcPtr) = gcWord dflags
globalRegType dflags (VanillaReg _ VNonGcPtr) = bWord dflags
globalRegType _ (FloatReg _) = cmmFloat W32
globalRegType _ (DoubleReg _) = cmmFloat W64
globalRegType _ (LongReg _) = cmmBits W64
-globalRegType _ Hp = gcWord -- The initialiser for all
+globalRegType dflags Hp = gcWord dflags
+ -- The initialiser for all
-- dynamically allocated closures
globalRegType dflags _ = bWord dflags
diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs
index 27054bb8b3..0ddbfb6227 100644
--- a/compiler/cmm/CmmLayoutStack.hs
+++ b/compiler/cmm/CmmLayoutStack.hs
@@ -916,8 +916,8 @@ lowerSafeForeignCall dflags block
id <- newTemp (bWord dflags)
new_base <- newTemp (cmmRegType dflags (CmmGlobal BaseReg))
let (caller_save, caller_load) = callerSaveVolatileRegs dflags
- load_tso <- newTemp gcWord
- load_stack <- newTemp gcWord
+ load_tso <- newTemp (gcWord dflags)
+ load_stack <- newTemp (gcWord dflags)
let suspend = saveThreadState dflags <*>
caller_save <*>
mkMiddle (callSuspendThread id intrbl)
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index d7df52a566..bfde123fd5 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -611,7 +611,7 @@ typenot8 :: { CmmType }
| 'bits64' { b64 }
| 'float32' { f32 }
| 'float64' { f64 }
- | 'gcptr' { gcWord }
+ | 'gcptr' {% do dflags <- getDynFlags; return $ gcWord dflags }
{
section :: String -> Section
section "text" = Text
diff --git a/compiler/cmm/CmmType.hs b/compiler/cmm/CmmType.hs
index db5db9bf96..4c5d6b1138 100644
--- a/compiler/cmm/CmmType.hs
+++ b/compiler/cmm/CmmType.hs
@@ -102,8 +102,8 @@ bWord _ = cmmBits wordWidth
bHalfWord :: DynFlags -> CmmType
bHalfWord dflags = cmmBits (halfWordWidth dflags)
-gcWord :: CmmType
-gcWord = CmmType GcPtrCat wordWidth
+gcWord :: DynFlags -> CmmType
+gcWord _ = CmmType GcPtrCat wordWidth
cInt, cLong :: CmmType
cInt = cmmBits cIntWidth
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index bc092177b1..07130f336b 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -89,7 +89,7 @@ import Hoopl
primRepCmmType :: DynFlags -> PrimRep -> CmmType
primRepCmmType _ VoidRep = panic "primRepCmmType:VoidRep"
-primRepCmmType _ PtrRep = gcWord
+primRepCmmType dflags PtrRep = gcWord dflags
primRepCmmType dflags IntRep = bWord dflags
primRepCmmType dflags WordRep = bWord dflags
primRepCmmType _ Int64Rep = b64
diff --git a/compiler/cmm/MkGraph.hs b/compiler/cmm/MkGraph.hs
index 6bcdcaa966..d9dfb42cbe 100644
--- a/compiler/cmm/MkGraph.hs
+++ b/compiler/cmm/MkGraph.hs
@@ -231,7 +231,7 @@ mkReturn dflags e actuals updfr_off =
mkReturnSimple :: DynFlags -> [CmmActual] -> UpdFrameOffset -> CmmAGraph
mkReturnSimple dflags actuals updfr_off =
mkReturn dflags e actuals updfr_off
- where e = CmmLoad (CmmStackSlot Old updfr_off) gcWord
+ where e = CmmLoad (CmmStackSlot Old updfr_off) (gcWord dflags)
mkBranch :: BlockId -> CmmAGraph
mkBranch bid = mkLast (CmmBranch bid)
diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index 48f674a09a..213745d59d 100644
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -256,7 +256,7 @@ emitOpenNursery =
do dflags <- getDynFlags
stmtsC [
-- Hp = CurrentNursery->free - 1;
- CmmAssign hp (cmmOffsetW dflags (CmmLoad (nursery_bdescr_free dflags) gcWord) (-1)),
+ CmmAssign hp (cmmOffsetW dflags (CmmLoad (nursery_bdescr_free dflags) (gcWord dflags)) (-1)),
-- HpLim = CurrentNursery->start +
-- CurrentNursery->blocks*BLOCK_SIZE_W - 1;
diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs
index 92ff418049..aaa97a2132 100644
--- a/compiler/codeGen/CgPrimOp.hs
+++ b/compiler/codeGen/CgPrimOp.hs
@@ -167,7 +167,7 @@ emitPrimOp _ [res] GetCurrentCCSOp [_dummy_arg] _live
= stmtC (CmmAssign (CmmLocal res) curCCS)
emitPrimOp dflags [res] ReadMutVarOp [mutv] _
- = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW dflags mutv (fixedHdrSize dflags) gcWord))
+ = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW dflags mutv (fixedHdrSize dflags) (gcWord dflags)))
emitPrimOp dflags [] WriteMutVarOp [mutv,var] live
= do stmtC (CmmStore (cmmOffsetW dflags mutv (fixedHdrSize dflags)) var)
@@ -818,7 +818,7 @@ doIndexByteArrayOp _ _ _ _
doReadPtrArrayOp :: LocalReg -> CmmExpr -> CmmExpr -> Code
doReadPtrArrayOp res addr idx
= do dflags <- getDynFlags
- mkBasicIndexedRead (arrPtrsHdrSize dflags) Nothing gcWord res addr idx
+ mkBasicIndexedRead (arrPtrsHdrSize dflags) Nothing (gcWord dflags) res addr idx
doWriteOffAddrOp, doWriteByteArrayOp
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 29554c8f14..ca03dfa484 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -184,7 +184,7 @@ addToMemE width ptr n
tagToClosure :: DynFlags -> TyCon -> CmmExpr -> CmmExpr
tagToClosure dflags tycon tag
- = CmmLoad (cmmOffsetExprW dflags closure_tbl tag) gcWord
+ = CmmLoad (cmmOffsetExprW dflags closure_tbl tag) (gcWord dflags)
where closure_tbl = CmmLit (CmmLabel lbl)
lbl = mkClosureTableLabel (tyConName tycon) NoCafRefs
diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs
index 88174b9f8c..1b1c360f83 100644
--- a/compiler/codeGen/ClosureInfo.lhs
+++ b/compiler/codeGen/ClosureInfo.lhs
@@ -266,7 +266,7 @@ instance Outputable CgRep where
ppr DoubleArg = ptext (sLit "D_")
argMachRep :: DynFlags -> CgRep -> CmmType
-argMachRep _ PtrArg = gcWord
+argMachRep dflags PtrArg = gcWord dflags
argMachRep dflags NonPtrArg = bWord dflags
argMachRep _ LongArg = b64
argMachRep _ FloatArg = f32
diff --git a/compiler/codeGen/StgCmmEnv.hs b/compiler/codeGen/StgCmmEnv.hs
index 10fc2029a9..664a606091 100644
--- a/compiler/codeGen/StgCmmEnv.hs
+++ b/compiler/codeGen/StgCmmEnv.hs
@@ -102,8 +102,9 @@ lneIdInfo dflags id regs
rhsIdInfo :: Id -> LambdaFormInfo -> FCode (CgIdInfo, LocalReg)
rhsIdInfo id lf_info
- = do { reg <- newTemp gcWord
- ; return (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)), reg) }
+ = do dflags <- getDynFlags
+ reg <- newTemp (gcWord dflags)
+ return (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)), reg)
mkRhsInit :: DynFlags -> LocalReg -> LambdaFormInfo -> CmmExpr -> CmmAGraph
mkRhsInit dflags reg lf_info expr
diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs
index eb5850f10f..0a6b6b9e5a 100644
--- a/compiler/codeGen/StgCmmForeign.hs
+++ b/compiler/codeGen/StgCmmForeign.hs
@@ -292,7 +292,7 @@ emitSaveThreadState bid = do
-- CurrentTSO->stackobj->sp = Sp;
emitStore (cmmOffset dflags (CmmLoad (cmmOffset dflags stgCurrentTSO (tso_stackobj dflags)) (bWord dflags)) (stack_SP dflags))
- (CmmStackSlot (Young bid) (widthInBytes (typeWidth gcWord)))
+ (CmmStackSlot (Young bid) (widthInBytes (typeWidth (gcWord dflags))))
emit $ closeNursery dflags
-- and save the current cost centre stack in the TSO when profiling:
when (dopt Opt_SccProfilingOn dflags) $
@@ -304,8 +304,8 @@ closeNursery dflags = mkStore (nursery_bdescr_free dflags) (cmmOffsetW dflags st
loadThreadState :: DynFlags -> LocalReg -> LocalReg -> CmmAGraph
loadThreadState dflags tso stack = do
- -- tso <- newTemp gcWord -- TODO FIXME NOW
- -- stack <- newTemp gcWord -- TODO FIXME NOW
+ -- tso <- newTemp (gcWord dflags) -- TODO FIXME NOW
+ -- stack <- newTemp (gcWord dflags) -- TODO FIXME NOW
catAGraphs [
-- tso = CurrentTSO;
mkAssign (CmmLocal tso) stgCurrentTSO,
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index aa803e026a..e16557e09f 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -248,7 +248,7 @@ emitPrimOp _ [res] GetCurrentCCSOp [_dummy_arg]
= emitAssign (CmmLocal res) curCCS
emitPrimOp dflags [res] ReadMutVarOp [mutv]
- = emitAssign (CmmLocal res) (cmmLoadIndexW dflags mutv (fixedHdrSize dflags) gcWord)
+ = emitAssign (CmmLocal res) (cmmLoadIndexW dflags mutv (fixedHdrSize dflags) (gcWord dflags))
emitPrimOp dflags [] WriteMutVarOp [mutv,var]
= do emitStore (cmmOffsetW dflags mutv (fixedHdrSize dflags)) var
@@ -886,7 +886,7 @@ doIndexByteArrayOp _ _ _ _
doReadPtrArrayOp :: LocalReg -> CmmExpr -> CmmExpr -> FCode ()
doReadPtrArrayOp res addr idx
= do dflags <- getDynFlags
- mkBasicIndexedRead (arrPtrsHdrSize dflags) Nothing gcWord res addr idx
+ mkBasicIndexedRead (arrPtrsHdrSize dflags) Nothing (gcWord dflags) res addr idx
doWriteOffAddrOp :: Maybe MachOp -> [LocalReg] -> [CmmExpr] -> FCode ()
diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index d9a43fb249..00c2129ed9 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -137,8 +137,8 @@ tysToParams :: [LlvmType] -> [LlvmParameter]
tysToParams = map (\ty -> (ty, []))
-- | Pointer width
-llvmPtrBits :: Int
-llvmPtrBits = widthInBits $ typeWidth gcWord
+llvmPtrBits :: DynFlags -> Int
+llvmPtrBits dflags = widthInBits $ typeWidth $ gcWord dflags
-- ----------------------------------------------------------------------------
-- * Llvm Version
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index a4b7652f8a..f80a4f2b4c 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -652,9 +652,10 @@ genStore_slow env addr val meta = do
other ->
pprPanic "genStore: ptr not right type!"
(PprCmm.pprExpr addr <+> text (
- "Size of Ptr: " ++ show llvmPtrBits ++
+ "Size of Ptr: " ++ show (llvmPtrBits dflags) ++
", Size of var: " ++ show (llvmWidthInBits other) ++
", Var: " ++ show vaddr))
+ where dflags = getDflags env
-- | Unconditional branch
@@ -1130,10 +1131,10 @@ 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 ++
+ "Size of Ptr: " ++ show (llvmPtrBits dflags) ++
", Size of var: " ++ show (llvmWidthInBits other) ++
", Var: " ++ show iptr))
-
+ where dflags = getDflags env
-- | Handle CmmReg expression
--