Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/8aabe8d06f7202c9a6cd1133e0b1ebc81338eed9 >--------------------------------------------------------------- commit 8aabe8d06f7202c9a6cd1133e0b1ebc81338eed9 Author: Simon Marlow <[email protected]> Date: Tue Aug 28 15:52:38 2012 +0100 Fix fencepost and byte/word bugs in cloneArray/copyArray (#7185) >--------------------------------------------------------------- compiler/cmm/CmmUtils.hs | 5 +++-- compiler/codeGen/CgPrimOp.hs | 36 ++++++++++++++++++++++-------------- compiler/codeGen/StgCmmPrim.hs | 33 +++++++++++++++++++++------------ 3 files changed, 46 insertions(+), 28 deletions(-) diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs index 615e2fd..2512974 100644 --- a/compiler/cmm/CmmUtils.hs +++ b/compiler/cmm/CmmUtils.hs @@ -38,7 +38,7 @@ module CmmUtils( cmmNegate, cmmULtWord, cmmUGeWord, cmmUGtWord, cmmSubWord, cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord, - cmmUShrWord, cmmAddWord, cmmMulWord, + cmmUShrWord, cmmAddWord, cmmMulWord, cmmQuotWord, isTrivialCmmExpr, hasNoGlobalRegs, @@ -285,7 +285,7 @@ cmmLoadIndexW base off ty = CmmLoad (cmmOffsetW base off) ty ----------------------- cmmULtWord, cmmUGeWord, cmmUGtWord, cmmSubWord, cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord, - cmmUShrWord, cmmAddWord, cmmMulWord + cmmUShrWord, cmmAddWord, cmmMulWord, cmmQuotWord :: CmmExpr -> CmmExpr -> CmmExpr cmmOrWord e1 e2 = CmmMachOp mo_wordOr [e1, e2] cmmAndWord e1 e2 = CmmMachOp mo_wordAnd [e1, e2] @@ -306,6 +306,7 @@ cmmNegate e = CmmMachOp (MO_S_Neg (cmmExprWidth e)) [e] blankWord :: CmmStatic blankWord = CmmUninitialised wORD_SIZE +cmmQuotWord e1 e2 = CmmMachOp mo_wordUQuot [e1, e2] --------------------------------------------------- -- diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs index a2e50e0..c128cb7 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 d9585c6..b4b6749 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 () _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
