Commit 44b5f471 authored by ian@well-typed.com's avatar ian@well-typed.com

Pass DynFlags down to gcWord

parent f611396a
......@@ -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
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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;
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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,
......
......@@ -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 ()
......
......@@ -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
......
......@@ -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
--
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment