Commit 8aabe8d0 authored by Simon Marlow's avatar Simon Marlow
Browse files

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

parent b660cc0b
......@@ -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 ()
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment