[project @ 2006-01-17 16:13:18 by simonmar]

[ghc-hetmet.git] / ghc / compiler / codeGen / CgPrimOp.hs

diff --git a/ghc/compiler/codeGen/CgPrimOp.hs b/ghc/compiler/codeGen/CgPrimOp.hs
index e59aafd..91aa391 100644 (file)
--- 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,14 +412,14 @@ 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 I32)
-translateOp CharNeOp       = Just (MO_Ne I32)
-translateOp CharGeOp       = Just (MO_U_Ge I32)
-translateOp CharLeOp       = Just (MO_U_Le I32)
-translateOp CharGtOp       = Just (MO_U_Gt I32)
-translateOp CharLtOp       = Just (MO_U_Lt I32)
+translateOp CharEqOp       = Just (MO_Eq wordRep)
+translateOp CharNeOp       = Just (MO_Ne wordRep)
+translateOp CharGeOp       = Just (MO_U_Ge wordRep)
+translateOp CharLeOp       = Just (MO_U_Le wordRep)
+translateOp CharGtOp       = Just (MO_U_Gt wordRep)
+translateOp CharLtOp       = Just (MO_U_Lt wordRep)
 
 -- Double ops
 
@@ -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