diff options
Diffstat (limited to 'compiler/codeGen')
-rw-r--r-- | compiler/codeGen/CgPrimOp.hs | 36 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmPrim.hs | 33 |
2 files changed, 43 insertions, 26 deletions
diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs index a2e50e0c0d..c128cb7f79 100644 --- a/compiler/codeGen/CgPrimOp.hs +++ b/compiler/codeGen/CgPrimOp.hs @@ -34,6 +34,7 @@ import DynFlags import FastString import Control.Monad +import Data.Bits -- --------------------------------------------------------------------------- -- Code generation for PrimOps @@ -843,8 +844,7 @@ doWritePtrArrayOp addr idx val cmmOffsetExpr (cmmOffsetExprW (cmmOffsetB addr (arrPtrsHdrSize dflags)) (loadArrPtrsSize dflags addr)) - (CmmMachOp mo_wordUShr [idx, - CmmLit (mkIntCLit mUT_ARR_PTRS_CARD_BITS)]) + (card idx) ) (CmmLit (CmmInt 1 W8)) loadArrPtrsSize :: DynFlags -> CmmExpr -> CmmExpr @@ -1020,10 +1020,8 @@ emitCloneArray info_p res_r src0 src_off0 n0 live = do src_off <- assignTemp_ src_off0 n <- assignTemp_ n0 - card_words <- assignTemp $ (n `cmmUShrWord` - (CmmLit (mkIntCLit mUT_ARR_PTRS_CARD_BITS))) - `cmmAddWord` CmmLit (mkIntCLit 1) - size <- assignTemp $ n `cmmAddWord` card_words + card_bytes <- assignTemp $ cardRoundUp n + size <- assignTemp $ n `cmmAddWord` bytesToWordsRoundUp card_bytes words <- assignTemp $ arrPtrsHdrSizeW dflags `cmmAddWord` size arr_r <- newTemp bWord @@ -1047,14 +1045,13 @@ emitCloneArray info_p res_r src0 src_off0 n0 live = do emitMemsetCall (cmmOffsetExprW dst_p n) (CmmLit (mkIntCLit 1)) - (card_words `cmmMulWord` wordSize) + card_bytes (CmmLit (mkIntCLit wORD_SIZE)) live stmtC $ CmmAssign (CmmLocal res_r) arr where arrPtrsHdrSizeW dflags = CmmLit $ mkIntCLit $ fixedHdrSize dflags + (sIZEOF_StgMutArrPtrs_NoHdr `div` wORD_SIZE) - wordSize = CmmLit (mkIntCLit wORD_SIZE) myCapability = CmmReg baseReg `cmmSubWord` CmmLit (mkIntCLit oFFSET_Capability_r) @@ -1066,13 +1063,24 @@ emitSetCards dst_start dst_cards_start n live = do start_card <- assignTemp $ card dst_start emitMemsetCall (dst_cards_start `cmmAddWord` start_card) (CmmLit (mkIntCLit 1)) - ((card (dst_start `cmmAddWord` n) `cmmSubWord` start_card) - `cmmAddWord` CmmLit (mkIntCLit 1)) - (CmmLit (mkIntCLit wORD_SIZE)) + (cardRoundUp n) + (CmmLit (mkIntCLit 1)) -- no alignment (1 byte) live - where - -- Convert an element index to a card index - card i = i `cmmUShrWord` (CmmLit (mkIntCLit mUT_ARR_PTRS_CARD_BITS)) + +-- Convert an element index to a card index +card :: CmmExpr -> CmmExpr +card i = i `cmmUShrWord` (CmmLit (mkIntCLit 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)))) + +bytesToWordsRoundUp :: CmmExpr -> CmmExpr +bytesToWordsRoundUp e = (e `cmmAddWord` CmmLit (mkIntCLit (wORD_SIZE - 1))) + `cmmQuotWord` wordSize + +wordSize :: CmmExpr +wordSize = CmmLit (mkIntCLit wORD_SIZE) -- | Emit a call to @memcpy@. emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> StgLiveVars diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index d9585c6d61..b4b67491eb 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -49,6 +49,7 @@ import Outputable import Util import Control.Monad (liftM) +import Data.Bits ------------------------------------------------------------------------ -- Primitive operations and foreign calls @@ -1095,10 +1096,8 @@ emitCloneArray info_p res_r src0 src_off0 n0 = do src_off <- assignTempE src_off0 n <- assignTempE n0 - card_words <- assignTempE $ (n `cmmUShrWord` - (CmmLit (mkIntCLit mUT_ARR_PTRS_CARD_BITS))) - `cmmAddWord` CmmLit (mkIntCLit 1) - size <- assignTempE $ n `cmmAddWord` card_words + card_bytes <- assignTempE $ cardRoundUp n + size <- assignTempE $ n `cmmAddWord` bytesToWordsRoundUp card_bytes dflags <- getDynFlags words <- assignTempE $ arrPtrsHdrSizeW dflags `cmmAddWord` size @@ -1122,13 +1121,12 @@ emitCloneArray info_p res_r src0 src_off0 n0 = do emitMemsetCall (cmmOffsetExprW dst_p n) (CmmLit (mkIntCLit 1)) - (card_words `cmmMulWord` wordSize) + card_bytes (CmmLit (mkIntCLit wORD_SIZE)) emit $ mkAssign (CmmLocal res_r) arr where arrPtrsHdrSizeW dflags = CmmLit $ mkIntCLit $ fixedHdrSize dflags + (sIZEOF_StgMutArrPtrs_NoHdr `div` wORD_SIZE) - wordSize = CmmLit (mkIntCLit wORD_SIZE) myCapability = CmmReg baseReg `cmmSubWord` CmmLit (mkIntCLit oFFSET_Capability_r) @@ -1140,12 +1138,23 @@ emitSetCards dst_start dst_cards_start n = do start_card <- assignTempE $ card dst_start emitMemsetCall (dst_cards_start `cmmAddWord` start_card) (CmmLit (mkIntCLit 1)) - ((card (dst_start `cmmAddWord` n) `cmmSubWord` start_card) - `cmmAddWord` CmmLit (mkIntCLit 1)) - (CmmLit (mkIntCLit wORD_SIZE)) - where - -- Convert an element index to a card index - card i = i `cmmUShrWord` (CmmLit (mkIntCLit mUT_ARR_PTRS_CARD_BITS)) + (cardRoundUp n) + (CmmLit (mkIntCLit 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)) + +-- 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)))) + +bytesToWordsRoundUp :: CmmExpr -> CmmExpr +bytesToWordsRoundUp e = (e `cmmAddWord` CmmLit (mkIntCLit (wORD_SIZE - 1))) + `cmmQuotWord` wordSize + +wordSize :: CmmExpr +wordSize = CmmLit (mkIntCLit wORD_SIZE) -- | Emit a call to @memcpy@. emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode () |