Implement #2191 (traceCcs# -- prints CCS of a value when available -- take 3)

In this version, I untag R1 before using it, and even enter R2 at the
end rather than simply returning it (which didn't work right when R2
was a thunk).

diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 1e41453..3779a79 100644 (file)
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -1743,6 +1743,17 @@ primop  GetApStackValOp "getApStackVal#" GenPrimOp
    out_of_line = True
 
 ------------------------------------------------------------------------
+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
+
+------------------------------------------------------------------------
 section "Etc" 
        {Miscellaneous built-ins}
 ------------------------------------------------------------------------

diff --git a/includes/StgMiscClosures.h b/includes/StgMiscClosures.h
index 460adeb..94244a9 100644 (file)
--- a/includes/StgMiscClosures.h
+++ b/includes/StgMiscClosures.h
@@ -606,6 +606,8 @@ RTS_FUN(getSparkzh_fast);
 
 RTS_FUN(noDuplicatezh_fast);
 
+RTS_FUN(traceCcszh_fast);
+
 /* Other misc stuff */
 // See wiki:Commentary/Compiler/Backends/PprC#Prototypes
 

diff --git a/rts/Linker.c b/rts/Linker.c
index ae1da56..474cd81 100644 (file)
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -856,6 +856,7 @@ typedef struct _RtsSymbolVal {
       SymI_NeedsProto(rts_stop_on_exception)           \
       SymI_HasProto(stopTimer)                         \
       SymI_HasProto(n_capabilities)                    \
+      SymI_HasProto(traceCcszh_fast)                    \
       RTS_USER_SIGNALS_SYMBOLS
 
 #ifdef SUPPORT_LONG_LONGS

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index dc60ff2..a6e221b 100644 (file)
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -2362,6 +2362,26 @@ getApStackValzh_fast
    RET_NP(ok,val);
 }
 
+/* -----------------------------------------------------------------------------
+   Misc. primitives
+   -------------------------------------------------------------------------- */
+
+// Write the cost center stack of the first argument on stderr; return
+// the second.  Possibly only makes sense for already evaluated
+// things?
+traceCcszh_fast
+{
+    W_ ccs;
+
+#ifdef PROFILING
+    ccs = StgHeader_ccs(UNTAG(R1));
+    foreign "C" fprintCCS_stderr(ccs "ptr") [R2];
+#endif
+
+    R1 = R2;
+    ENTER();
+}
+
 getSparkzh_fast
 {
    W_ spark;