change dirty_MUT_VAR() to use recordMutableCap()

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

diff --git a/ghc/compiler/codeGen/CgPrimOp.hs b/ghc/compiler/codeGen/CgPrimOp.hs
index 610f4d5..c1264be 100644 (file)
--- a/ghc/compiler/codeGen/CgPrimOp.hs
+++ b/ghc/compiler/codeGen/CgPrimOp.hs
@@ -10,19 +10,25 @@ module CgPrimOp (
    cgPrimOp
  ) where
 
+#include "HsVersions.h"
+
+import ForeignCall     ( CCallConv(CCallConv) )
 import StgSyn          ( StgLiveVars, StgArg )
 import CgBindery       ( getVolatileRegs, getArgAmodes )
 import CgMonad
 import CgInfoTbls      ( getConstrTag )
 import CgUtils         ( cmmOffsetW, cmmOffsetB, cmmLoadIndexW )
+import ForeignCall
 import Cmm
-import CLabel          ( mkMAP_FROZEN_infoLabel )
+import CLabel          ( mkMAP_FROZEN_infoLabel, mkMAP_DIRTY_infoLabel,
+                         mkDirty_MUT_VAR_Label, mkRtsCodeLabel )
 import CmmUtils
 import MachOp
 import SMRep
 import PrimOp          ( PrimOp(..) )
 import SMRep           ( tablesNextToCode )
 import Constants       ( wORD_SIZE, wORD_SIZE_IN_BITS )
+import StaticFlags     ( opt_Parallel )
 import Outputable
 
 -- ---------------------------------------------------------------------------
@@ -107,13 +113,30 @@ emitPrimOp [res_r,res_c] IntSubCOp [aa,bb] live
 
 
 emitPrimOp [res] ParOp [arg] live
-   = stmtC (CmmAssign res (CmmLit (mkIntCLit 1)))
+  = do
+       -- for now, just implement this in a C function
+       -- later, we might want to inline it.
+    vols <- getVolatileRegs live
+    stmtC (CmmCall (CmmForeignCall newspark CCallConv) [(res,NoHint)]
+               [(CmmReg (CmmGlobal BaseReg), PtrHint), 
+                (arg,PtrHint)] 
+               (Just vols))
+  where
+       newspark = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("newSpark")))
 
 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-}]
+                       [(CmmReg (CmmGlobal BaseReg), PtrHint),
+                        (mutv,PtrHint)]
+                       (Just vols))
 
 --  #define sizzeofByteArrayzh(r,a) \
 --     r = (((StgArrWords *)(a))->words * sizeof(W_))
@@ -525,7 +548,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