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#

3 files changed, 26 insertions, 10 deletions

diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs
index 72bbf6cc58..43a570d41e 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 d546c38a90..a2337aee91 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 ceb9226594..304ad70ce2 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"