Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/1fc25dfd0ba410b8100f2f910394ae041758c8c5 >--------------------------------------------------------------- commit 1fc25dfd0ba410b8100f2f910394ae041758c8c5 Author: Simon Marlow <[email protected]> Date: Wed Nov 30 10:33:47 2011 +0000 Further tweaks to the ccs primops - add getCCSOf# :: a -> State# s -> (# State# s, Addr# #) (returns the CCS attached to the supplied object) - remove traceCcs# (obsoleted by getCCSOf#) - rename getCCCS# to getCurrentCCS# >--------------------------------------------------------------- compiler/codeGen/CgPrimOp.hs | 9 ++++++++- compiler/codeGen/StgCmmPrim.hs | 9 ++++++++- compiler/prelude/primops.txt.pp | 18 ++++++++++-------- 3 files changed, 26 insertions(+), 10 deletions(-) diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs index 72bbf6c..43a570d 100644 --- a/compiler/codeGen/CgPrimOp.hs +++ b/compiler/codeGen/CgPrimOp.hs @@ -38,6 +38,7 @@ import Module import Constants import Outputable import FastString +import StaticFlags -- --------------------------------------------------------------------------- -- Code generation for PrimOps @@ -155,7 +156,13 @@ emitPrimOp [res] SparkOp [arg] live = do where newspark = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark"))) -emitPrimOp [res] GetCCCSOp [] _live +emitPrimOp [res] GetCCSOfOp [arg] _live + = stmtC (CmmAssign (CmmLocal res) val) + where + val | opt_SccProfilingOn = costCentreFrom (cmmUntag arg) + | otherwise = CmmLit zeroCLit + +emitPrimOp [res] GetCurrentCCSOp [_dummy_arg] _live = stmtC (CmmAssign (CmmLocal res) curCCS) emitPrimOp [res] ReadMutVarOp [mutv] _ diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index d546c38..a2337ae 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -42,6 +42,7 @@ import Constants import Module import FastString import Outputable +import StaticFlags ------------------------------------------------------------------------ -- Primitive operations and foreign calls @@ -228,7 +229,13 @@ emitPrimOp [res] SparkOp [arg] [(CmmReg (CmmGlobal BaseReg), AddrHint), ((CmmReg (CmmLocal tmp)), AddrHint)] emit (mkAssign (CmmLocal res) (CmmReg (CmmLocal tmp))) -emitPrimOp [res] GetCCCSOp [] +emitPrimOp [res] GetCCSOfOp [arg] + = emit (mkAssign (CmmLocal res) val) + where + val | opt_SccProfilingOn = costCentreFrom (cmmUntag arg) + | otherwise = CmmLit zeroCLit + +emitPrimOp [res] GetCurrentCCSOp [_dummy_arg] = emit (mkAssign (CmmLocal res) curCCS) emitPrimOp [res] ReadMutVarOp [mutv] diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index ceb9226..304ad70 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -1793,14 +1793,16 @@ section "Misc" {These aren't nearly as wired in as Etc...} ------------------------------------------------------------------------ -primop TraceCcsOp "traceCcs#" GenPrimOp - a -> b -> b - with - has_side_effects = True - out_of_line = True - -primop GetCCCSOp "getCCCS#" GenPrimOp - State# s -> (# State# s, Addr# #) +primop GetCCSOfOp "getCCSOf#" GenPrimOp + a -> State# s -> (# State# s, Addr# #) + +primop GetCurrentCCSOp "getCurrentCCS#" GenPrimOp + a -> State# s -> (# State# s, Addr# #) + { Returns the current {\tt CostCentreStack} (value is {\tt NULL} if + not profiling). Takes a dummy argument which can be used to + avoid the call to {\tt getCCCS\#} being floated out by the + simplifier, which would result in an uninformative stack + ("CAF"). } ------------------------------------------------------------------------ section "Etc" _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
