Skip to content

Commit

Permalink
Fix fencepost and byte/word bugs in cloneArray/copyArray (#7185)
Browse files Browse the repository at this point in the history
  • Loading branch information
@simonmar
simonmar committed Aug 31, 2012
1 parent b660cc0 commit 8aabe8d
Show file tree
Hide file tree
Showing 3 changed files with 46 additions and 28 deletions.
5 changes: 3 additions & 2 deletions compiler/cmm/CmmUtils.hs
View file
Expand Up @@ -38,7 +38,7 @@ module CmmUtils(
cmmNegate,
cmmULtWord, cmmUGeWord, cmmUGtWord, cmmSubWord,
cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord,
cmmUShrWord, cmmAddWord, cmmMulWord,
cmmUShrWord, cmmAddWord, cmmMulWord, cmmQuotWord,

isTrivialCmmExpr, hasNoGlobalRegs,

Expand Down Expand Up @@ -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]
Expand All @@ -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]

---------------------------------------------------
--
Expand Down
36 changes: 22 additions & 14 deletions compiler/codeGen/CgPrimOp.hs
View file
Expand Up @@ -34,6 +34,7 @@ import DynFlags
import FastString

import Control.Monad
import Data.Bits

-- ---------------------------------------------------------------------------
-- Code generation for PrimOps
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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)

Expand All @@ -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
Expand Down
33 changes: 21 additions & 12 deletions compiler/codeGen/StgCmmPrim.hs
View file
Expand Up @@ -49,6 +49,7 @@ import Outputable
import Util

import Control.Monad (liftM)
import Data.Bits

------------------------------------------------------------------------
-- Primitive operations and foreign calls
Expand Down Expand Up @@ -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

Expand All @@ -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)

Expand All @@ -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 ()
Expand Down

0 comments on commit 8aabe8d

Please sign in to comment.