X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FCgPrimOp.hs;h=bc7c9140edb0ab5df7605d69a25c0ec5871655d2;hb=14a5c62a2d27830ea8b3716bb32a04f23678b355;hp=ccb252b484536871a24fe06d212651632e9d9e33;hpb=e792bb8488aa3c33d7b186abdf53aa8b0ef68b11;p=ghc-hetmet.git

diff --git a/ghc/compiler/codeGen/CgPrimOp.hs b/ghc/compiler/codeGen/CgPrimOp.hs
index ccb252b..bc7c914 100644
--- a/ghc/compiler/codeGen/CgPrimOp.hs
+++ b/ghc/compiler/codeGen/CgPrimOp.hs
@@ -10,19 +10,26 @@ module CgPrimOp (
    cgPrimOp
  ) where
 
+#include "HsVersions.h"
+
+import ForeignCall	( CCallConv(CCallConv) )
 import StgSyn		( StgLiveVars, StgArg )
+import CgForeignCall	( emitForeignCall' )
 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 +114,31 @@ 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
+    emitForeignCall' PlayRisky
+	[(res,NoHint)]
+    	(CmmForeignCall newspark CCallConv) 
+	[(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
+	emitForeignCall' PlayRisky
+		[{-no results-}]
+		(CmmForeignCall (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
+			 CCallConv)
+		[(CmmReg (CmmGlobal BaseReg), PtrHint), (mutv,PtrHint)]
+		(Just vols)
 
 --  #define sizzeofByteArrayzh(r,a) \
 --     r = (((StgArrWords *)(a))->words * sizeof(W_))
@@ -313,8 +338,11 @@ emitPrimOp [res] op [arg] live
 emitPrimOp [res] op args live
    | Just prim <- callishOp op
    = do vols <- getVolatileRegs live
-	stmtC (CmmCall (CmmPrim prim) [(res,NoHint)] 
-		[(a,NoHint) | a<-args] (Just vols)) -- ToDo: hints?
+	emitForeignCall' PlayRisky
+	   [(res,NoHint)] 
+	   (CmmPrim prim) 
+	   [(a,NoHint) | a<-args]  -- ToDo: hints?
+	   (Just vols)
 
    | Just mop <- translateOp op
    = let stmt = CmmAssign res (CmmMachOp mop args) in
@@ -330,6 +358,8 @@ nopOp Int2WordOp     = True
 nopOp Word2IntOp     = True
 nopOp Int2AddrOp     = True
 nopOp Addr2IntOp     = True
+nopOp ChrOp	     = True  -- Int# and Char# are rep'd the same
+nopOp OrdOp	     = True
 nopOp _		     = False
 
 -- These PrimOps turn into double casts
@@ -401,14 +431,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
 
@@ -451,9 +481,6 @@ translateOp Float2IntOp    = Just (MO_S_Conv F32 wordRep)
 translateOp Float2DoubleOp = Just (MO_S_Conv F32 F64)
 translateOp Double2FloatOp = Just (MO_S_Conv F64 F32)
 
-translateOp OrdOp          = Just (MO_U_Conv I32 wordRep)
-translateOp ChrOp          = Just (MO_U_Conv wordRep I32)
-
 -- Word comparisons masquerading as more exotic things.
 
 translateOp SameMutVarOp           = Just mo_wordEq
@@ -526,7 +553,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