X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FStgCmmPrim.hs;h=9cabcb12e74d5ab376b21bf9e544bbbe4014174e;hb=9105c03ffef568aab097a293313eb6ff4f0dd5dc;hp=e5ff8f73ff1e99d0d047c10b4d3a50f27b316ef0;hpb=a02e7f40afc1aab7fe466f949f505c1d7250713d;p=ghc-hetmet.git

diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index e5ff8f7..9cabcb1 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -232,8 +232,8 @@ emitPrimOp [res] SizeofMutableByteArrayOp [arg]
 
 
 --  #define touchzh(o)                  /* nothing */
-emitPrimOp [] TouchOp [_arg]
-   = nopC
+emitPrimOp res@[] TouchOp args@[_arg]
+   = do emitPrimCall res MO_Touch args
 
 --  #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
 emitPrimOp [res] ByteArrayContents_Char [arg]
@@ -413,9 +413,9 @@ emitPrimOp [res] op [arg]
    = emit (mkAssign (CmmLocal res) $
 	   CmmMachOp (mop rep wordWidth) [CmmMachOp (mop wordWidth rep) [arg]])
 
-emitPrimOp [res] op args
+emitPrimOp r@[res] op args
    | Just prim <- callishOp op
-   = do emitPrimCall res prim args
+   = do emitPrimCall r prim args
 
    | Just mop <- translateOp op
    = let stmt = mkAssign (CmmLocal res) (CmmMachOp mop args) in
@@ -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 ()