diff options
author | Ian Lynagh <ian@well-typed.com> | 2012-09-12 12:37:01 +0100 |
---|---|---|
committer | Ian Lynagh <ian@well-typed.com> | 2012-09-12 12:37:01 +0100 |
commit | 44b5f471a314d964948c38684ce74b7a87df4ed8 (patch) | |
tree | 075f88991983d976ad13714da61b9773a6ca0a02 | |
parent | f611396a581e733c41cee41750c95675bdb64961 (diff) | |
download | haskell-44b5f471a314d964948c38684ce74b7a87df4ed8.tar.gz |
Pass DynFlags down to gcWord
-rw-r--r-- | compiler/cmm/CmmExpr.hs | 7 | ||||
-rw-r--r-- | compiler/cmm/CmmLayoutStack.hs | 4 | ||||
-rw-r--r-- | compiler/cmm/CmmParse.y | 2 | ||||
-rw-r--r-- | compiler/cmm/CmmType.hs | 4 | ||||
-rw-r--r-- | compiler/cmm/CmmUtils.hs | 2 | ||||
-rw-r--r-- | compiler/cmm/MkGraph.hs | 2 | ||||
-rw-r--r-- | compiler/codeGen/CgForeignCall.hs | 2 | ||||
-rw-r--r-- | compiler/codeGen/CgPrimOp.hs | 4 | ||||
-rw-r--r-- | compiler/codeGen/CgUtils.hs | 2 | ||||
-rw-r--r-- | compiler/codeGen/ClosureInfo.lhs | 2 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmEnv.hs | 5 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmForeign.hs | 6 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmPrim.hs | 4 | ||||
-rw-r--r-- | compiler/llvmGen/LlvmCodeGen/Base.hs | 4 | ||||
-rw-r--r-- | compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 7 |
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 -- |