Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/1f7433b7b998dda4dde6d09f22a37f637745c079 >--------------------------------------------------------------- commit 1f7433b7b998dda4dde6d09f22a37f637745c079 Author: Simon Marlow <[email protected]> Date: Tue Nov 29 14:05:17 2011 +0000 Add a new primop: getCCCS# :: State# s -> (# State# s, Addr# #) Returns a pointer to the current cost-centre stack when profiling, NULL otherwise. >--------------------------------------------------------------- compiler/codeGen/CgPrimOp.hs | 2 ++ compiler/codeGen/StgCmmPrim.hs | 3 +++ compiler/prelude/primops.txt.pp | 3 +++ rts/Capability.c | 3 +++ 4 files changed, 11 insertions(+), 0 deletions(-) diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs index 6fe934b..72bbf6c 100644 --- a/compiler/codeGen/CgPrimOp.hs +++ b/compiler/codeGen/CgPrimOp.hs @@ -155,6 +155,8 @@ emitPrimOp [res] SparkOp [arg] live = do where newspark = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark"))) +emitPrimOp [res] GetCCCSOp [] _live + = stmtC (CmmAssign (CmmLocal res) curCCS) emitPrimOp [res] ReadMutVarOp [mutv] _ = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW mutv fixedHdrSize gcWord)) diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index f8cc425..d546c38 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -228,6 +228,9 @@ emitPrimOp [res] SparkOp [arg] [(CmmReg (CmmGlobal BaseReg), AddrHint), ((CmmReg (CmmLocal tmp)), AddrHint)] emit (mkAssign (CmmLocal res) (CmmReg (CmmLocal tmp))) +emitPrimOp [res] GetCCCSOp [] + = emit (mkAssign (CmmLocal res) curCCS) + emitPrimOp [res] ReadMutVarOp [mutv] = emit (mkAssign (CmmLocal res) (cmmLoadIndexW mutv fixedHdrSize gcWord)) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 204dce2..ceb9226 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -1799,6 +1799,9 @@ primop TraceCcsOp "traceCcs#" GenPrimOp has_side_effects = True out_of_line = True +primop GetCCCSOp "getCCCS#" GenPrimOp + State# s -> (# State# s, Addr# #) + ------------------------------------------------------------------------ section "Etc" {Miscellaneous built-ins} diff --git a/rts/Capability.c b/rts/Capability.c index fd9f64f..6c84d1e 100644 --- a/rts/Capability.c +++ b/rts/Capability.c @@ -267,6 +267,8 @@ initCapability( Capability *cap, nat i ) #ifdef PROFILING cap->r.rCCCS = CCS_SYSTEM; +#else + cap->r.rCCCS = NULL; #endif traceCapsetAssignCap(CAPSET_OSPROCESS_DEFAULT, i); @@ -614,6 +616,7 @@ waitForReturnCapability (Capability **pCap, Task *task) #ifdef PROFILING cap->r.rCCCS = CCS_SYSTEM; #endif + ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task); debugTrace(DEBUG_sched, "resuming capability %d", cap->no); _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
