summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/GHC/StgToCmm/Ticky.hs69
-rw-r--r--rts/Ticky.c2
-rw-r--r--rts/eventlog/EventLog.c4
-rw-r--r--rts/include/rts/Ticky.h1
4 files changed, 40 insertions, 36 deletions
diff --git a/compiler/GHC/StgToCmm/Ticky.hs b/compiler/GHC/StgToCmm/Ticky.hs
index c322e99a0f..c37ac4897b 100644
--- a/compiler/GHC/StgToCmm/Ticky.hs
+++ b/compiler/GHC/StgToCmm/Ticky.hs
@@ -207,8 +207,8 @@ instance ToJson TickyClosureType where
,("args", json args)
]
-tickyEntryDesc :: (SDocContext -> TickyClosureType -> String)
-tickyEntryDesc ctxt = renderWithContext ctxt . renderJSON . json
+tickyEntryDescJson :: (SDocContext -> TickyClosureType -> String)
+tickyEntryDescJson ctxt = renderWithContext ctxt . renderJSON . json
data TickyClosureType
= TickyFun
@@ -279,6 +279,34 @@ withNewTickyCounter cloType name m = do
lbl <- emitTickyCounter cloType name
setTickyCtrLabel lbl m
+emitTickyData :: Platform
+ -> CLabel -- ^ lbl for the counter
+ -> Arity -- ^ arity
+ -> CmmLit -- ^ fun desc
+ -> CmmLit -- ^ arg desc
+ -> CmmLit -- ^ json desc
+ -> CmmLit -- ^ info table lbl
+ -> FCode ()
+emitTickyData platform ctr_lbl arity fun_desc arg_desc json_desc info_tbl =
+ emitDataLits ctr_lbl
+ -- Must match layout of rts/include/rts/Ticky.h's StgEntCounter
+ --
+ -- krc: note that all the fields are I32 now; some were I16
+ -- before, but the code generator wasn't handling that
+ -- properly and it led to chaos, panic and disorder.
+ [ zeroCLit platform, -- registered?
+ mkIntCLit platform arity, -- Arity
+ zeroCLit platform, -- Heap allocated for this thing
+ fun_desc,
+ arg_desc,
+ json_desc,
+ info_tbl,
+ zeroCLit platform, -- Entries into this thing
+ zeroCLit platform, -- Heap allocated by this thing
+ zeroCLit platform -- Link to next StgEntCounter
+ ]
+
+
emitTickyCounter :: TickyClosureType -> Id -> FCode CLabel
emitTickyCounter cloType tickee
= let name = idName tickee in
@@ -342,23 +370,9 @@ emitTickyCounter cloType tickee
; let ctx = defaultSDocContext {sdocPprDebug = True}
; fun_descr_lit <- newStringCLit $ renderWithContext ctx ppr_for_ticky_name
- ; arg_descr_lit <- newStringCLit $ tickyEntryDesc ctx cloType
- ; emitDataLits ctr_lbl
- -- Must match layout of rts/include/rts/Ticky.h's StgEntCounter
- --
- -- krc: note that all the fields are I32 now; some were I16
- -- before, but the code generator wasn't handling that
- -- properly and it led to chaos, panic and disorder.
- [ mkIntCLit platform 0, -- registered?
- mkIntCLit platform (tickyArgArity cloType), -- Arity
- mkIntCLit platform 0, -- Heap allocated for this thing
- fun_descr_lit,
- arg_descr_lit,
- info_lbl,
- zeroCLit platform, -- Entries into this thing
- zeroCLit platform, -- Heap allocated by this thing
- zeroCLit platform -- Link to next StgEntCounter
- ]
+ ; arg_descr_lit <- newStringCLit $ tickyArgDesc cloType
+ ; json_descr_lit <- newStringCLit $ tickyEntryDescJson ctx cloType
+ ; emitTickyData platform ctr_lbl (tickyArgArity cloType) fun_descr_lit arg_descr_lit json_descr_lit info_lbl
}
{- Note [TagSkip ticky counters]
@@ -432,21 +446,8 @@ emitTickyCounterTag unique (NonVoid id) =
; sdoc_context <- stgToCmmContext <$> getStgToCmmConfig
; fun_descr_lit <- newStringCLit $ renderWithContext sdoc_context ppr_for_ticky_name
; arg_descr_lit <- newStringCLit $ "infer"
- ; emitDataLits ctr_lbl
- -- Must match layout of includes/rts/Ticky.h's StgEntCounter
- --
- -- krc: note that all the fields are I32 now; some were I16
- -- before, but the code generator wasn't handling that
- -- properly and it led to chaos, panic and disorder.
- [ mkIntCLit platform 0, -- registered?
- mkIntCLit platform 0, -- Arity
- mkIntCLit platform 0, -- Heap allocated for this thing
- fun_descr_lit,
- arg_descr_lit,
- zeroCLit platform, -- Entries into this thing
- zeroCLit platform, -- Heap allocated by this thing
- zeroCLit platform -- Link to next StgEntCounter
- ]
+ ; json_descr_lit <- newStringCLit $ "infer"
+ ; emitTickyData platform ctr_lbl 0 fun_descr_lit arg_descr_lit json_descr_lit (zeroCLit platform)
}
-- -----------------------------------------------------------------------------
-- Ticky stack frames
diff --git a/rts/Ticky.c b/rts/Ticky.c
index f82cd27104..a216fcb00f 100644
--- a/rts/Ticky.c
+++ b/rts/Ticky.c
@@ -17,7 +17,7 @@
*/
StgEntCounter top_ct
= { 0, 0, 0,
- "TOP", "", NULL,
+ "TOP", "", "",NULL,
0, 0, NULL };
/* Data structure used in ``registering'' one of these counters. */
diff --git a/rts/eventlog/EventLog.c b/rts/eventlog/EventLog.c
index 0536ecdab6..bd65b6e642 100644
--- a/rts/eventlog/EventLog.c
+++ b/rts/eventlog/EventLog.c
@@ -1357,7 +1357,7 @@ void postProfBegin(void)
#if defined(TICKY_TICKY)
static void postTickyCounterDef(EventsBuf *eb, StgEntCounter *p)
{
- StgWord len = 8 + 2 + strlen(p->arg_kinds)+1 + strlen(p->str)+1 + 8;
+ StgWord len = 8 + 2 + strlen(p->arg_kinds)+1 + strlen(p->str)+1 + 8 + strlen(p->ticky_json)+1;
ensureRoomForVariableEvent(eb, len);
postEventHeader(eb, EVENT_TICKY_COUNTER_DEF);
postPayloadSize(eb, len);
@@ -1367,6 +1367,8 @@ static void postTickyCounterDef(EventsBuf *eb, StgEntCounter *p)
postString(eb, p->arg_kinds);
postString(eb, p->str);
postWord64(eb, (W_) (INFO_PTR_TO_STRUCT(p->info)));
+ postString(eb, p->ticky_json);
+
}
void postTickyCounterDefs(StgEntCounter *counters)
diff --git a/rts/include/rts/Ticky.h b/rts/include/rts/Ticky.h
index 7658e3c08a..4d58c8e63a 100644
--- a/rts/include/rts/Ticky.h
+++ b/rts/include/rts/Ticky.h
@@ -26,6 +26,7 @@ typedef struct _StgEntCounter {
/* (rest of args are in registers) */
char *str; /* name of the thing */
char *arg_kinds; /* info about the args types */
+ char *ticky_json; /* json_info for eventlog mostly describing the tick */
StgInfoTable *info; /* Info table corresponding to this closure */
StgInt entry_count; /* Trips to fast entry code */
StgInt allocs; /* number of allocations by this fun */