diff options
author | Simon Marlow <marlowsd@gmail.com> | 2012-08-28 16:09:50 +0100 |
---|---|---|
committer | Simon Marlow <marlowsd@gmail.com> | 2012-08-31 16:43:58 +0100 |
commit | de3a8f7631b5276c30c90a256e8135a8ff3095e7 (patch) | |
tree | 4c90507007f4ead15548f2002a0ff5d237f95a6e /compiler | |
parent | 8aabe8d06f7202c9a6cd1133e0b1ebc81338eed9 (diff) | |
download | haskell-de3a8f7631b5276c30c90a256e8135a8ff3095e7.tar.gz |
Cleanup: add mkIntExpr and zeroExpr utils
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/cmm/CmmExpr.hs | 2 | ||||
-rw-r--r-- | compiler/cmm/CmmLayoutStack.hs | 6 | ||||
-rw-r--r-- | compiler/cmm/CmmUtils.hs | 23 | ||||
-rw-r--r-- | compiler/codeGen/CgClosure.lhs | 8 | ||||
-rw-r--r-- | compiler/codeGen/CgForeignCall.hs | 2 | ||||
-rw-r--r-- | compiler/codeGen/CgHeapery.lhs | 12 | ||||
-rw-r--r-- | compiler/codeGen/CgPrimOp.hs | 4 | ||||
-rw-r--r-- | compiler/codeGen/CgProf.hs | 6 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmBind.hs | 2 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmForeign.hs | 2 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmHeap.hs | 2 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmPrim.hs | 51 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmProf.hs | 6 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmTicky.hs | 4 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmUtils.hs | 8 |
15 files changed, 72 insertions, 66 deletions
diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs index a6b9b11e5f..e57c6eca4c 100644 --- a/compiler/cmm/CmmExpr.hs +++ b/compiler/cmm/CmmExpr.hs @@ -62,7 +62,7 @@ instance Eq CmmExpr where -- Equality ignores the types CmmStackSlot a1 i1 == CmmStackSlot a2 i2 = a1==a2 && i1==i2 _e1 == _e2 = False -data CmmReg +data CmmReg = CmmLocal {-# UNPACK #-} !LocalReg | CmmGlobal GlobalReg deriving( Eq, Ord ) diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs index 98008d5d0d..49a0176b45 100644 --- a/compiler/cmm/CmmLayoutStack.hs +++ b/compiler/cmm/CmmLayoutStack.hs @@ -773,12 +773,12 @@ arguments. areaToSp :: ByteOff -> ByteOff -> (Area -> StackLoc) -> CmmExpr -> CmmExpr areaToSp sp_old _sp_hwm area_off (CmmStackSlot area n) = cmmOffset (CmmReg spReg) (sp_old - area_off area - n) -areaToSp _ sp_hwm _ (CmmLit CmmHighStackMark) = CmmLit (mkIntCLit sp_hwm) +areaToSp _ sp_hwm _ (CmmLit CmmHighStackMark) = mkIntExpr sp_hwm areaToSp _ _ _ (CmmMachOp (MO_U_Lt _) -- Note [null stack check] [CmmMachOp (MO_Sub _) [ CmmReg (CmmGlobal Sp) , CmmLit (CmmInt 0 _)], - CmmReg (CmmGlobal SpLim)]) = CmmLit (CmmInt 0 wordWidth) + CmmReg (CmmGlobal SpLim)]) = zeroExpr areaToSp _ _ _ other = other -- ----------------------------------------------------------------------------- @@ -968,7 +968,7 @@ callSuspendThread id intrbl = CmmUnsafeForeignCall (ForeignTarget (foreignLbl (fsLit "suspendThread")) (ForeignConvention CCallConv [AddrHint, NoHint] [AddrHint])) - [id] [CmmReg (CmmGlobal BaseReg), CmmLit (mkIntCLit (fromEnum intrbl))] + [id] [CmmReg (CmmGlobal BaseReg), mkIntExpr (fromEnum intrbl)] callResumeThread :: LocalReg -> LocalReg -> CmmNode O O callResumeThread new_base id = diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs index 25129747be..93158848f3 100644 --- a/compiler/cmm/CmmUtils.hs +++ b/compiler/cmm/CmmUtils.hs @@ -24,13 +24,14 @@ module CmmUtils( typeCmmType, typeForeignHint, -- CmmLit - zeroCLit, mkIntCLit, + zeroCLit, mkIntCLit, mkWordCLit, packHalfWordsCLit, mkByteStringCLit, mkDataLits, mkRODataLits, -- CmmExpr - mkLblExpr, + mkIntExpr, zeroExpr, + mkLblExpr, cmmRegOff, cmmOffset, cmmLabelOff, cmmOffsetLit, cmmOffsetExpr, cmmRegOffB, cmmOffsetB, cmmLabelOffB, cmmOffsetLitB, cmmOffsetExprB, cmmRegOffW, cmmOffsetW, cmmLabelOffW, cmmOffsetLitW, cmmOffsetExprW, @@ -128,9 +129,15 @@ typeForeignHint = primRepForeignHint . typePrimRep mkIntCLit :: Int -> CmmLit mkIntCLit i = CmmInt (toInteger i) wordWidth +mkIntExpr :: Int -> CmmExpr +mkIntExpr i = CmmLit $! mkIntCLit i + zeroCLit :: CmmLit zeroCLit = CmmInt 0 wordWidth +zeroExpr :: CmmExpr +zeroExpr = CmmLit zeroCLit + mkByteStringCLit :: Unique -> [Word8] -> (CmmLit, GenCmmDecl CmmStatics info stmt) -- We have to make a top-level decl for the string, -- and return a literal pointing to it @@ -239,7 +246,7 @@ cmmIndexExpr width base idx = cmmOffsetExpr base byte_off where idx_w = cmmExprWidth idx - byte_off = CmmMachOp (MO_Shl idx_w) [idx, CmmLit (mkIntCLit (widthInLog width))] + byte_off = CmmMachOp (MO_Shl idx_w) [idx, mkIntExpr (widthInLog width)] cmmLoadIndex :: CmmType -> CmmExpr -> Int -> CmmExpr cmmLoadIndex ty expr ix = CmmLoad (cmmIndex (typeWidth ty) expr ix) ty @@ -299,6 +306,7 @@ cmmUShrWord e1 e2 = CmmMachOp mo_wordUShr [e1, e2] cmmAddWord e1 e2 = CmmMachOp mo_wordAdd [e1, e2] cmmSubWord e1 e2 = CmmMachOp mo_wordSub [e1, e2] cmmMulWord e1 e2 = CmmMachOp mo_wordMul [e1, e2] +cmmQuotWord e1 e2 = CmmMachOp mo_wordUQuot [e1, e2] cmmNegate :: CmmExpr -> CmmExpr cmmNegate (CmmLit (CmmInt n rep)) = CmmLit (CmmInt (-n) rep) @@ -306,7 +314,6 @@ cmmNegate e = CmmMachOp (MO_S_Neg (cmmExprWidth e)) [e] blankWord :: CmmStatic blankWord = CmmUninitialised wORD_SIZE -cmmQuotWord e1 e2 = CmmMachOp mo_wordUQuot [e1, e2] --------------------------------------------------- -- @@ -339,8 +346,8 @@ hasNoGlobalRegs _ = False -- Tag bits mask --cmmTagBits = CmmLit (mkIntCLit tAG_BITS) cmmTagMask, cmmPointerMask :: CmmExpr -cmmTagMask = CmmLit (mkIntCLit tAG_MASK) -cmmPointerMask = CmmLit (mkIntCLit (complement tAG_MASK)) +cmmTagMask = mkIntExpr tAG_MASK +cmmPointerMask = mkIntExpr (complement tAG_MASK) -- Used to untag a possibly tagged pointer -- A static label need not be untagged @@ -354,10 +361,10 @@ cmmGetTag e = (e `cmmAndWord` cmmTagMask) -- Test if a closure pointer is untagged cmmIsTagged :: CmmExpr -> CmmExpr cmmIsTagged e = (e `cmmAndWord` cmmTagMask) - `cmmNeWord` CmmLit zeroCLit + `cmmNeWord` zeroExpr cmmConstrTag, cmmConstrTag1 :: CmmExpr -> CmmExpr -cmmConstrTag e = (e `cmmAndWord` cmmTagMask) `cmmSubWord` (CmmLit (mkIntCLit 1)) +cmmConstrTag e = (e `cmmAndWord` cmmTagMask) `cmmSubWord` mkIntExpr 1 -- Get constructor tag, but one based. cmmConstrTag1 e = e `cmmAndWord` cmmTagMask diff --git a/compiler/codeGen/CgClosure.lhs b/compiler/codeGen/CgClosure.lhs index f1da2d4235..ede235a00a 100644 --- a/compiler/codeGen/CgClosure.lhs +++ b/compiler/codeGen/CgClosure.lhs @@ -323,7 +323,7 @@ mkFunEntryCode cl_info cc reg_args stk_args sp_top reg_save_code body = do { tickyEnterFun cl_info ; enterCostCentreFun cc (CmmMachOp mo_wordSub [ CmmReg nodeReg - , CmmLit (mkIntCLit (funTag cl_info)) ]) + , mkIntExpr (funTag cl_info) ]) (node : map snd reg_args) -- live regs ; cgExpr body } @@ -429,8 +429,8 @@ funWrapper closure_info arg_regs reg_save_code fun_body = do ; whenC (tag /= 0 && node_points) $ do l <- newLabelC stmtC (CmmCondBranch (CmmMachOp mo_wordEq [cmmGetTag (CmmReg nodeReg), - CmmLit (mkIntCLit tag)]) l) - stmtC (CmmStore (CmmLit (mkWordCLit 0)) (CmmLit (mkWordCLit 0))) + mkIntExpr tag)]) l) + stmtC (CmmStore (CmmLit (mkWordCLit 0)) (mkWordExpr 0)) labelC l -} @@ -598,7 +598,7 @@ link_caf cl_info _is_upd = do -- node is live, so save it. -- see Note [atomic CAF entry] in rts/sm/Storage.c - ; emitIf (CmmMachOp mo_wordEq [ CmmReg (CmmLocal ret), CmmLit zeroCLit]) $ + ; emitIf (CmmMachOp mo_wordEq [ CmmReg (CmmLocal ret), zeroExpr]) $ -- re-enter R1. Doing this directly is slightly dodgy; we're -- assuming lots of things, like the stack pointer hasn't -- moved since we entered the CAF. diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs index a37245ea01..801d8a31c6 100644 --- a/compiler/codeGen/CgForeignCall.hs +++ b/compiler/codeGen/CgForeignCall.hs @@ -263,7 +263,7 @@ emitOpenNursery = stmtsC [ (CmmMachOp mo_wordMul [ CmmMachOp (MO_SS_Conv W32 wordWidth) [CmmLoad nursery_bdescr_blocks b32], - CmmLit (mkIntCLit bLOCK_SIZE) + mkIntExpr bLOCK_SIZE ]) (-1) ) diff --git a/compiler/codeGen/CgHeapery.lhs b/compiler/codeGen/CgHeapery.lhs index 2ce37cf565..98d08f9ea1 100644 --- a/compiler/codeGen/CgHeapery.lhs +++ b/compiler/codeGen/CgHeapery.lhs @@ -462,8 +462,8 @@ do_checks _ hp _ _ _ "structures in the code."]) do_checks stk hp reg_save_code rts_lbl live - = do_checks' (CmmLit (mkIntCLit (stk*wORD_SIZE))) - (CmmLit (mkIntCLit (hp*wORD_SIZE))) + = do_checks' (mkIntExpr (stk*wORD_SIZE)) + (mkIntExpr (hp*wORD_SIZE)) (stk /= 0) (hp /= 0) reg_save_code rts_lbl live -- The offsets are now in *bytes* @@ -528,7 +528,7 @@ hpChkGen :: CmmExpr -> CmmExpr -> CmmExpr -> Code hpChkGen bytes liveness reentry = do dflags <- getDynFlags let platform = targetPlatform dflags - do_checks' (CmmLit (mkIntCLit 0)) bytes False True assigns + do_checks' zeroExpr bytes False True assigns stg_gc_gen (Just (activeStgRegs platform)) where assigns = mkStmts [ mk_vanilla_assignment 9 liveness, @@ -538,7 +538,7 @@ hpChkGen bytes liveness reentry -- we want to assign to Sp[0] on failure (used in AutoApply.cmm:BUILD_PAP). hpChkNodePointsAssignSp0 :: CmmExpr -> CmmExpr -> Code hpChkNodePointsAssignSp0 bytes sp0 - = do_checks' (CmmLit (mkIntCLit 0)) bytes False True assign + = do_checks' zeroExpr bytes False True assign stg_gc_enter1 (Just [node]) where assign = oneStmt (CmmStore (CmmReg spReg) sp0) @@ -546,7 +546,7 @@ stkChkGen :: CmmExpr -> CmmExpr -> CmmExpr -> Code stkChkGen bytes liveness reentry = do dflags <- getDynFlags let platform = targetPlatform dflags - do_checks' bytes (CmmLit (mkIntCLit 0)) True False assigns + do_checks' bytes zeroExpr True False assigns stg_gc_gen (Just (activeStgRegs platform)) where assigns = mkStmts [ mk_vanilla_assignment 9 liveness, @@ -558,7 +558,7 @@ mk_vanilla_assignment n e stkChkNodePoints :: CmmExpr -> Code stkChkNodePoints bytes - = do_checks' bytes (CmmLit (mkIntCLit 0)) True False noStmts + = do_checks' bytes zeroExpr True False noStmts stg_gc_enter1 (Just [node]) stg_gc_gen :: CmmExpr diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs index c128cb7f79..0c8fb1a89a 100644 --- a/compiler/codeGen/CgPrimOp.hs +++ b/compiler/codeGen/CgPrimOp.hs @@ -89,7 +89,7 @@ emitPrimOp [res_r,res_c] IntAddCOp [aa,bb] _ CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]], CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)] ], - CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1)) + mkIntExpr (wORD_SIZE_IN_BITS - 1) ] ] @@ -112,7 +112,7 @@ emitPrimOp [res_r,res_c] IntSubCOp [aa,bb] _ CmmMachOp mo_wordXor [aa,bb], CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)] ], - CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1)) + mkIntExpr (wORD_SIZE_IN_BITS - 1) ] ] diff --git a/compiler/codeGen/CgProf.hs b/compiler/codeGen/CgProf.hs index 2eccae7926..c5f1afa68e 100644 --- a/compiler/codeGen/CgProf.hs +++ b/compiler/codeGen/CgProf.hs @@ -108,7 +108,7 @@ profDynAlloc :: ClosureInfo -> CmmExpr -> Code profDynAlloc cl_info ccs = ifProfiling $ do dflags <- getDynFlags - profAlloc (CmmLit (mkIntCLit (closureSize dflags cl_info))) ccs + profAlloc (mkIntExpr (closureSize dflags cl_info)) ccs -- | Record the allocation of a closure (size is given by a CmmExpr) -- The size must be in words, because the allocation counter in a CCS counts @@ -124,7 +124,7 @@ profAlloc words ccs (cmmOffsetB ccs oFFSET_CostCentreStack_mem_alloc) (CmmMachOp (MO_UU_Conv wordWidth alloc_rep) $ [CmmMachOp mo_wordSub [words, - CmmLit (mkIntCLit (profHdrSize dflags))]])) + mkIntExpr (profHdrSize dflags)]])) -- subtract the "profiling overhead", which is the -- profiling header in a closure. where @@ -266,7 +266,7 @@ staticLdvInit = zeroCLit dynLdvInit :: CmmExpr dynLdvInit = -- (era << LDV_SHIFT) | LDV_STATE_CREATE CmmMachOp mo_wordOr [ - CmmMachOp mo_wordShl [loadEra, CmmLit (mkIntCLit lDV_SHIFT) ], + CmmMachOp mo_wordShl [loadEra, mkIntExpr lDV_SHIFT ], CmmLit (mkWordCLit lDV_STATE_CREATE) ] diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index 0f0bfb8467..04799a7f0b 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -459,7 +459,7 @@ closureCodeBody top_lvl bndr cl_info cc args arity body fv_details ; enterCostCentreFun cc (CmmMachOp mo_wordSub [ CmmReg nodeReg - , CmmLit (mkIntCLit (funTag cl_info)) ]) + , mkIntExpr (funTag cl_info) ]) ; whenC node_points (ldvEnterClosure cl_info) ; granYield arg_regs node_points diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs index 5a717bbc65..cdedd1243c 100644 --- a/compiler/codeGen/StgCmmForeign.hs +++ b/compiler/codeGen/StgCmmForeign.hs @@ -339,7 +339,7 @@ openNursery = catAGraphs [ (CmmMachOp mo_wordMul [ CmmMachOp (MO_SS_Conv W32 wordWidth) [CmmLoad nursery_bdescr_blocks b32], - CmmLit (mkIntCLit bLOCK_SIZE) + mkIntExpr bLOCK_SIZE ]) (-1) ) diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index 12f3b1347e..b82064e0ec 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -559,7 +559,7 @@ do_checks checkStack alloc do_gc = do -- with slop at the end of the current block, which can -- confuse the LDV profiler. where - alloc_lit = CmmLit (mkIntCLit (alloc*wORD_SIZE)) -- Bytes + alloc_lit = mkIntExpr (alloc*wORD_SIZE) -- Bytes bump_hp = cmmOffsetExprB (CmmReg hpReg) alloc_lit -- Sp overflow if (Sp - CmmHighStack < SpLim) diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index b4b67491eb..3a7a456082 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -182,7 +182,7 @@ emitPrimOp [res_r,res_c] IntAddCOp [aa,bb] CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]], CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)] ], - CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1)) + mkIntExpr (wORD_SIZE_IN_BITS - 1) ] ] @@ -205,7 +205,7 @@ emitPrimOp [res_r,res_c] IntSubCOp [aa,bb] CmmMachOp mo_wordXor [aa,bb], CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)] ], - CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1)) + mkIntExpr (wORD_SIZE_IN_BITS - 1) ] ] @@ -913,7 +913,7 @@ doWritePtrArrayOp addr idx val (cmmOffsetExprW (cmmOffsetB addr (arrPtrsHdrSize dflags)) (loadArrPtrsSize dflags addr)) (CmmMachOp mo_wordUShr [idx, - CmmLit (mkIntCLit mUT_ARR_PTRS_CARD_BITS)]) + mkIntExpr mUT_ARR_PTRS_CARD_BITS]) ) (CmmLit (CmmInt 1 W8)) loadArrPtrsSize :: DynFlags -> CmmExpr -> CmmExpr @@ -963,7 +963,7 @@ doCopyByteArrayOp = emitCopyByteArray copy -- Copy data (we assume the arrays aren't overlapping since -- they're of different types) copy _src _dst dst_p src_p bytes = - emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit 1)) + emitMemcpyCall dst_p src_p bytes (mkIntExpr 1) -- | Takes a source 'MutableByteArray#', an offset in the source -- array, a destination 'MutableByteArray#', an offset into the @@ -979,8 +979,8 @@ doCopyMutableByteArrayOp = emitCopyByteArray copy -- TODO: Optimize branch for common case of no aliasing. copy src dst dst_p src_p bytes = do [moveCall, cpyCall] <- forkAlts [ - getCode $ emitMemmoveCall dst_p src_p bytes (CmmLit (mkIntCLit 1)), - getCode $ emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit 1)) + getCode $ emitMemmoveCall dst_p src_p bytes (mkIntExpr 1), + getCode $ emitMemcpyCall dst_p src_p bytes (mkIntExpr 1) ] emit =<< mkCmmIfThenElse (cmmEqWord src dst) moveCall cpyCall @@ -1005,7 +1005,7 @@ doSetByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr doSetByteArrayOp ba off len c = do dflags <- getDynFlags p <- assignTempE $ cmmOffsetExpr (cmmOffsetB ba (arrWordsHdrSize dflags)) off - emitMemsetCall p c len (CmmLit (mkIntCLit 1)) + emitMemsetCall p c len (mkIntExpr 1) -- ---------------------------------------------------------------------------- -- Copying pointer arrays @@ -1035,7 +1035,7 @@ doCopyArrayOp = emitCopyArray copy -- Copy data (we assume the arrays aren't overlapping since -- they're of different types) copy _src _dst dst_p src_p bytes = - emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit wORD_SIZE)) + emitMemcpyCall dst_p src_p bytes (mkIntExpr wORD_SIZE) -- | Takes a source 'MutableArray#', an offset in the source array, a @@ -1051,8 +1051,8 @@ doCopyMutableArrayOp = emitCopyArray copy -- TODO: Optimize branch for common case of no aliasing. copy src dst dst_p src_p bytes = do [moveCall, cpyCall] <- forkAlts [ - getCode $ emitMemmoveCall dst_p src_p bytes (CmmLit (mkIntCLit wORD_SIZE)), - getCode $ emitMemcpyCall dst_p src_p bytes (CmmLit (mkIntCLit wORD_SIZE)) + getCode $ emitMemmoveCall dst_p src_p bytes (mkIntExpr wORD_SIZE), + getCode $ emitMemcpyCall dst_p src_p bytes (mkIntExpr wORD_SIZE) ] emit =<< mkCmmIfThenElse (cmmEqWord src dst) moveCall cpyCall @@ -1075,7 +1075,7 @@ emitCopyArray copy src0 src_off0 dst0 dst_off0 n0 = do dst_elems_p <- assignTempE $ cmmOffsetB dst (arrPtrsHdrSize dflags) dst_p <- assignTempE $ cmmOffsetExprW dst_elems_p dst_off src_p <- assignTempE $ cmmOffsetExprW (cmmOffsetB src (arrPtrsHdrSize dflags)) src_off - bytes <- assignTempE $ cmmMulWord n (CmmLit (mkIntCLit wORD_SIZE)) + bytes <- assignTempE $ cmmMulWord n (mkIntExpr wORD_SIZE) copy src dst dst_p src_p bytes @@ -1103,8 +1103,8 @@ emitCloneArray info_p res_r src0 src_off0 n0 = do arr_r <- newTemp bWord emitAllocateCall arr_r myCapability words - tickyAllocPrim (CmmLit (mkIntCLit (arrPtrsHdrSize dflags))) (n `cmmMulWord` wordSize) - (CmmLit $ mkIntCLit 0) + tickyAllocPrim (mkIntExpr (arrPtrsHdrSize dflags)) (n `cmmMulWord` wordSize) + zeroExpr let arr = CmmReg (CmmLocal arr_r) emitSetDynHdr arr (CmmLit (CmmLabel info_p)) curCCS @@ -1117,18 +1117,17 @@ emitCloneArray info_p res_r src0 src_off0 n0 = do src_p <- assignTempE $ cmmOffsetExprW (cmmOffsetB src (arrPtrsHdrSize dflags)) src_off - emitMemcpyCall dst_p src_p (n `cmmMulWord` wordSize) (CmmLit (mkIntCLit wORD_SIZE)) + emitMemcpyCall dst_p src_p (n `cmmMulWord` wordSize) (mkIntExpr wORD_SIZE) emitMemsetCall (cmmOffsetExprW dst_p n) - (CmmLit (mkIntCLit 1)) + (mkIntExpr 1) card_bytes - (CmmLit (mkIntCLit wORD_SIZE)) + (mkIntExpr wORD_SIZE) emit $ mkAssign (CmmLocal res_r) arr where - arrPtrsHdrSizeW dflags = CmmLit $ mkIntCLit $ fixedHdrSize dflags + - (sIZEOF_StgMutArrPtrs_NoHdr `div` wORD_SIZE) - myCapability = CmmReg baseReg `cmmSubWord` - CmmLit (mkIntCLit oFFSET_Capability_r) + arrPtrsHdrSizeW dflags = mkIntExpr (fixedHdrSize dflags + + (sIZEOF_StgMutArrPtrs_NoHdr `div` wORD_SIZE)) + myCapability = CmmReg baseReg `cmmSubWord` mkIntExpr oFFSET_Capability_r -- | Takes and offset in the destination array, the base address of -- the card table, and the number of elements affected (*not* the @@ -1137,24 +1136,24 @@ emitSetCards :: CmmExpr -> CmmExpr -> CmmExpr -> FCode () emitSetCards dst_start dst_cards_start n = do start_card <- assignTempE $ card dst_start emitMemsetCall (dst_cards_start `cmmAddWord` start_card) - (CmmLit (mkIntCLit 1)) + (mkIntExpr 1) (cardRoundUp n) - (CmmLit (mkIntCLit 1)) -- no alignment (1 byte) + (mkIntExpr 1) -- no alignment (1 byte) -- Convert an element index to a card index card :: CmmExpr -> CmmExpr -card i = i `cmmUShrWord` (CmmLit (mkIntCLit mUT_ARR_PTRS_CARD_BITS)) +card i = i `cmmUShrWord` mkIntExpr mUT_ARR_PTRS_CARD_BITS -- Convert a number of elements to a number of cards, rounding up cardRoundUp :: CmmExpr -> CmmExpr -cardRoundUp i = card (i `cmmAddWord` (CmmLit (mkIntCLit ((1 `shiftL` mUT_ARR_PTRS_CARD_BITS) - 1)))) +cardRoundUp i = card (i `cmmAddWord` (mkIntExpr ((1 `shiftL` mUT_ARR_PTRS_CARD_BITS) - 1))) bytesToWordsRoundUp :: CmmExpr -> CmmExpr -bytesToWordsRoundUp e = (e `cmmAddWord` CmmLit (mkIntCLit (wORD_SIZE - 1))) +bytesToWordsRoundUp e = (e `cmmAddWord` mkIntExpr (wORD_SIZE - 1)) `cmmQuotWord` wordSize wordSize :: CmmExpr -wordSize = CmmLit (mkIntCLit wORD_SIZE) +wordSize = mkIntExpr wORD_SIZE -- | Emit a call to @memcpy@. emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode () diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs index 56c02d040f..7f677d5969 100644 --- a/compiler/codeGen/StgCmmProf.hs +++ b/compiler/codeGen/StgCmmProf.hs @@ -163,7 +163,7 @@ profDynAlloc :: SMRep -> CmmExpr -> FCode () profDynAlloc rep ccs = ifProfiling $ do dflags <- getDynFlags - profAlloc (CmmLit (mkIntCLit (heapClosureSize dflags rep))) ccs + profAlloc (mkIntExpr (heapClosureSize dflags rep)) ccs -- | Record the allocation of a closure (size is given by a CmmExpr) -- The size must be in words, because the allocation counter in a CCS counts @@ -176,7 +176,7 @@ profAlloc words ccs (cmmOffsetB ccs oFFSET_CostCentreStack_mem_alloc) (CmmMachOp (MO_UU_Conv wordWidth (typeWidth alloc_rep)) $ [CmmMachOp mo_wordSub [words, - CmmLit (mkIntCLit (profHdrSize dflags))]])) + mkIntExpr (profHdrSize dflags)]])) -- subtract the "profiling overhead", which is the -- profiling header in a closure. where @@ -324,7 +324,7 @@ staticLdvInit = zeroCLit dynLdvInit :: CmmExpr dynLdvInit = -- (era << LDV_SHIFT) | LDV_STATE_CREATE CmmMachOp mo_wordOr [ - CmmMachOp mo_wordShl [loadEra, CmmLit (mkIntCLit lDV_SHIFT) ], + CmmMachOp mo_wordShl [loadEra, mkIntExpr lDV_SHIFT ], CmmLit (mkWordCLit lDV_STATE_CREATE) ] diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs index ec8f674555..585d6b08eb 100644 --- a/compiler/codeGen/StgCmmTicky.hs +++ b/compiler/codeGen/StgCmmTicky.hs @@ -186,14 +186,14 @@ registerTickyCtr ctr_lbl test = CmmMachOp (MO_Eq wordWidth) [CmmLoad (CmmLit (cmmLabelOffB ctr_lbl oFFSET_StgEntCounter_registeredp)) bWord, - CmmLit (mkIntCLit 0)] + zeroExpr] register_stmts = [ mkStore (CmmLit (cmmLabelOffB ctr_lbl oFFSET_StgEntCounter_link)) (CmmLoad ticky_entry_ctrs bWord) , mkStore ticky_entry_ctrs (mkLblExpr ctr_lbl) , mkStore (CmmLit (cmmLabelOffB ctr_lbl oFFSET_StgEntCounter_registeredp)) - (CmmLit (mkIntCLit 1)) ] + (mkIntExpr 1) ] ticky_entry_ctrs = mkLblExpr (mkCmmDataLabel rtsPackageId (fsLit "ticky_entry_ctrs")) tickyReturnOldCon, tickyReturnNewCon :: RepArity -> FCode () diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs index 100d821cb0..8cb0ee89be 100644 --- a/compiler/codeGen/StgCmmUtils.hs +++ b/compiler/codeGen/StgCmmUtils.hs @@ -512,7 +512,7 @@ mk_switch _tag_expr [(_tag,lbl)] Nothing _ _ _ mk_switch tag_expr [(tag,lbl)] (Just deflt) _ _ _ = return (mkCbranch cond deflt lbl) where - cond = cmmNeWord tag_expr (CmmLit (mkIntCLit tag)) + cond = cmmNeWord tag_expr (mkIntExpr tag) -- We have lo_tag < hi_tag, but there's only one branch, -- so there must be a default @@ -550,7 +550,7 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C = do stmts <- mk_switch tag_expr branches mb_deflt lowest_branch hi_tag via_C mkCmmIfThenElse - (cmmULtWord tag_expr (CmmLit (mkIntCLit lowest_branch))) + (cmmULtWord tag_expr (mkIntExpr lowest_branch)) (mkBranch deflt) stmts @@ -558,7 +558,7 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C = do stmts <- mk_switch tag_expr branches mb_deflt lo_tag highest_branch via_C mkCmmIfThenElse - (cmmUGtWord tag_expr (CmmLit (mkIntCLit highest_branch))) + (cmmUGtWord tag_expr (mkIntExpr highest_branch)) (mkBranch deflt) stmts @@ -568,7 +568,7 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C hi_stmts <- mk_switch tag_expr hi_branches mb_deflt mid_tag hi_tag via_C mkCmmIfThenElse - (cmmUGeWord tag_expr (CmmLit (mkIntCLit mid_tag))) + (cmmUGeWord tag_expr (mkIntExpr mid_tag)) hi_stmts lo_stmts -- we test (e >= mid_tag) rather than (e < mid_tag), because |