Permalink
Browse files

Fix fencepost and byte/word bugs in cloneArray/copyArray (#7185)

  • Loading branch information...
1 parent b660cc0 commit 8aabe8d06f7202c9a6cd1133e0b1ebc81338eed9 @simonmar simonmar committed Aug 28, 2012
Showing with 46 additions and 28 deletions.
  1. +3 −2 compiler/cmm/CmmUtils.hs
  2. +22 −14 compiler/codeGen/CgPrimOp.hs
  3. +21 −12 compiler/codeGen/StgCmmPrim.hs
View
@@ -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]
---------------------------------------------------
--
@@ -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
@@ -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 ()

0 comments on commit 8aabe8d

Please sign in to comment.