From 979fb4abd736734d30089a8b328824d4a5862a6a Mon Sep 17 00:00:00 2001 From: Samuel Bronson Date: Tue, 27 Jan 2009 08:48:25 +0000 Subject: [PATCH] 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). --- compiler/prelude/primops.txt.pp | 11 +++++++++++ includes/StgMiscClosures.h | 2 ++ rts/Linker.c | 1 + rts/PrimOps.cmm | 20 ++++++++++++++++++++ 4 files changed, 34 insertions(+) diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 1e41453..3779a79 100644 --- 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 --- 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 --- 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 --- 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; -- 1.7.10.4