[commit: ghc] ghc-7.6: MERGED: Fix fencepost and byte/word bugs in cloneArray/copyArray (#7185) (13a833e)
Ian Lynagh <[email protected]>
| Newsgroups | gmane.comp.lang.haskell.cvs.ghc |
|---|---|
| Message-ID | <[email protected]> |
Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-7.6 http://hackage.haskell.org/trac/ghc/changeset/13a833e51c141165d927325fa0d1bce9ccdab1de >--------------------------------------------------------------- commit 13a833e51c141165d927325fa0d1bce9ccdab1de Author: Ian Lynagh <[email protected]> Date: Tue Sep 4 14:00:12 2012 +0100 MERGED: Fix fencepost and byte/word bugs in cloneArray/copyArray (#7185) From: commit 8aabe8d06f7202c9a6cd1133e0b1ebc81338eed9 Author: Simon Marlow <[email protected]> Date: Tue Aug 28 15:52:38 2012 +0100 >--------------------------------------------------------------- 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 f2e4d8e..f88e630 100644 --- a/compiler/cmm/CmmUtils.hs +++ b/compiler/cmm/CmmUtils.hs @@ -43,7 +43,7 @@ module CmmUtils( cmmNegate, cmmULtWord, cmmUGeWord, cmmUGtWord, cmmSubWord, cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord, - cmmUShrWord, cmmAddWord, cmmMulWord, + cmmUShrWord, cmmAddWord, cmmMulWord, cmmQuotWord, isTrivialCmmExpr, hasNoGlobalRegs, @@ -290,7 +290,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] @@ -304,6 +304,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) diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs index 641cd5d..b729822 100644 --- a/compiler/codeGen/CgPrimOp.hs +++ b/compiler/codeGen/CgPrimOp.hs @@ -34,6 +34,7 @@ import FastString import StaticFlags import Control.Monad +import Data.Bits -- --------------------------------------------------------------------------- -- Code generation for PrimOps @@ -829,8 +830,7 @@ doWritePtrArrayOp addr idx val cmmOffsetExpr (cmmOffsetExprW (cmmOffsetB addr arrPtrsHdrSize) (loadArrPtrsSize addr)) - (CmmMachOp mo_wordUShr [idx, - CmmLit (mkIntCLit mUT_ARR_PTRS_CARD_BITS)]) + (card idx) ) (CmmLit (CmmInt 1 W8)) loadArrPtrsSize :: CmmExpr -> CmmExpr @@ -1002,10 +1002,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_words <- assignTemp $ cardRoundUp n + size <- assignTemp $ n `cmmAddWord` bytesToWordsRoundUp card_bytes words <- assignTemp $ arrPtrsHdrSizeW `cmmAddWord` size arr_r <- newTemp bWord @@ -1029,14 +1027,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 = CmmLit $ mkIntCLit $ fixedHdrSize + (sIZEOF_StgMutArrPtrs_NoHdr `div` wORD_SIZE) - wordSize = CmmLit (mkIntCLit wORD_SIZE) myCapability = CmmReg baseReg `cmmSubWord` CmmLit (mkIntCLit oFFSET_Capability_r) @@ -1048,13 +1045,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 15020cc..2dff561 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -50,6 +50,7 @@ import StaticFlags import Util import Control.Monad (liftM) +import Data.Bits ------------------------------------------------------------------------ -- Primitive operations and foreign calls @@ -1080,10 +1081,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 words <- assignTempE $ arrPtrsHdrSizeW `cmmAddWord` size arr_r <- newTemp bWord @@ -1106,13 +1105,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 = CmmLit $ mkIntCLit $ fixedHdrSize + (sIZEOF_StgMutArrPtrs_NoHdr `div` wORD_SIZE) - wordSize = CmmLit (mkIntCLit wORD_SIZE) myCapability = CmmReg baseReg `cmmSubWord` CmmLit (mkIntCLit oFFSET_Capability_r) @@ -1124,12 +1122,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 ()