From: dias@cs.tufts.edu <unknown>
Date: Tue, 22 Dec 2009 22:20:17 +0000 (+0000)
Subject: Copying Simon M's fix for 650 to the new codegen
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=0e5b82290dfb34c969106d6bfb6efa16f8ce63d1;hp=da5a51ce7993b783c71be2e361ac03909bd6a3dc

Copying Simon M's fix for 650 to the new codegen
---

diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index 3318ec9..9cabcb1 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -636,8 +636,21 @@ doWriteByteArrayOp _ _ _
 
 doWritePtrArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
 doWritePtrArrayOp addr idx val
-   = do emit (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
-        mkBasicIndexedWrite arrPtrsHdrSize Nothing addr idx val
+  = do mkBasicIndexedWrite arrPtrsHdrSize Nothing addr idx val
+       emit (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
+  -- the write barrier.  We must write a byte into the mark table:
+  -- bits8[a + header_size + StgMutArrPtrs_size(a) + x >> N]
+       emit $ mkStore (
+         cmmOffsetExpr
+          (cmmOffsetExprW (cmmOffsetB addr arrPtrsHdrSize)
+                         (loadArrPtrsSize addr))
+          (CmmMachOp mo_wordUShr [idx,
+                                  CmmLit (mkIntCLit mUT_ARR_PTRS_CARD_BITS)])
+         ) (CmmLit (CmmInt 1 W8))
+       
+loadArrPtrsSize :: CmmExpr -> CmmExpr
+loadArrPtrsSize addr = CmmLoad (cmmOffsetB addr off) bWord
+ where off = fixedHdrSize*wORD_SIZE + oFFSET_StgMutArrPtrs_ptrs
 
 mkBasicIndexedRead :: ByteOff -> Maybe MachOp -> CmmType
 		   -> LocalReg -> CmmExpr -> CmmExpr -> FCode ()