Further tweaks to the ccs primops
authorSimon Marlow <marlowsd@gmail.com>
Wed, 30 Nov 2011 10:33:47 +0000 (10:33 +0000)
committerSimon Marlow <marlowsd@gmail.com>
Wed, 30 Nov 2011 11:33:16 +0000 (11:33 +0000)
 - 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
compiler/codeGen/StgCmmPrim.hs
compiler/prelude/primops.txt.pp

index 72bbf6c..43a570d 100644 (file)
@@ -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] _
index d546c38..a2337ae 100644 (file)
@@ -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]
index ceb9226..304ad70 100644 (file)
@@ -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"