diff options
Diffstat (limited to 'compiler/codeGen')
25 files changed, 291 insertions, 279 deletions
diff --git a/compiler/codeGen/CgBindery.lhs b/compiler/codeGen/CgBindery.lhs index 7fe79804fa..834276bd7b 100644 --- a/compiler/codeGen/CgBindery.lhs +++ b/compiler/codeGen/CgBindery.lhs @@ -38,8 +38,8 @@ import CgStackery import CgUtils import CLabel import ClosureInfo -import Constants +import DynFlags import OldCmm import PprCmm ( {- instance Outputable -} ) import SMRep @@ -87,8 +87,8 @@ data CgIdInfo , cg_tag :: {-# UNPACK #-} !Int -- tag to be added in idInfoToAmode } -mkCgIdInfo :: Id -> VolatileLoc -> StableLoc -> LambdaFormInfo -> CgIdInfo -mkCgIdInfo id vol stb lf +mkCgIdInfo :: DynFlags -> Id -> VolatileLoc -> StableLoc -> LambdaFormInfo -> CgIdInfo +mkCgIdInfo dflags id vol stb lf = CgIdInfo { cg_id = id, cg_vol = vol, cg_stb = stb, cg_lf = lf, cg_rep = idCgRep id, cg_tag = tag } where @@ -100,10 +100,10 @@ mkCgIdInfo id vol stb lf If yes, we assume that the constructor is evaluated and can be tagged. -} - = tagForCon con + = tagForCon dflags con | otherwise - = funTagLFInfo lf + = funTagLFInfo dflags lf voidIdInfo :: Id -> CgIdInfo voidIdInfo id = CgIdInfo { cg_id = id, cg_vol = NoVolatileLoc @@ -120,11 +120,11 @@ data VolatileLoc -- These locations die across a call -- NB. Byte offset, because we subtract R1's -- tag from the offset. -mkTaggedCgIdInfo :: Id -> VolatileLoc -> StableLoc -> LambdaFormInfo -> DataCon +mkTaggedCgIdInfo :: DynFlags -> Id -> VolatileLoc -> StableLoc -> LambdaFormInfo -> DataCon -> CgIdInfo -mkTaggedCgIdInfo id vol stb lf con +mkTaggedCgIdInfo dflags id vol stb lf con = CgIdInfo { cg_id = id, cg_vol = vol, cg_stb = stb, - cg_lf = lf, cg_rep = idCgRep id, cg_tag = tagForCon con } + cg_lf = lf, cg_rep = idCgRep id, cg_tag = tagForCon dflags con } \end{code} @StableLoc@ encodes where an Id can be found, used by @@ -172,36 +172,38 @@ instance Outputable StableLoc where %************************************************************************ \begin{code} -stableIdInfo :: Id -> CmmExpr -> LambdaFormInfo -> CgIdInfo -stableIdInfo id amode lf_info = mkCgIdInfo id NoVolatileLoc (StableLoc amode) lf_info +stableIdInfo :: DynFlags -> Id -> CmmExpr -> LambdaFormInfo -> CgIdInfo +stableIdInfo dflags id amode lf_info = mkCgIdInfo dflags id NoVolatileLoc (StableLoc amode) lf_info -heapIdInfo :: Id -> VirtualHpOffset -> LambdaFormInfo -> CgIdInfo -heapIdInfo id offset lf_info = mkCgIdInfo id (VirHpLoc offset) NoStableLoc lf_info +heapIdInfo :: DynFlags -> Id -> VirtualHpOffset -> LambdaFormInfo -> CgIdInfo +heapIdInfo dflags id offset lf_info = mkCgIdInfo dflags id (VirHpLoc offset) NoStableLoc lf_info -letNoEscapeIdInfo :: Id -> VirtualSpOffset -> LambdaFormInfo -> CgIdInfo -letNoEscapeIdInfo id sp lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLNE sp) lf_info +letNoEscapeIdInfo :: DynFlags -> Id -> VirtualSpOffset -> LambdaFormInfo -> CgIdInfo +letNoEscapeIdInfo dflags id sp lf_info + = mkCgIdInfo dflags id NoVolatileLoc (VirStkLNE sp) lf_info -stackIdInfo :: Id -> VirtualSpOffset -> LambdaFormInfo -> CgIdInfo -stackIdInfo id sp lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLoc sp) lf_info +stackIdInfo :: DynFlags -> Id -> VirtualSpOffset -> LambdaFormInfo -> CgIdInfo +stackIdInfo dflags id sp lf_info + = mkCgIdInfo dflags id NoVolatileLoc (VirStkLoc sp) lf_info -nodeIdInfo :: Id -> Int -> LambdaFormInfo -> CgIdInfo -nodeIdInfo id offset lf_info = mkCgIdInfo id (VirNodeLoc (wORD_SIZE*offset)) NoStableLoc lf_info +nodeIdInfo :: DynFlags -> Id -> Int -> LambdaFormInfo -> CgIdInfo +nodeIdInfo dflags id offset lf_info = mkCgIdInfo dflags id (VirNodeLoc (wORD_SIZE dflags * offset)) NoStableLoc lf_info -regIdInfo :: Id -> CmmReg -> LambdaFormInfo -> CgIdInfo -regIdInfo id reg lf_info = mkCgIdInfo id (RegLoc reg) NoStableLoc lf_info +regIdInfo :: DynFlags -> Id -> CmmReg -> LambdaFormInfo -> CgIdInfo +regIdInfo dflags id reg lf_info = mkCgIdInfo dflags id (RegLoc reg) NoStableLoc lf_info -taggedStableIdInfo :: Id -> CmmExpr -> LambdaFormInfo -> DataCon -> CgIdInfo -taggedStableIdInfo id amode lf_info con - = mkTaggedCgIdInfo id NoVolatileLoc (StableLoc amode) lf_info con +taggedStableIdInfo :: DynFlags -> Id -> CmmExpr -> LambdaFormInfo -> DataCon -> CgIdInfo +taggedStableIdInfo dflags id amode lf_info con + = mkTaggedCgIdInfo dflags id NoVolatileLoc (StableLoc amode) lf_info con -taggedHeapIdInfo :: Id -> VirtualHpOffset -> LambdaFormInfo -> DataCon +taggedHeapIdInfo :: DynFlags -> Id -> VirtualHpOffset -> LambdaFormInfo -> DataCon -> CgIdInfo -taggedHeapIdInfo id offset lf_info con - = mkTaggedCgIdInfo id (VirHpLoc offset) NoStableLoc lf_info con +taggedHeapIdInfo dflags id offset lf_info con + = mkTaggedCgIdInfo dflags id (VirHpLoc offset) NoStableLoc lf_info con -untagNodeIdInfo :: Id -> Int -> LambdaFormInfo -> Int -> CgIdInfo -untagNodeIdInfo id offset lf_info tag - = mkCgIdInfo id (VirNodeLoc (wORD_SIZE*offset - tag)) NoStableLoc lf_info +untagNodeIdInfo :: DynFlags -> Id -> Int -> LambdaFormInfo -> Int -> CgIdInfo +untagNodeIdInfo dflags id offset lf_info tag + = mkCgIdInfo dflags id (VirNodeLoc (wORD_SIZE dflags * offset - tag)) NoStableLoc lf_info idInfoToAmode :: CgIdInfo -> FCode CmmExpr @@ -283,7 +285,8 @@ modifyBindC name mangle_fn = do getCgIdInfo :: Id -> FCode CgIdInfo getCgIdInfo id - = do { -- Try local bindings first + = do { dflags <- getDynFlags + ; -- Try local bindings first ; local_binds <- getBinds ; case lookupVarEnv local_binds id of { Just info -> return info ; @@ -301,7 +304,7 @@ getCgIdInfo id in if isExternalName name then do let ext_lbl = CmmLit (CmmLabel (mkClosureLabel name $ idCafInfo id)) - return (stableIdInfo id ext_lbl (mkLFImported id)) + return (stableIdInfo dflags id ext_lbl (mkLFImported id)) else if isVoidArg (idCgRep id) then -- Void things are never in the environment @@ -428,9 +431,9 @@ getArgAmodes (atom:atoms) \begin{code} bindArgsToStack :: [(Id, VirtualSpOffset)] -> Code bindArgsToStack args - = mapCs bind args - where - bind(id, offset) = addBindC id (stackIdInfo id offset (mkLFArgument id)) + = do dflags <- getDynFlags + let bind (id, offset) = addBindC id (stackIdInfo dflags id offset (mkLFArgument id)) + mapCs bind args bindArgsToRegs :: [(Id, GlobalReg)] -> Code bindArgsToRegs args @@ -440,11 +443,13 @@ bindArgsToRegs args bindNewToNode :: Id -> VirtualHpOffset -> LambdaFormInfo -> Code bindNewToNode id offset lf_info - = addBindC id (nodeIdInfo id offset lf_info) + = do dflags <- getDynFlags + addBindC id (nodeIdInfo dflags id offset lf_info) bindNewToUntagNode :: Id -> VirtualHpOffset -> LambdaFormInfo -> Int -> Code bindNewToUntagNode id offset lf_info tag - = addBindC id (untagNodeIdInfo id offset lf_info tag) + = do dflags <- getDynFlags + addBindC id (untagNodeIdInfo dflags id offset lf_info tag) -- Create a new temporary whose unique is that in the id, -- bind the id to it, and return the addressing mode for the @@ -456,14 +461,14 @@ bindNewToTemp id temp_reg = LocalReg uniq (argMachRep dflags (idCgRep id)) lf_info = mkLFArgument id -- Always used of things we -- know nothing about - addBindC id (regIdInfo id (CmmLocal temp_reg) lf_info) + addBindC id (regIdInfo dflags id (CmmLocal temp_reg) lf_info) return temp_reg bindNewToReg :: Id -> CmmReg -> LambdaFormInfo -> Code bindNewToReg name reg lf_info - = addBindC name info - where - info = mkCgIdInfo name (RegLoc reg) NoStableLoc lf_info + = do dflags <- getDynFlags + let info = mkCgIdInfo dflags name (RegLoc reg) NoStableLoc lf_info + addBindC name info rebindToStack :: Id -> VirtualSpOffset -> Code rebindToStack name offset @@ -497,9 +502,10 @@ Probably *naughty* to look inside monad... nukeDeadBindings :: StgLiveVars -- All the *live* variables -> Code nukeDeadBindings live_vars = do + dflags <- getDynFlags binds <- getBinds let (dead_stk_slots, bs') = - dead_slots live_vars + dead_slots dflags live_vars [] [] [ (cg_id b, b) | b <- varEnvElts binds ] setBinds $ mkVarEnv bs' @@ -509,7 +515,8 @@ nukeDeadBindings live_vars = do Several boring auxiliary functions to do the dirty work. \begin{code} -dead_slots :: StgLiveVars +dead_slots :: DynFlags + -> StgLiveVars -> [(Id,CgIdInfo)] -> [VirtualSpOffset] -> [(Id,CgIdInfo)] @@ -517,12 +524,12 @@ dead_slots :: StgLiveVars -- dead_slots carries accumulating parameters for -- filtered bindings, dead slots -dead_slots _ fbs ds [] +dead_slots _ _ fbs ds [] = (ds, reverse fbs) -- Finished; rm the dups, if any -dead_slots live_vars fbs ds ((v,i):bs) +dead_slots dflags live_vars fbs ds ((v,i):bs) | v `elementOfUniqSet` live_vars - = dead_slots live_vars ((v,i):fbs) ds bs + = dead_slots dflags live_vars ((v,i):fbs) ds bs -- Live, so don't record it in dead slots -- Instead keep it in the filtered bindings @@ -530,12 +537,12 @@ dead_slots live_vars fbs ds ((v,i):bs) = case cg_stb i of VirStkLoc offset | size > 0 - -> dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs + -> dead_slots dflags live_vars fbs ([offset-size+1 .. offset] ++ ds) bs - _ -> dead_slots live_vars fbs ds bs + _ -> dead_slots dflags live_vars fbs ds bs where size :: WordOff - size = cgRepSizeW (cg_rep i) + size = cgRepSizeW dflags (cg_rep i) getLiveStackSlots :: FCode [VirtualSpOffset] -- Return the offsets of slots in stack containig live pointers diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs index 2be57893dd..45edd64666 100644 --- a/compiler/codeGen/CgCallConv.hs +++ b/compiler/codeGen/CgCallConv.hs @@ -66,18 +66,18 @@ import Data.Bits ------------------------- mkArgDescr :: Name -> [Id] -> FCode ArgDescr mkArgDescr _nm args - = case stdPattern arg_reps of - Just spec_id -> return (ArgSpec spec_id) - Nothing -> return (ArgGen arg_bits) - where - arg_bits = argBits arg_reps - arg_reps = filter nonVoidArg (map idCgRep args) - -- Getting rid of voids eases matching of standard patterns - -argBits :: [CgRep] -> [Bool] -- True for non-ptr, False for ptr -argBits [] = [] -argBits (PtrArg : args) = False : argBits args -argBits (arg : args) = take (cgRepSizeW arg) (repeat True) ++ argBits args + = do dflags <- getDynFlags + let arg_bits = argBits dflags arg_reps + arg_reps = filter nonVoidArg (map idCgRep args) + -- Getting rid of voids eases matching of standard patterns + case stdPattern arg_reps of + Just spec_id -> return (ArgSpec spec_id) + Nothing -> return (ArgGen arg_bits) + +argBits :: DynFlags -> [CgRep] -> [Bool] -- True for non-ptr, False for ptr +argBits _ [] = [] +argBits dflags (PtrArg : args) = False : argBits dflags args +argBits dflags (arg : args) = take (cgRepSizeW dflags arg) (repeat True) ++ argBits dflags args stdPattern :: [CgRep] -> Maybe StgHalfWord stdPattern [] = Just ARG_NONE -- just void args, probably diff --git a/compiler/codeGen/CgClosure.lhs b/compiler/codeGen/CgClosure.lhs index fce910489e..11a5091c07 100644 --- a/compiler/codeGen/CgClosure.lhs +++ b/compiler/codeGen/CgClosure.lhs @@ -84,7 +84,7 @@ cgTopRhsClosure id ccs binder_info upd_flag args body = do ; let descr = closureDescription dflags mod_name name closure_info = mkClosureInfo dflags True id lf_info 0 0 srt_info descr closure_label = mkLocalClosureLabel name $ idCafInfo id - cg_id_info = stableIdInfo id (mkLblExpr closure_label) lf_info + cg_id_info = stableIdInfo dflags id (mkLblExpr closure_label) lf_info closure_rep = mkStaticClosureFields dflags closure_info ccs True [] -- BUILD THE OBJECT, AND GENERATE INFO TABLE (IF NECESSARY) @@ -136,7 +136,7 @@ cgStdRhsClosure bndr _cc _bndr_info _fvs _args _body lf_info payload ; heap_offset <- allocDynClosure closure_info curCCS curCCS amodes_w_offsets -- RETURN - ; returnFC (bndr, heapIdInfo bndr heap_offset lf_info) } + ; returnFC (bndr, heapIdInfo dflags bndr heap_offset lf_info) } \end{code} Here's the general case. @@ -188,7 +188,7 @@ cgRhsClosure bndr cc bndr_info fvs upd_flag args body = do let -- A function closure pointer may be tagged, so we -- must take it into account when accessing the free variables. - mbtag = tagForArity (length args) + mbtag = tagForArity dflags (length args) bind_fv (info, offset) | Just tag <- mbtag = bindNewToUntagNode (cgIdInfoId info) offset (cgIdInfoLF info) tag @@ -211,7 +211,7 @@ cgRhsClosure bndr cc bndr_info fvs upd_flag args body = do ; heap_offset <- allocDynClosure closure_info curCCS curCCS amodes_w_offsets -- RETURN - ; returnFC (bndr, heapIdInfo bndr heap_offset lf_info) } + ; returnFC (bndr, heapIdInfo dflags bndr heap_offset lf_info) } mkClosureLFInfo :: Id -- The binder @@ -279,7 +279,7 @@ closureCodeBody _binder_info cl_info cc args body -- eg. if we're compiling a let-no-escape). ; vSp <- getVirtSp ; let (reg_args, other_args) = assignCallRegs dflags (addIdReps args) - (sp_top, stk_args) = mkVirtStkOffsets vSp other_args + (sp_top, stk_args) = mkVirtStkOffsets dflags vSp other_args -- Allocate the global ticky counter ; let ticky_ctr_lbl = mkRednCountsLabel (closureName cl_info) (clHasCafRefs cl_info) @@ -324,7 +324,7 @@ mkFunEntryCode cl_info cc reg_args stk_args sp_top reg_save_code body = do ; tickyEnterFun cl_info ; enterCostCentreFun cc (CmmMachOp (mo_wordSub dflags) [ CmmReg nodeReg - , mkIntExpr dflags (funTag cl_info) ]) + , mkIntExpr dflags (funTag dflags cl_info) ]) (node : map snd reg_args) -- live regs ; cgExpr body } @@ -365,22 +365,22 @@ mkSlowEntryCode dflags cl_info reg_args reps_w_regs :: [(CgRep,GlobalReg)] reps_w_regs = [(idCgRep id, reg) | (id,reg) <- reverse reg_args] (final_stk_offset, stk_offsets) - = mapAccumL (\off (rep,_) -> (off + cgRepSizeW rep, off)) + = mapAccumL (\off (rep,_) -> (off + cgRepSizeW dflags rep, off)) 0 reps_w_regs load_assts = zipWithEqual "mk_load" mk_load reps_w_regs stk_offsets mk_load (rep,reg) offset = CmmAssign (CmmGlobal reg) - (CmmLoad (cmmRegOffW spReg offset) + (CmmLoad (cmmRegOffW dflags spReg offset) (argMachRep dflags rep)) save_assts = zipWithEqual "mk_save" mk_save reps_w_regs stk_offsets mk_save (rep,reg) offset = ASSERT( argMachRep dflags rep `cmmEqType` globalRegType dflags reg ) - CmmStore (cmmRegOffW spReg offset) + CmmStore (cmmRegOffW dflags spReg offset) (CmmReg (CmmGlobal reg)) - stk_adj_pop = CmmAssign spReg (cmmRegOffW spReg final_stk_offset) - stk_adj_push = CmmAssign spReg (cmmRegOffW spReg (- final_stk_offset)) + stk_adj_pop = CmmAssign spReg (cmmRegOffW dflags spReg final_stk_offset) + stk_adj_push = CmmAssign spReg (cmmRegOffW dflags spReg (- final_stk_offset)) live_regs = Just $ map snd reps_w_regs jump_to_entry = CmmJump (mkLblExpr (entryLabelFromCI dflags cl_info)) live_regs \end{code} diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs index 8afbc8f64e..aeb87235e3 100644 --- a/compiler/codeGen/CgCon.lhs +++ b/compiler/codeGen/CgCon.lhs @@ -98,7 +98,7 @@ cgTopRhsCon id con args ; emitDataLits closure_label closure_rep -- RETURN - ; returnFC (id, taggedStableIdInfo id (mkLblExpr closure_label) lf_info con) } + ; returnFC (id, taggedStableIdInfo dflags id (mkLblExpr closure_label) lf_info con) } \end{code} %************************************************************************ @@ -148,8 +148,8 @@ which have exclusively size-zero (VoidRep) args, we generate no code at all. \begin{code} -buildDynCon' _ _ binder _ con [] - = returnFC (taggedStableIdInfo binder +buildDynCon' dflags _ binder _ con [] + = returnFC (taggedStableIdInfo dflags binder (mkLblExpr (mkClosureLabel (dataConName con) (idCafInfo binder))) (mkConLFInfo con) @@ -192,8 +192,8 @@ buildDynCon' dflags platform binder _ con [arg_amode] = do { let intlike_lbl = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_INTLIKE_closure") offsetW = (val_int - mIN_INTLIKE dflags) * (fixedHdrSize dflags + 1) -- INTLIKE closures consist of a header and one word payload - intlike_amode = CmmLit (cmmLabelOffW intlike_lbl offsetW) - ; returnFC (taggedStableIdInfo binder intlike_amode (mkConLFInfo con) con) } + intlike_amode = CmmLit (cmmLabelOffW dflags intlike_lbl offsetW) + ; returnFC (taggedStableIdInfo dflags binder intlike_amode (mkConLFInfo con) con) } buildDynCon' dflags platform binder _ con [arg_amode] | maybeCharLikeCon con @@ -204,8 +204,8 @@ buildDynCon' dflags platform binder _ con [arg_amode] = do { let charlike_lbl = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_CHARLIKE_closure") offsetW = (val_int - mIN_CHARLIKE dflags) * (fixedHdrSize dflags + 1) -- CHARLIKE closures consist of a header and one word payload - charlike_amode = CmmLit (cmmLabelOffW charlike_lbl offsetW) - ; returnFC (taggedStableIdInfo binder charlike_amode (mkConLFInfo con) con) } + charlike_amode = CmmLit (cmmLabelOffW dflags charlike_lbl offsetW) + ; returnFC (taggedStableIdInfo dflags binder charlike_amode (mkConLFInfo con) con) } \end{code} @@ -218,7 +218,7 @@ buildDynCon' dflags _ binder ccs con args (closure_info, amodes_w_offsets) = layOutDynConstr dflags con args ; hp_off <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets - ; returnFC (taggedHeapIdInfo binder hp_off lf_info con) } + ; returnFC (taggedHeapIdInfo dflags binder hp_off lf_info con) } where lf_info = mkConLFInfo con @@ -249,7 +249,7 @@ bindConArgs con args let -- The binding below forces the masking out of the tag bits -- when accessing the constructor field. - bind_arg (arg, offset) = bindNewToUntagNode arg offset (mkLFArgument arg) (tagForCon con) + bind_arg (arg, offset) = bindNewToUntagNode arg offset (mkLFArgument arg) (tagForCon dflags con) (_, args_w_offsets) = layOutDynConstr dflags con (addIdReps args) -- ASSERT(not (isUnboxedTupleCon con)) return () @@ -284,8 +284,8 @@ bindUnboxedTupleComponents args -- Allocate the rest on the stack -- The real SP points to the return address, above which any -- leftover unboxed-tuple components will be allocated - (ptr_sp, ptr_offsets) = mkVirtStkOffsets rsp ptr_args - (nptr_sp, nptr_offsets) = mkVirtStkOffsets ptr_sp nptr_args + (ptr_sp, ptr_offsets) = mkVirtStkOffsets dflags rsp ptr_args + (nptr_sp, nptr_offsets) = mkVirtStkOffsets dflags ptr_sp nptr_args ptrs = ptr_sp - rsp nptrs = nptr_sp - ptr_sp @@ -418,7 +418,8 @@ closures predeclared. \begin{code} cgTyCon :: TyCon -> FCode CmmGroup -- each constructor gets a separate CmmGroup cgTyCon tycon - = do { constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon) + = do { dflags <- getDynFlags + ; constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon) -- Generate a table of static closures for an enumeration type -- Put the table after the data constructor decls, because the @@ -431,7 +432,7 @@ cgTyCon tycon ; extra <- if isEnumerationTyCon tycon then do tbl <- getCmm (emitRODataLits "cgTyCon" (mkLocalClosureTableLabel (tyConName tycon) NoCafRefs) - [ CmmLabelOff (mkLocalClosureLabel (dataConName con) NoCafRefs) (tagForCon con) + [ CmmLabelOff (mkLocalClosureLabel (dataConName con) NoCafRefs) (tagForCon dflags con) | con <- tyConDataCons tycon]) return [tbl] else diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs index 435fbb0558..824a82635d 100644 --- a/compiler/codeGen/CgForeignCall.hs +++ b/compiler/codeGen/CgForeignCall.hs @@ -30,7 +30,6 @@ import OldCmm import OldCmmUtils import SMRep import ForeignCall -import Constants import DynFlags import Outputable import Module @@ -103,7 +102,7 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live = do | otherwise = Nothing -- ToDo: this might not be correct for 64-bit API - arg_size rep = max (widthInBytes (typeWidth rep)) wORD_SIZE + arg_size rep = max (widthInBytes (typeWidth rep)) (wORD_SIZE dflags) vols <- getVolatileRegs live srt <- getSRTInfo emitForeignCall' safety results @@ -286,7 +285,7 @@ stack_STACK dflags = closureField dflags (oFFSET_StgStack_stack dflags) stack_SP dflags = closureField dflags (oFFSET_StgStack_sp dflags) closureField :: DynFlags -> ByteOff -> ByteOff -closureField dflags off = off + fixedHdrSize dflags * wORD_SIZE +closureField dflags off = off + fixedHdrSize dflags * wORD_SIZE dflags stgSp, stgHp, stgCurrentTSO, stgCurrentNursery :: CmmExpr stgSp = CmmReg sp diff --git a/compiler/codeGen/CgHeapery.lhs b/compiler/codeGen/CgHeapery.lhs index f3cb7796f4..c7f6f294ce 100644 --- a/compiler/codeGen/CgHeapery.lhs +++ b/compiler/codeGen/CgHeapery.lhs @@ -42,7 +42,6 @@ import TyCon import CostCentre import Util import Module -import Constants import Outputable import DynFlags import FastString @@ -103,8 +102,9 @@ setRealHp new_realHp getHpRelOffset :: VirtualHpOffset -> FCode CmmExpr getHpRelOffset virtual_offset - = do { hp_usg <- getHpUsage - ; return (cmmRegOffW hpReg (hpRel (realHp hp_usg) virtual_offset)) } + = do { dflags <- getDynFlags + ; hp_usg <- getHpUsage + ; return (cmmRegOffW dflags hpReg (hpRel (realHp hp_usg) virtual_offset)) } \end{code} @@ -165,7 +165,7 @@ mkVirtHeapOffsets dflags is_thunk things | otherwise = fixedHdrSize dflags computeOffset wds_so_far (rep, thing) - = (wds_so_far + cgRepSizeW rep, (thing, hdr_size + wds_so_far)) + = (wds_so_far + cgRepSizeW dflags rep, (thing, hdr_size + wds_so_far)) \end{code} @@ -244,7 +244,7 @@ mkStaticClosure dflags info_lbl ccs payload padding_wds static_link_field saved_ padLitToWord :: DynFlags -> CmmLit -> [CmmLit] padLitToWord dflags lit = lit : padding pad_length where width = typeWidth (cmmLitType dflags lit) - pad_length = wORD_SIZE - widthInBytes width :: Int + pad_length = wORD_SIZE dflags - widthInBytes width :: Int padding n | n <= 0 = [] | n `rem` 2 /= 0 = CmmInt 0 W8 : padding (n-1) @@ -461,8 +461,8 @@ do_checks stk hp reg_save_code rts_lbl live "See: http://hackage.haskell.org/trac/ghc/ticket/4505", "Suggestion: read data from a file instead of having large static data", "structures in the code."]) - else do_checks' (mkIntExpr dflags (stk * wORD_SIZE)) - (mkIntExpr dflags (hp * wORD_SIZE)) + else do_checks' (mkIntExpr dflags (stk * wORD_SIZE dflags)) + (mkIntExpr dflags (hp * wORD_SIZE dflags)) (stk /= 0) (hp /= 0) reg_save_code rts_lbl live -- The offsets are now in *bytes* diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs index ce4228e0fc..e2a3aa2efd 100644 --- a/compiler/codeGen/CgInfoTbls.hs +++ b/compiler/codeGen/CgInfoTbls.hs @@ -43,7 +43,6 @@ import CLabel import Name import Unique -import Constants import DynFlags import Util import Outputable @@ -94,16 +93,17 @@ emitReturnTarget -> CgStmts -- The direct-return code (if any) -> FCode CLabel emitReturnTarget name stmts - = do { srt_info <- getSRTInfo - ; blks <- cgStmtsToBlocks stmts - ; frame <- mkStackLayout - ; let smrep = mkStackRep (mkLiveness frame) - info = CmmInfoTable { cit_lbl = info_lbl - , cit_prof = NoProfilingInfo - , cit_rep = smrep - , cit_srt = srt_info } - ; emitInfoTableAndCode entry_lbl info args blks - ; return info_lbl } + = do dflags <- getDynFlags + srt_info <- getSRTInfo + blks <- cgStmtsToBlocks stmts + frame <- mkStackLayout + let smrep = mkStackRep (mkLiveness dflags frame) + info = CmmInfoTable { cit_lbl = info_lbl + , cit_prof = NoProfilingInfo + , cit_rep = smrep + , cit_srt = srt_info } + emitInfoTableAndCode entry_lbl info args blks + return info_lbl where args = {- trace "emitReturnTarget: missing args" -} [] uniq = getUnique name @@ -173,7 +173,7 @@ stack_layout _ [] sizeW = replicate sizeW Nothing stack_layout dflags ((off, bind):binds) sizeW | off == sizeW - 1 = (Just stack_bind) : (stack_layout dflags binds (sizeW - rep_size)) where - rep_size = cgRepSizeW (cgIdInfoArgRep bind) + rep_size = cgRepSizeW dflags (cgIdInfoArgRep bind) stack_bind = LocalReg unique machRep unique = getUnique (cgIdInfoId bind) machRep = argMachRep dflags (cgIdInfoArgRep bind) @@ -217,7 +217,7 @@ emitAlgReturnTarget name branches mb_deflt fam_sz = do { blks <- getCgStmts $ do -- is the constructor tag in the node reg? dflags <- getDynFlags - if isSmallFamily fam_sz + if isSmallFamily dflags fam_sz then do -- yes, node has constr. tag let tag_expr = cmmConstrTag1 dflags (CmmReg nodeReg) branches' = [(tag+1,branch)|(tag,branch)<-branches] @@ -258,7 +258,7 @@ stdInfoTableSizeW dflags | otherwise = 0 stdInfoTableSizeB :: DynFlags -> ByteOff -stdInfoTableSizeB dflags = stdInfoTableSizeW dflags * wORD_SIZE +stdInfoTableSizeB dflags = stdInfoTableSizeW dflags * wORD_SIZE dflags stdSrtBitmapOffset :: DynFlags -> ByteOff -- Byte offset of the SRT bitmap half-word which is @@ -267,11 +267,11 @@ stdSrtBitmapOffset dflags = stdInfoTableSizeB dflags - hALF_WORD_SIZE stdClosureTypeOffset :: DynFlags -> ByteOff -- Byte offset of the closure type half-word -stdClosureTypeOffset dflags = stdInfoTableSizeB dflags - wORD_SIZE +stdClosureTypeOffset dflags = stdInfoTableSizeB dflags - wORD_SIZE dflags stdPtrsOffset, stdNonPtrsOffset :: DynFlags -> ByteOff -stdPtrsOffset dflags = stdInfoTableSizeB dflags - 2*wORD_SIZE -stdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2*wORD_SIZE + hALF_WORD_SIZE +stdPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags +stdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags + hALF_WORD_SIZE ------------------------------------------------------------------------- -- diff --git a/compiler/codeGen/CgLetNoEscape.lhs b/compiler/codeGen/CgLetNoEscape.lhs index 2fb603baed..610869ad89 100644 --- a/compiler/codeGen/CgLetNoEscape.lhs +++ b/compiler/codeGen/CgLetNoEscape.lhs @@ -162,7 +162,8 @@ cgLetNoEscapeClosure in -- saveVolatileVarsAndRegs done earlier in cgExpr. - do { (vSp, _) <- forkEvalHelp rhs_eob_info + do { dflags <- getDynFlags + ; (vSp, _) <- forkEvalHelp rhs_eob_info (do { allocStackTop retAddrSizeW ; nukeDeadBindings full_live_in_rhss }) @@ -176,7 +177,7 @@ cgLetNoEscapeClosure ; _ <- emitReturnTarget (idName bndr) abs_c ; return () }) - ; returnFC (bndr, letNoEscapeIdInfo bndr vSp lf_info) } + ; returnFC (bndr, letNoEscapeIdInfo dflags bndr vSp lf_info) } \end{code} \begin{code} diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs index 854a81a101..98c7e21332 100644 --- a/compiler/codeGen/CgPrimOp.hs +++ b/compiler/codeGen/CgPrimOp.hs @@ -28,7 +28,6 @@ import OldCmmUtils import PrimOp import SMRep import Module -import Constants import Outputable import DynFlags import FastString @@ -851,7 +850,7 @@ doWritePtrArrayOp addr idx val loadArrPtrsSize :: DynFlags -> CmmExpr -> CmmExpr loadArrPtrsSize dflags addr = CmmLoad (cmmOffsetB dflags addr off) (bWord dflags) - where off = fixedHdrSize dflags * wORD_SIZE + oFFSET_StgMutArrPtrs_ptrs dflags + where off = fixedHdrSize dflags * wORD_SIZE dflags + oFFSET_StgMutArrPtrs_ptrs dflags mkBasicIndexedRead :: ByteOff -> Maybe MachOp -> CmmType -> LocalReg -> CmmExpr -> CmmExpr -> Code @@ -967,7 +966,7 @@ doCopyArrayOp = emitCopyArray copy -- they're of different types) copy _src _dst dst_p src_p bytes live = do dflags <- getDynFlags - emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit dflags wORD_SIZE)) live + emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit dflags (wORD_SIZE dflags))) live -- | Takes a source 'MutableArray#', an offset in the source array, a -- destination 'MutableArray#', an offset into the destination array, @@ -983,8 +982,8 @@ doCopyMutableArrayOp = emitCopyArray copy copy src dst dst_p src_p bytes live = do dflags <- getDynFlags emitIfThenElse (cmmEqWord dflags src dst) - (emitMemmoveCall dst_p src_p bytes (CmmLit (mkIntCLit dflags wORD_SIZE)) live) - (emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit dflags wORD_SIZE)) live) + (emitMemmoveCall dst_p src_p bytes (CmmLit (mkIntCLit dflags (wORD_SIZE dflags))) live) + (emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit dflags (wORD_SIZE dflags))) live) emitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> StgLiveVars -> Code) @@ -1007,7 +1006,7 @@ emitCopyArray copy src0 src_off0 dst0 dst_off0 n0 live = do dst_elems_p <- assignTemp $ cmmOffsetB dflags dst (arrPtrsHdrSize dflags) dst_p <- assignTemp $ cmmOffsetExprW dflags dst_elems_p dst_off src_p <- assignTemp $ cmmOffsetExprW dflags (cmmOffsetB dflags src (arrPtrsHdrSize dflags)) src_off - bytes <- assignTemp $ cmmMulWord dflags n (CmmLit (mkIntCLit dflags wORD_SIZE)) + bytes <- assignTemp $ cmmMulWord dflags n (CmmLit (mkIntCLit dflags (wORD_SIZE dflags))) copy src dst dst_p src_p bytes live @@ -1025,7 +1024,7 @@ emitCloneArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> CmmExpr emitCloneArray info_p res_r src0 src_off0 n0 live = do dflags <- getDynFlags let arrPtrsHdrSizeW dflags = CmmLit $ mkIntCLit dflags $ fixedHdrSize dflags + - (sIZEOF_StgMutArrPtrs_NoHdr dflags `div` wORD_SIZE) + (sIZEOF_StgMutArrPtrs_NoHdr dflags `div` wORD_SIZE dflags) myCapability = cmmSubWord dflags (CmmReg baseReg) (CmmLit (mkIntCLit dflags (oFFSET_Capability_r dflags))) -- Assign the arguments to temporaries so the code generator can @@ -1045,9 +1044,9 @@ emitCloneArray info_p res_r src0 src_off0 n0 live = do let arr = CmmReg (CmmLocal arr_r) emitSetDynHdr arr (CmmLit (CmmLabel info_p)) curCCS - stmtC $ CmmStore (cmmOffsetB dflags arr (fixedHdrSize dflags * wORD_SIZE + + stmtC $ CmmStore (cmmOffsetB dflags arr (fixedHdrSize dflags * wORD_SIZE dflags + oFFSET_StgMutArrPtrs_ptrs dflags)) n - stmtC $ CmmStore (cmmOffsetB dflags arr (fixedHdrSize dflags * wORD_SIZE + + stmtC $ CmmStore (cmmOffsetB dflags arr (fixedHdrSize dflags * wORD_SIZE dflags + oFFSET_StgMutArrPtrs_size dflags)) size dst_p <- assignTemp $ cmmOffsetB dflags arr (arrPtrsHdrSize dflags) @@ -1055,12 +1054,12 @@ emitCloneArray info_p res_r src0 src_off0 n0 live = do src_off emitMemcpyCall dst_p src_p (cmmMulWord dflags n (wordSize dflags)) - (CmmLit (mkIntCLit dflags wORD_SIZE)) live + (CmmLit (mkIntCLit dflags (wORD_SIZE dflags))) live emitMemsetCall (cmmOffsetExprW dflags dst_p n) (CmmLit (mkIntCLit dflags 1)) card_bytes - (CmmLit (mkIntCLit dflags wORD_SIZE)) + (CmmLit (mkIntCLit dflags (wORD_SIZE dflags))) live stmtC $ CmmAssign (CmmLocal res_r) arr @@ -1088,11 +1087,11 @@ cardRoundUp dflags i = card dflags (cmmAddWord dflags i (CmmLit (mkIntCLit dflag bytesToWordsRoundUp :: DynFlags -> CmmExpr -> CmmExpr bytesToWordsRoundUp dflags e = cmmQuotWord dflags - (cmmAddWord dflags e (CmmLit (mkIntCLit dflags (wORD_SIZE - 1)))) + (cmmAddWord dflags e (CmmLit (mkIntCLit dflags (wORD_SIZE dflags - 1)))) (wordSize dflags) wordSize :: DynFlags -> CmmExpr -wordSize dflags = CmmLit (mkIntCLit dflags wORD_SIZE) +wordSize dflags = CmmLit (mkIntCLit dflags (wORD_SIZE dflags)) -- | Emit a call to @memcpy@. emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> StgLiveVars diff --git a/compiler/codeGen/CgProf.hs b/compiler/codeGen/CgProf.hs index 19376b95ca..6d87ee7127 100644 --- a/compiler/codeGen/CgProf.hs +++ b/compiler/codeGen/CgProf.hs @@ -45,7 +45,6 @@ import CostCentre import DynFlags import FastString import Module -import Constants -- Lots of field offsets import Outputable import Data.Char @@ -203,7 +202,9 @@ emitCostCentreStackDecl ccs -- pad out the struct with zero words until we hit the -- size of the overall struct (which we get via DerivedConstants.h) -- - lits = zero dflags : mkCCostCentre cc : replicate (sizeof_ccs_words - 2) (zero dflags) + lits = zero dflags + : mkCCostCentre cc + : replicate (sizeof_ccs_words dflags - 2) (zero dflags) ; emitDataLits (mkCCSLabel ccs) lits } | otherwise = pprPanic "emitCostCentreStackDecl" (ppr ccs) @@ -213,13 +214,13 @@ zero dflags = mkIntCLit dflags 0 zero64 :: CmmLit zero64 = CmmInt 0 W64 -sizeof_ccs_words :: Int -sizeof_ccs_words +sizeof_ccs_words :: DynFlags -> Int +sizeof_ccs_words dflags -- round up to the next word. | ms == 0 = ws | otherwise = ws + 1 where - (ws,ms) = SIZEOF_CostCentreStack `divMod` wORD_SIZE + (ws,ms) = SIZEOF_CostCentreStack `divMod` wORD_SIZE dflags -- --------------------------------------------------------------------------- -- Set the current cost centre stack @@ -284,8 +285,8 @@ ldvRecordCreate closure = do dflags <- getDynFlags ldvEnterClosure :: ClosureInfo -> Code ldvEnterClosure closure_info = do dflags <- getDynFlags + let tag = funTag dflags closure_info ldvEnter (cmmOffsetB dflags (CmmReg nodeReg) (-tag)) - where tag = funTag closure_info -- don't forget to substract node's tag ldvEnter :: CmmExpr -> Code diff --git a/compiler/codeGen/CgStackery.lhs b/compiler/codeGen/CgStackery.lhs index 7c4caf4e1d..2f7bdfc083 100644 --- a/compiler/codeGen/CgStackery.lhs +++ b/compiler/codeGen/CgStackery.lhs @@ -37,7 +37,6 @@ import SMRep import OldCmm import OldCmmUtils import CLabel -import Constants import DynFlags import Util import OrdList @@ -101,8 +100,9 @@ setRealSp new_real_sp getSpRelOffset :: VirtualSpOffset -> FCode CmmExpr getSpRelOffset virtual_offset - = do { real_sp <- getRealSp - ; return (cmmRegOffW spReg (spRel real_sp virtual_offset)) } + = do dflags <- getDynFlags + real_sp <- getRealSp + return (cmmRegOffW dflags spReg (spRel real_sp virtual_offset)) \end{code} @@ -118,12 +118,13 @@ increase towards the top of stack). \begin{code} mkVirtStkOffsets - :: VirtualSpOffset -- Offset of the last allocated thing + :: DynFlags + -> VirtualSpOffset -- Offset of the last allocated thing -> [(CgRep,a)] -- things to make offsets for -> (VirtualSpOffset, -- OUTPUTS: Topmost allocated word [(a, VirtualSpOffset)]) -- things with offsets (voids filtered out) -mkVirtStkOffsets init_Sp_offset things +mkVirtStkOffsets dflags init_Sp_offset things = loop init_Sp_offset [] (reverse things) where loop offset offs [] = (offset,offs) @@ -132,7 +133,7 @@ mkVirtStkOffsets init_Sp_offset things loop offset offs ((rep,t):things) = loop thing_slot ((t,thing_slot):offs) things where - thing_slot = offset + cgRepSizeW rep + thing_slot = offset + cgRepSizeW dflags rep -- offset of thing is offset+size, because we're -- growing the stack *downwards* as the offsets increase. @@ -149,12 +150,13 @@ mkStkAmodes CmmStmts) -- Assignments to appropriate stk slots mkStkAmodes tail_Sp things - = do { rSp <- getRealSp - ; let (last_Sp_offset, offsets) = mkVirtStkOffsets tail_Sp things - abs_cs = [ CmmStore (cmmRegOffW spReg (spRel rSp offset)) amode - | (amode, offset) <- offsets - ] - ; returnFC (last_Sp_offset, toOL abs_cs) } + = do dflags <- getDynFlags + rSp <- getRealSp + let (last_Sp_offset, offsets) = mkVirtStkOffsets dflags tail_Sp things + abs_cs = [ CmmStore (cmmRegOffW dflags spReg (spRel rSp offset)) amode + | (amode, offset) <- offsets + ] + returnFC (last_Sp_offset, toOL abs_cs) \end{code} %************************************************************************ @@ -167,7 +169,11 @@ Allocate a virtual offset for something. \begin{code} allocPrimStack :: CgRep -> FCode VirtualSpOffset -allocPrimStack rep +allocPrimStack rep = do dflags <- getDynFlags + allocPrimStack' dflags rep + +allocPrimStack' :: DynFlags -> CgRep -> FCode VirtualSpOffset +allocPrimStack' dflags rep = do { stk_usg <- getStkUsage ; let free_stk = freeStk stk_usg ; case find_block free_stk of @@ -183,7 +189,7 @@ allocPrimStack rep } where size :: WordOff - size = cgRepSizeW rep + size = cgRepSizeW dflags rep -- Find_block looks for a contiguous chunk of free slots -- returning the offset of its topmost word @@ -289,7 +295,7 @@ pushSpecUpdateFrame lbl updatee code ; MASSERT(case sequel of { OnStack -> True; _ -> False}) } ; dflags <- getDynFlags ; allocStackTop (fixedHdrSize dflags + - sIZEOF_StgUpdateFrame_NoHdr dflags `quot` wORD_SIZE) + sIZEOF_StgUpdateFrame_NoHdr dflags `quot` wORD_SIZE dflags) ; vsp <- getVirtSp ; setStackFrame vsp ; frame_addr <- getSpRelOffset vsp @@ -322,7 +328,7 @@ emitSpecPushUpdateFrame lbl frame_addr updatee = do off_updatee :: DynFlags -> ByteOff off_updatee dflags - = fixedHdrSize dflags * wORD_SIZE + (oFFSET_StgUpdateFrame_updatee dflags) + = fixedHdrSize dflags * wORD_SIZE dflags + oFFSET_StgUpdateFrame_updatee dflags \end{code} diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs index 228c5bd2c6..c52c8a8c99 100644 --- a/compiler/codeGen/CgUtils.hs +++ b/compiler/codeGen/CgUtils.hs @@ -53,7 +53,6 @@ import TyCon import DataCon import Id import IdInfo -import Constants import SMRep import OldCmm import OldCmmUtils @@ -142,20 +141,20 @@ mkLtOp dflags lit = MO_U_Lt (typeWidth (cmmLitType dflags (mkSimpleLi Big families only use the tag value 1 to represent evaluatedness. -} -isSmallFamily :: Int -> Bool -isSmallFamily fam_size = fam_size <= mAX_PTR_TAG +isSmallFamily :: DynFlags -> Int -> Bool +isSmallFamily dflags fam_size = fam_size <= mAX_PTR_TAG dflags -tagForCon :: DataCon -> ConTagZ -tagForCon con = tag +tagForCon :: DynFlags -> DataCon -> ConTagZ +tagForCon dflags con = tag where con_tag = dataConTagZ con fam_size = tyConFamilySize (dataConTyCon con) - tag | isSmallFamily fam_size = con_tag + 1 - | otherwise = 1 + tag | isSmallFamily dflags fam_size = con_tag + 1 + | otherwise = 1 --Tag an expression, to do: refactor, this appears in some other module. tagCons :: DynFlags -> DataCon -> CmmExpr -> CmmExpr -tagCons dflags con expr = cmmOffsetB dflags expr (tagForCon con) +tagCons dflags con expr = cmmOffsetB dflags expr (tagForCon dflags con) -------------------------------------------------------------------------- -- @@ -800,7 +799,7 @@ getSRTInfo = do -> do id <- newUnique let srt_desc_lbl = mkLargeSRTLabel id emitRODataLits "getSRTInfo" srt_desc_lbl - ( cmmLabelOffW srt_lbl off + ( cmmLabelOffW dflags srt_lbl off : mkWordCLit dflags (fromIntegral len) : map (mkWordCLit dflags) bmp) return (C_SRT srt_desc_lbl 0 srt_escape) diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs index 1b1c360f83..7a72a00602 100644 --- a/compiler/codeGen/ClosureInfo.lhs +++ b/compiler/codeGen/ClosureInfo.lhs @@ -342,17 +342,17 @@ separateByPtrFollowness things \end{code} \begin{code} -cgRepSizeB :: CgRep -> ByteOff -cgRepSizeB DoubleArg = dOUBLE_SIZE -cgRepSizeB LongArg = wORD64_SIZE -cgRepSizeB VoidArg = 0 -cgRepSizeB _ = wORD_SIZE - -cgRepSizeW :: CgRep -> ByteOff -cgRepSizeW DoubleArg = dOUBLE_SIZE `quot` wORD_SIZE -cgRepSizeW LongArg = wORD64_SIZE `quot` wORD_SIZE -cgRepSizeW VoidArg = 0 -cgRepSizeW _ = 1 +cgRepSizeB :: DynFlags -> CgRep -> ByteOff +cgRepSizeB dflags DoubleArg = dOUBLE_SIZE dflags +cgRepSizeB _ LongArg = wORD64_SIZE +cgRepSizeB _ VoidArg = 0 +cgRepSizeB dflags _ = wORD_SIZE dflags + +cgRepSizeW :: DynFlags -> CgRep -> ByteOff +cgRepSizeW dflags DoubleArg = dOUBLE_SIZE dflags `quot` wORD_SIZE dflags +cgRepSizeW dflags LongArg = wORD64_SIZE `quot` wORD_SIZE dflags +cgRepSizeW _ VoidArg = 0 +cgRepSizeW _ _ = 1 retAddrSizeW :: WordOff retAddrSizeW = 1 -- One word @@ -927,25 +927,27 @@ lfFunInfo :: LambdaFormInfo -> Maybe (RepArity, ArgDescr) lfFunInfo (LFReEntrant _ arity _ arg_desc) = Just (arity, arg_desc) lfFunInfo _ = Nothing -funTag :: ClosureInfo -> Int -funTag (ClosureInfo { closureLFInfo = lf_info }) = funTagLFInfo lf_info -funTag _ = 0 +funTag :: DynFlags -> ClosureInfo -> Int +funTag dflags (ClosureInfo { closureLFInfo = lf_info }) + = funTagLFInfo dflags lf_info +funTag _ _ = 0 -- maybe this should do constructor tags too? -funTagLFInfo :: LambdaFormInfo -> Int -funTagLFInfo lf +funTagLFInfo :: DynFlags -> LambdaFormInfo -> Int +funTagLFInfo dflags lf -- A function is tagged with its arity | Just (arity,_) <- lfFunInfo lf, - Just tag <- tagForArity arity + Just tag <- tagForArity dflags arity = tag -- other closures (and unknown ones) are not tagged | otherwise = 0 -tagForArity :: RepArity -> Maybe Int -tagForArity i | i <= mAX_PTR_TAG = Just i - | otherwise = Nothing +tagForArity :: DynFlags -> RepArity -> Maybe Int +tagForArity dflags i + | i <= mAX_PTR_TAG dflags = Just i + | otherwise = Nothing clHasCafRefs :: ClosureInfo -> CafInfo clHasCafRefs (ClosureInfo {closureSRT = srt}) = diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs index 65e0103099..f1022e5280 100644 --- a/compiler/codeGen/StgCmm.hs +++ b/compiler/codeGen/StgCmm.hs @@ -205,9 +205,10 @@ mkModuleInit cost_centre_info this_mod hpc_info cgEnumerationTyCon :: TyCon -> FCode () cgEnumerationTyCon tycon - = emitRODataLits (mkLocalClosureTableLabel (tyConName tycon) NoCafRefs) + = do dflags <- getDynFlags + emitRODataLits (mkLocalClosureTableLabel (tyConName tycon) NoCafRefs) [ CmmLabelOff (mkLocalClosureLabel (dataConName con) NoCafRefs) - (tagForCon con) + (tagForCon dflags con) | con <- tyConDataCons tycon] @@ -236,7 +237,7 @@ cgDataCon data_con ; ldvEnter (CmmReg nodeReg) ; tickyReturnOldCon (length arg_things) ; void $ emitReturn [cmmOffsetB dflags (CmmReg nodeReg) - (tagForCon data_con)] + (tagForCon dflags data_con)] } -- The case continuation code expects a tagged pointer diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index aac1abfe0c..02d3d0246f 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -43,7 +43,6 @@ import Module import ListSetOps import Util import BasicTypes -import Constants import Outputable import FastString import Maybes @@ -460,7 +459,7 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details ; enterCostCentreFun cc (CmmMachOp (mo_wordSub dflags) [ CmmReg nodeReg - , mkIntExpr dflags (funTag cl_info) ]) + , mkIntExpr dflags (funTag dflags cl_info) ]) ; whenC node_points (ldvEnterClosure cl_info) ; granYield arg_regs node_points @@ -483,8 +482,8 @@ bind_fv (id, off) = do { reg <- rebindToReg id; return (reg, off) } load_fvs :: LocalReg -> LambdaFormInfo -> [(LocalReg, WordOff)] -> FCode () load_fvs node lf_info = mapM_ (\ (reg, off) -> do dflags <- getDynFlags + let tag = lfDynTag dflags lf_info emit $ mkTaggedObjectLoad dflags reg node off tag) - where tag = lfDynTag lf_info ----------------------------------------- -- The "slow entry" code for a function. This entry point takes its @@ -634,7 +633,7 @@ pushUpdateFrame lbl updatee body updfr <- getUpdFrameOff dflags <- getDynFlags let - hdr = fixedHdrSize dflags * wORD_SIZE + hdr = fixedHdrSize dflags * wORD_SIZE dflags frame = updfr + hdr + sIZEOF_StgUpdateFrame_NoHdr dflags off_updatee = hdr + oFFSET_StgUpdateFrame_updatee dflags -- diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index b944208a07..85346da205 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -86,7 +86,6 @@ import TcType import TyCon import BasicTypes import Outputable -import Constants import DynFlags import Util @@ -299,32 +298,33 @@ Big families only use the tag value 1 to represent evaluatedness. We don't have very many tag bits: for example, we have 2 bits on x86-32 and 3 bits on x86-64. -} -isSmallFamily :: Int -> Bool -isSmallFamily fam_size = fam_size <= mAX_PTR_TAG +isSmallFamily :: DynFlags -> Int -> Bool +isSmallFamily dflags fam_size = fam_size <= mAX_PTR_TAG dflags -- We keep the *zero-indexed* tag in the srt_len field of the info -- table of a data constructor. dataConTagZ :: DataCon -> ConTagZ dataConTagZ con = dataConTag con - fIRST_TAG -tagForCon :: DataCon -> DynTag -tagForCon con - | isSmallFamily fam_size = con_tag + 1 - | otherwise = 1 +tagForCon :: DynFlags -> DataCon -> DynTag +tagForCon dflags con + | isSmallFamily dflags fam_size = con_tag + 1 + | otherwise = 1 where con_tag = dataConTagZ con fam_size = tyConFamilySize (dataConTyCon con) -tagForArity :: RepArity -> DynTag -tagForArity arity | isSmallFamily arity = arity - | otherwise = 0 +tagForArity :: DynFlags -> RepArity -> DynTag +tagForArity dflags arity + | isSmallFamily dflags arity = arity + | otherwise = 0 -lfDynTag :: LambdaFormInfo -> DynTag +lfDynTag :: DynFlags -> LambdaFormInfo -> DynTag -- Return the tag in the low order bits of a variable bound -- to this LambdaForm -lfDynTag (LFCon con) = tagForCon con -lfDynTag (LFReEntrant _ arity _ _) = tagForArity arity -lfDynTag _other = 0 +lfDynTag dflags (LFCon con) = tagForCon dflags con +lfDynTag dflags (LFReEntrant _ arity _ _) = tagForArity dflags arity +lfDynTag _ _other = 0 ----------------------------------------------------------------------------- @@ -755,8 +755,9 @@ lfFunInfo :: LambdaFormInfo -> Maybe (RepArity, ArgDescr) lfFunInfo (LFReEntrant _ arity _ arg_desc) = Just (arity, arg_desc) lfFunInfo _ = Nothing -funTag :: ClosureInfo -> DynTag -funTag (ClosureInfo { closureLFInfo = lf_info }) = lfDynTag lf_info +funTag :: DynFlags -> ClosureInfo -> DynTag +funTag dflags (ClosureInfo { closureLFInfo = lf_info }) + = lfDynTag dflags lf_info isToplevClosure :: ClosureInfo -> Bool isToplevClosure (ClosureInfo { closureLFInfo = lf_info }) diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index 0e0f2f13f8..c822a64e2c 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -189,7 +189,7 @@ buildDynCon' dflags platform binder _cc con [arg] val_int = fromIntegral val :: Int offsetW = (val_int - mIN_INTLIKE dflags) * (fixedHdrSize dflags + 1) -- INTLIKE closures consist of a header and one word payload - intlike_amode = cmmLabelOffW intlike_lbl offsetW + intlike_amode = cmmLabelOffW dflags intlike_lbl offsetW ; return ( litIdInfo dflags binder (mkConLFInfo con) intlike_amode , return mkNop) } @@ -203,7 +203,7 @@ buildDynCon' dflags platform binder _cc con [arg] = do { let charlike_lbl = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_CHARLIKE_closure") offsetW = (val_int - mIN_CHARLIKE dflags) * (fixedHdrSize dflags + 1) -- CHARLIKE closures consist of a header and one word payload - charlike_amode = cmmLabelOffW charlike_lbl offsetW + charlike_amode = cmmLabelOffW dflags charlike_lbl offsetW ; return ( litIdInfo dflags binder (mkConLFInfo con) charlike_amode , return mkNop) } @@ -246,17 +246,15 @@ bindConArgs (DataAlt con) base args = ASSERT(not (isUnboxedTupleCon con)) do dflags <- getDynFlags let (_, _, args_w_offsets) = mkVirtConstrOffsets dflags (addIdReps args) + tag = tagForCon dflags con + + -- The binding below forces the masking out of the tag bits + -- when accessing the constructor field. + bind_arg :: (NonVoid Id, VirtualHpOffset) -> FCode LocalReg + bind_arg (arg, offset) + = do emit $ mkTaggedObjectLoad dflags (idToReg dflags arg) base offset tag + bindArgToReg arg mapM bind_arg args_w_offsets - where - tag = tagForCon con - - -- The binding below forces the masking out of the tag bits - -- when accessing the constructor field. - bind_arg :: (NonVoid Id, VirtualHpOffset) -> FCode LocalReg - bind_arg (arg, offset) - = do { dflags <- getDynFlags - ; emit $ mkTaggedObjectLoad dflags (idToReg dflags arg) base offset tag - ; bindArgToReg arg } bindConArgs _other_con _base args = ASSERT( null args ) return [] diff --git a/compiler/codeGen/StgCmmEnv.hs b/compiler/codeGen/StgCmmEnv.hs index 664a606091..5106b971b1 100644 --- a/compiler/codeGen/StgCmmEnv.hs +++ b/compiler/codeGen/StgCmmEnv.hs @@ -76,11 +76,11 @@ nonVoidIds ids = [NonVoid id | id <- ids, not (isVoidRep (idPrimRep id))] -- Manipulating CgIdInfo ------------------------------------- -mkCgIdInfo :: Id -> LambdaFormInfo -> CmmExpr -> CgIdInfo -mkCgIdInfo id lf expr +mkCgIdInfo :: DynFlags -> Id -> LambdaFormInfo -> CmmExpr -> CgIdInfo +mkCgIdInfo dflags id lf expr = CgIdInfo { cg_id = id, cg_lf = lf , cg_loc = CmmLoc expr, - cg_tag = lfDynTag lf } + cg_tag = lfDynTag dflags lf } litIdInfo :: DynFlags -> Id -> LambdaFormInfo -> CmmLit -> CgIdInfo litIdInfo dflags id lf lit @@ -88,13 +88,13 @@ litIdInfo dflags id lf lit , cg_loc = CmmLoc (addDynTag dflags (CmmLit lit) tag) , cg_tag = tag } where - tag = lfDynTag lf + tag = lfDynTag dflags lf lneIdInfo :: DynFlags -> Id -> [NonVoid Id] -> CgIdInfo lneIdInfo dflags id regs = CgIdInfo { cg_id = id, cg_lf = lf , cg_loc = LneLoc blk_id (map (idToReg dflags) regs) - , cg_tag = lfDynTag lf } + , cg_tag = lfDynTag dflags lf } where lf = mkLFLetNoEscape blk_id = mkBlockId (idUnique id) @@ -104,11 +104,11 @@ rhsIdInfo :: Id -> LambdaFormInfo -> FCode (CgIdInfo, LocalReg) rhsIdInfo id lf_info = do dflags <- getDynFlags reg <- newTemp (gcWord dflags) - return (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)), reg) + return (mkCgIdInfo dflags id lf_info (CmmReg (CmmLocal reg)), reg) mkRhsInit :: DynFlags -> LocalReg -> LambdaFormInfo -> CmmExpr -> CmmAGraph mkRhsInit dflags reg lf_info expr - = mkAssign (CmmLocal reg) (addDynTag dflags expr (lfDynTag lf_info)) + = mkAssign (CmmLocal reg) (addDynTag dflags expr (lfDynTag dflags lf_info)) idInfoToAmode :: CgIdInfo -> CmmExpr -- Returns a CmmExpr for the *tagged* pointer @@ -217,7 +217,7 @@ bindToReg :: NonVoid Id -> LambdaFormInfo -> FCode LocalReg bindToReg nvid@(NonVoid id) lf_info = do dflags <- getDynFlags let reg = idToReg dflags nvid - addBindC id (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg))) + addBindC id (mkCgIdInfo dflags id lf_info (CmmReg (CmmLocal reg))) return reg rebindToReg :: NonVoid Id -> FCode LocalReg diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index ccd7d96231..307d3715b3 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -512,7 +512,7 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts bndr_reg = CmmLocal (idToReg dflags bndr) -- Is the constructor tag in the node reg? - ; if isSmallFamily fam_sz + ; if isSmallFamily dflags fam_sz then do let -- Yes, bndr_reg has constr. tag in ls bits tag_expr = cmmConstrTag1 dflags (CmmReg bndr_reg) diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs index ca5f49794b..9e4db9cdaa 100644 --- a/compiler/codeGen/StgCmmForeign.hs +++ b/compiler/codeGen/StgCmmForeign.hs @@ -34,7 +34,6 @@ import TysPrim import CLabel import SMRep import ForeignCall -import Constants import DynFlags import Maybes import Outputable @@ -66,7 +65,7 @@ cgForeignCall (CCall (CCallSpec target cconv safety)) stg_args res_ty -- ToDo: this might not be correct for 64-bit API arg_size (arg, _) = max (widthInBytes $ typeWidth $ cmmExprType dflags arg) - wORD_SIZE + (wORD_SIZE dflags) ; cmm_args <- getFCallArgs stg_args ; (res_regs, res_hints) <- newUnboxedTupleRegs res_ty ; let ((call_args, arg_hints), cmm_target) @@ -363,7 +362,7 @@ stack_SP dflags = closureField dflags (oFFSET_StgStack_sp dflags) closureField :: DynFlags -> ByteOff -> ByteOff -closureField dflags off = off + fixedHdrSize dflags * wORD_SIZE +closureField dflags off = off + fixedHdrSize dflags * wORD_SIZE dflags stgSp, stgHp, stgCurrentTSO, stgCurrentNursery :: CmmExpr stgSp = CmmReg sp diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index a19810b6fb..fb3739177c 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -44,7 +44,6 @@ import IdInfo( CafInfo(..), mayHaveCafRefs ) import Module import DynFlags import FastString( mkFastString, fsLit ) -import Constants import Util import Control.Monad (when) @@ -222,7 +221,7 @@ mkStaticClosure dflags info_lbl ccs payload padding static_link_field saved_info padLitToWord :: DynFlags -> CmmLit -> [CmmLit] padLitToWord dflags lit = lit : padding pad_length where width = typeWidth (cmmLitType dflags lit) - pad_length = wORD_SIZE - widthInBytes width :: Int + pad_length = wORD_SIZE dflags - widthInBytes width :: Int padding n | n <= 0 = [] | n `rem` 2 /= 0 = CmmInt 0 W8 : padding (n-1) @@ -543,7 +542,7 @@ do_checks :: Bool -- Should we check the stack? do_checks checkStack alloc do_gc = do dflags <- getDynFlags let - alloc_lit = mkIntExpr dflags (alloc*wORD_SIZE) -- Bytes + alloc_lit = mkIntExpr dflags (alloc * wORD_SIZE dflags) -- Bytes bump_hp = cmmOffsetExprB dflags (CmmReg hpReg) alloc_lit -- Sp overflow if (Sp - CmmHighStack < SpLim) diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs index a7426284a3..142100e109 100644 --- a/compiler/codeGen/StgCmmLayout.hs +++ b/compiler/codeGen/StgCmmLayout.hs @@ -219,7 +219,7 @@ direct_call caller call_conv lbl arity args emitCallWithExtraStack (call_conv, NativeReturn) target (nonVArgs fast_args) - (mkStkOffsets (stack_args dflags)) + (mkStkOffsets dflags (stack_args dflags)) where target = CmmLit (CmmLabel lbl) (fast_args, rest_args) = splitAt real_arity args @@ -329,10 +329,11 @@ slowCallPattern [] = (fsLit "stg_ap_0", 0) -- See Note [over-saturated calls]. mkStkOffsets - :: [(ArgRep, Maybe CmmExpr)] -- things to make offsets for + :: DynFlags + -> [(ArgRep, Maybe CmmExpr)] -- things to make offsets for -> ( ByteOff -- OUTPUTS: Topmost allocated word , [(CmmExpr, ByteOff)] ) -- things with offsets (voids filtered out) -mkStkOffsets things +mkStkOffsets dflags things = loop 0 [] (reverse things) where loop offset offs [] = (offset,offs) @@ -341,7 +342,7 @@ mkStkOffsets things loop offset offs ((rep,Just thing):things) = loop thing_off ((thing, thing_off):offs) things where - thing_off = offset + argRepSizeW rep * wORD_SIZE + thing_off = offset + argRepSizeW dflags rep * wORD_SIZE dflags -- offset of thing is offset+size, because we're -- growing the stack *downwards* as the offsets increase. @@ -382,13 +383,13 @@ isNonV :: ArgRep -> Bool isNonV V = False isNonV _ = True -argRepSizeW :: ArgRep -> WordOff -- Size in words -argRepSizeW N = 1 -argRepSizeW P = 1 -argRepSizeW F = 1 -argRepSizeW L = wORD64_SIZE `quot` wORD_SIZE -argRepSizeW D = dOUBLE_SIZE `quot` wORD_SIZE -argRepSizeW V = 0 +argRepSizeW :: DynFlags -> ArgRep -> WordOff -- Size in words +argRepSizeW _ N = 1 +argRepSizeW _ P = 1 +argRepSizeW _ F = 1 +argRepSizeW dflags L = wORD64_SIZE `quot` wORD_SIZE dflags +argRepSizeW dflags D = dOUBLE_SIZE dflags `quot` wORD_SIZE dflags +argRepSizeW _ V = 0 idArgRep :: Id -> ArgRep idArgRep = toArgRep . idPrimRep @@ -405,8 +406,9 @@ hpRel hp off = off - hp getHpRelOffset :: VirtualHpOffset -> FCode CmmExpr getHpRelOffset virtual_offset - = do { hp_usg <- getHpUsage - ; return (cmmRegOffW hpReg (hpRel (realHp hp_usg) virtual_offset)) } + = do dflags <- getDynFlags + hp_usg <- getHpUsage + return (cmmRegOffW dflags hpReg (hpRel (realHp hp_usg) virtual_offset)) mkVirtHeapOffsets :: DynFlags @@ -438,7 +440,7 @@ mkVirtHeapOffsets dflags is_thunk things | otherwise = fixedHdrSize dflags computeOffset wds_so_far (rep, thing) - = (wds_so_far + argRepSizeW (toArgRep rep), + = (wds_so_far + argRepSizeW dflags (toArgRep rep), (NonVoid thing, hdr_size + wds_so_far)) mkVirtConstrOffsets :: DynFlags -> [(PrimRep,a)] -> (WordOff, WordOff, [(NonVoid a, VirtualHpOffset)]) @@ -462,19 +464,20 @@ mkVirtConstrOffsets dflags = mkVirtHeapOffsets dflags False #include "../includes/rts/storage/FunTypes.h" mkArgDescr :: Name -> [Id] -> FCode ArgDescr -mkArgDescr _nm args - = case stdPattern arg_reps of - Just spec_id -> return (ArgSpec spec_id) - Nothing -> return (ArgGen arg_bits) - where - arg_bits = argBits arg_reps - arg_reps = filter isNonV (map idArgRep args) - -- Getting rid of voids eases matching of standard patterns - -argBits :: [ArgRep] -> [Bool] -- True for non-ptr, False for ptr -argBits [] = [] -argBits (P : args) = False : argBits args -argBits (arg : args) = take (argRepSizeW arg) (repeat True) ++ argBits args +mkArgDescr _nm args + = do dflags <- getDynFlags + let arg_bits = argBits dflags arg_reps + arg_reps = filter isNonV (map idArgRep args) + -- Getting rid of voids eases matching of standard patterns + case stdPattern arg_reps of + Just spec_id -> return (ArgSpec spec_id) + Nothing -> return (ArgGen arg_bits) + +argBits :: DynFlags -> [ArgRep] -> [Bool] -- True for non-ptr, False for ptr +argBits _ [] = [] +argBits dflags (P : args) = False : argBits dflags args +argBits dflags (arg : args) = take (argRepSizeW dflags arg) (repeat True) + ++ argBits dflags args ---------------------- stdPattern :: [ArgRep] -> Maybe StgHalfWord @@ -570,7 +573,7 @@ stdInfoTableSizeW dflags | otherwise = 0 stdInfoTableSizeB :: DynFlags -> ByteOff -stdInfoTableSizeB dflags = stdInfoTableSizeW dflags * wORD_SIZE :: ByteOff +stdInfoTableSizeB dflags = stdInfoTableSizeW dflags * wORD_SIZE dflags stdSrtBitmapOffset :: DynFlags -> ByteOff -- Byte offset of the SRT bitmap half-word which is @@ -579,11 +582,11 @@ stdSrtBitmapOffset dflags = stdInfoTableSizeB dflags - hALF_WORD_SIZE stdClosureTypeOffset :: DynFlags -> ByteOff -- Byte offset of the closure type half-word -stdClosureTypeOffset dflags = stdInfoTableSizeB dflags - wORD_SIZE +stdClosureTypeOffset dflags = stdInfoTableSizeB dflags - wORD_SIZE dflags stdPtrsOffset, stdNonPtrsOffset :: DynFlags -> ByteOff -stdPtrsOffset dflags = stdInfoTableSizeB dflags - 2*wORD_SIZE -stdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2*wORD_SIZE + hALF_WORD_SIZE +stdPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags +stdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags + hALF_WORD_SIZE ------------------------------------------------------------------------- -- diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index 0d5e3778bf..cbb2aa70bd 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -42,7 +42,6 @@ import CLabel import CmmUtils import PrimOp import SMRep -import Constants import Module import FastString import Outputable @@ -919,7 +918,7 @@ doWritePtrArrayOp addr idx val loadArrPtrsSize :: DynFlags -> CmmExpr -> CmmExpr loadArrPtrsSize dflags addr = CmmLoad (cmmOffsetB dflags addr off) (bWord dflags) - where off = fixedHdrSize dflags * wORD_SIZE + oFFSET_StgMutArrPtrs_ptrs dflags + where off = fixedHdrSize dflags * wORD_SIZE dflags + oFFSET_StgMutArrPtrs_ptrs dflags mkBasicIndexedRead :: ByteOff -> Maybe MachOp -> CmmType -> LocalReg -> CmmExpr -> CmmExpr -> FCode () @@ -1042,7 +1041,7 @@ doCopyArrayOp = emitCopyArray copy -- they're of different types) copy _src _dst dst_p src_p bytes = do dflags <- getDynFlags - emitMemcpyCall dst_p src_p bytes (mkIntExpr dflags wORD_SIZE) + emitMemcpyCall dst_p src_p bytes (mkIntExpr dflags (wORD_SIZE dflags)) -- | Takes a source 'MutableArray#', an offset in the source array, a @@ -1059,8 +1058,8 @@ doCopyMutableArrayOp = emitCopyArray copy copy src dst dst_p src_p bytes = do dflags <- getDynFlags [moveCall, cpyCall] <- forkAlts [ - getCode $ emitMemmoveCall dst_p src_p bytes (mkIntExpr dflags wORD_SIZE), - getCode $ emitMemcpyCall dst_p src_p bytes (mkIntExpr dflags wORD_SIZE) + getCode $ emitMemmoveCall dst_p src_p bytes (mkIntExpr dflags (wORD_SIZE dflags)), + getCode $ emitMemcpyCall dst_p src_p bytes (mkIntExpr dflags (wORD_SIZE dflags)) ] emit =<< mkCmmIfThenElse (cmmEqWord dflags src dst) moveCall cpyCall @@ -1083,7 +1082,7 @@ emitCopyArray copy src0 src_off0 dst0 dst_off0 n0 = do dst_elems_p <- assignTempE $ cmmOffsetB dflags dst (arrPtrsHdrSize dflags) dst_p <- assignTempE $ cmmOffsetExprW dflags dst_elems_p dst_off src_p <- assignTempE $ cmmOffsetExprW dflags (cmmOffsetB dflags src (arrPtrsHdrSize dflags)) src_off - bytes <- assignTempE $ cmmMulWord dflags n (mkIntExpr dflags wORD_SIZE) + bytes <- assignTempE $ cmmMulWord dflags n (mkIntExpr dflags (wORD_SIZE dflags)) copy src dst dst_p src_p bytes @@ -1101,7 +1100,7 @@ emitCloneArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> CmmExpr emitCloneArray info_p res_r src0 src_off0 n0 = do dflags <- getDynFlags let arrPtrsHdrSizeW dflags = mkIntExpr dflags (fixedHdrSize dflags + - (sIZEOF_StgMutArrPtrs_NoHdr dflags `div` wORD_SIZE)) + (sIZEOF_StgMutArrPtrs_NoHdr dflags `div` wORD_SIZE dflags)) myCapability = cmmSubWord dflags (CmmReg baseReg) (mkIntExpr dflags (oFFSET_Capability_r dflags)) -- Passed as arguments (be careful) src <- assignTempE src0 @@ -1119,21 +1118,21 @@ emitCloneArray info_p res_r src0 src_off0 n0 = do let arr = CmmReg (CmmLocal arr_r) emitSetDynHdr arr (CmmLit (CmmLabel info_p)) curCCS - emit $ mkStore (cmmOffsetB dflags arr (fixedHdrSize dflags * wORD_SIZE + + emit $ mkStore (cmmOffsetB dflags arr (fixedHdrSize dflags * wORD_SIZE dflags + oFFSET_StgMutArrPtrs_ptrs dflags)) n - emit $ mkStore (cmmOffsetB dflags arr (fixedHdrSize dflags * wORD_SIZE + + emit $ mkStore (cmmOffsetB dflags arr (fixedHdrSize dflags * wORD_SIZE dflags + oFFSET_StgMutArrPtrs_size dflags)) size dst_p <- assignTempE $ cmmOffsetB dflags arr (arrPtrsHdrSize dflags) src_p <- assignTempE $ cmmOffsetExprW dflags (cmmOffsetB dflags src (arrPtrsHdrSize dflags)) src_off - emitMemcpyCall dst_p src_p (cmmMulWord dflags n (wordSize dflags)) (mkIntExpr dflags wORD_SIZE) + emitMemcpyCall dst_p src_p (cmmMulWord dflags n (wordSize dflags)) (mkIntExpr dflags (wORD_SIZE dflags)) emitMemsetCall (cmmOffsetExprW dflags dst_p n) (mkIntExpr dflags 1) card_bytes - (mkIntExpr dflags wORD_SIZE) + (mkIntExpr dflags (wORD_SIZE dflags)) emit $ mkAssign (CmmLocal res_r) arr -- | Takes and offset in the destination array, the base address of @@ -1157,11 +1156,11 @@ cardRoundUp :: DynFlags -> CmmExpr -> CmmExpr cardRoundUp dflags i = card dflags (cmmAddWord dflags i (mkIntExpr dflags ((1 `shiftL` mUT_ARR_PTRS_CARD_BITS dflags) - 1))) bytesToWordsRoundUp :: DynFlags -> CmmExpr -> CmmExpr -bytesToWordsRoundUp dflags e = cmmQuotWord dflags (cmmAddWord dflags e (mkIntExpr dflags (wORD_SIZE - 1))) +bytesToWordsRoundUp dflags e = cmmQuotWord dflags (cmmAddWord dflags e (mkIntExpr dflags (wORD_SIZE dflags - 1))) (wordSize dflags) wordSize :: DynFlags -> CmmExpr -wordSize dflags = mkIntExpr dflags wORD_SIZE +wordSize dflags = mkIntExpr dflags (wORD_SIZE dflags) -- | Emit a call to @memcpy@. emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode () diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs index d5fa9d73a1..e6e9899040 100644 --- a/compiler/codeGen/StgCmmProf.hs +++ b/compiler/codeGen/StgCmmProf.hs @@ -54,7 +54,6 @@ import CostCentre import DynFlags import FastString import Module -import Constants -- Lots of field offsets import Outputable import Control.Monad @@ -263,7 +262,7 @@ emitCostCentreStackDecl ccs do dflags <- getDynFlags let mk_lits cc = zero dflags : mkCCostCentre cc : - replicate (sizeof_ccs_words - 2) (zero dflags) + replicate (sizeof_ccs_words dflags - 2) (zero dflags) -- Note: to avoid making any assumptions about how the -- C compiler (that compiles the RTS, in particular) does -- layouts of structs containing long-longs, simply @@ -277,13 +276,13 @@ zero dflags = mkIntCLit dflags 0 zero64 :: CmmLit zero64 = CmmInt 0 W64 -sizeof_ccs_words :: Int -sizeof_ccs_words +sizeof_ccs_words :: DynFlags -> Int +sizeof_ccs_words dflags -- round up to the next word. | ms == 0 = ws | otherwise = ws + 1 where - (ws,ms) = SIZEOF_CostCentreStack `divMod` wORD_SIZE + (ws,ms) = SIZEOF_CostCentreStack `divMod` wORD_SIZE dflags -- --------------------------------------------------------------------------- -- Set the current cost centre stack @@ -348,8 +347,8 @@ ldvRecordCreate closure = do dflags <- getDynFlags -- ldvEnterClosure :: ClosureInfo -> FCode () ldvEnterClosure closure_info = do dflags <- getDynFlags + let tag = funTag dflags closure_info ldvEnter (cmmOffsetB dflags (CmmReg nodeReg) (-tag)) - where tag = funTag closure_info -- don't forget to substract node's tag ldvEnter :: CmmExpr -> FCode () diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs index 52bd114b5d..4471b78151 100644 --- a/compiler/codeGen/StgCmmUtils.hs +++ b/compiler/codeGen/StgCmmUtils.hs @@ -57,7 +57,6 @@ import ForeignCall import IdInfo import Type import TyCon -import Constants import SMRep import Module import Literal @@ -150,7 +149,7 @@ mkTaggedObjectLoad dflags reg base offset tag = mkAssign (CmmLocal reg) (CmmLoad (cmmOffsetB dflags (CmmReg (CmmLocal base)) - (wORD_SIZE*offset - tag)) + (wORD_SIZE dflags * offset - tag)) (localRegType reg)) ------------------------------------------------------------------------- |