Ticky:Make json info a separate field.wip/andreask/ticky_json_master

Fixes #21233

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 */