X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgPrimOp.hs;h=91aa3911f83a3fa84dec938eb36a3db655c77605;hb=91b07216be1cb09230b7d1b417899ddea8620ff3;hp=bd54204eaff94ea51ffcc8ed606b233392a5e109;hpb=3a0d52e19bfb1f3f96af0950ac2329730c659e53;p=ghc-hetmet.git

diff --git a/ghc/compiler/codeGen/CgPrimOp.hs b/ghc/compiler/codeGen/CgPrimOp.hs
index bd54204..91aa391 100644
--- a/ghc/compiler/codeGen/CgPrimOp.hs
+++ b/ghc/compiler/codeGen/CgPrimOp.hs
@@ -10,13 +10,15 @@ module CgPrimOp (
    cgPrimOp
  ) where
 
+import ForeignCall	( CCallConv(CCallConv) )
 import StgSyn		( StgLiveVars, StgArg )
 import CgBindery	( getVolatileRegs, getArgAmodes )
 import CgMonad
 import CgInfoTbls	( getConstrTag )
 import CgUtils		( cmmOffsetW, cmmOffsetB, cmmLoadIndexW )
 import Cmm
-import CLabel		( mkMAP_FROZEN_infoLabel )
+import CLabel		( mkMAP_FROZEN_infoLabel, mkMAP_DIRTY_infoLabel,
+			  mkDirty_MUT_VAR_Label )
 import CmmUtils
 import MachOp
 import SMRep
@@ -113,7 +115,14 @@ emitPrimOp [res] ReadMutVarOp [mutv] live
    = stmtC (CmmAssign res (cmmLoadIndexW mutv fixedHdrSize))
 
 emitPrimOp [] WriteMutVarOp [mutv,var] live
-   = stmtC (CmmStore (cmmOffsetW mutv fixedHdrSize) var)
+   = do
+	stmtC (CmmStore (cmmOffsetW mutv fixedHdrSize) var)
+	vols <- getVolatileRegs live
+	stmtC (CmmCall (CmmForeignCall (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
+				CCallConv) 
+			[{-no results-}]
+			[(mutv,PtrHint)]
+			(Just vols))
 
 --  #define sizzeofByteArrayzh(r,a) \
 --     r = (((StgArrWords *)(a))->words * sizeof(W_))
@@ -403,7 +412,7 @@ translateOp AddrLeOp       = Just mo_wordULe
 translateOp AddrGtOp       = Just mo_wordUGt
 translateOp AddrLtOp       = Just mo_wordULt
 
--- 32-bit unsigned ops
+-- Char# ops
 
 translateOp CharEqOp       = Just (MO_Eq wordRep)
 translateOp CharNeOp       = Just (MO_Ne wordRep)
@@ -525,7 +534,8 @@ doWriteByteArrayOp _ _ _ _
    = panic "CgPrimOp: doWriteByteArrayOp"
 
 doWritePtrArrayOp addr idx val
-   = mkBasicIndexedWrite arrPtrsHdrSize Nothing wordRep addr idx val
+   = do stmtC (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
+        mkBasicIndexedWrite arrPtrsHdrSize Nothing wordRep addr idx val
 
 
 mkBasicIndexedRead off Nothing read_rep res base idx