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
-- ---------------------------------------------------------------------------
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_))
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
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
= 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