Commit 13a833e5 authored by ian@well-typed.com's avatar ian@well-typed.com
Browse files

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

From:
    commit 8aabe8d0
    Author: Simon Marlow <marlowsd@gmail.com>
    Date:   Tue Aug 28 15:52:38 2012 +0100
parent 3869ac51
......@@ -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)
......
......@@ -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
......
......@@ -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 ()
......
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