[commit: ghc] ghc-7.6: MERGED: Fix fencepost and byte/word bugs in cloneArray/copyArray (#7185) (13a833e)
Ian Lynagh
igloo at earth.li
Tue Sep 4 15:42:19 CEST 2012
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 <ian at well-typed.com>
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 <marlowsd at gmail.com>
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 at .
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 at .
emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
More information about the Cvs-ghc
mailing list