eventlog: Add BLOCKS_SIZE event

The BLOCKS_SIZE event reports the size of the currently allocated blocks
in bytes.

It is like the HEAP_SIZE event, but reports about the blocks rather than
megablocks.

You can work out the current heap fragmentation by looking at the
difference between HEAP_SIZE and BLOCKS_SIZE.

Fixes #19357

6 files changed, 41 insertions, 8 deletions

diff --git a/docs/users_guide/eventlog-formats.rst b/docs/users_guide/eventlog-formats.rst
index f8561a911d..b5a01995f5 100644
--- a/docs/users_guide/eventlog-formats.rst
+++ b/docs/users_guide/eventlog-formats.rst
@@ -242,23 +242,28 @@ A typical garbage collection will look something like the following:
 8. A :event-type:`GC_END` event will be emitted marking the end of the GC cycle.
 
 9. A :event-type:`HEAP_SIZE` event will be emitted giving the
-   cumulative heap allocations of the program until now.
+   current size of the heap, in bytes, calculated by how many megablocks
+   are allocated.
 
-10. A :event-type:`GC_STATS_GHC` event will be emitted
+10. A :event-type:`BLOCKS_SIZE` event will be emitted giving the
+   current size of the heap, in bytes, calculated by how many blocks
+   are allocated.
+
+11. A :event-type:`GC_STATS_GHC` event will be emitted
    containing various details of the collection and heap state.
 
-11. In the case of a major collection, a
+12. In the case of a major collection, a
     :event-type:`HEAP_LIVE` event will be emitted describing
     the current size of the live on-heap data.
 
-12. In the case of the :ghc-flag:`-threaded` RTS, a
+13. In the case of the :ghc-flag:`-threaded` RTS, a
     :event-type:`SPARK_COUNTERS` event will be emitted giving
     details on how many sparks have been created, evaluated, and GC'd.
 
-13. As mutator threads resume execution they will emit :event-type:`RUN_THREAD`
+14. As mutator threads resume execution they will emit :event-type:`RUN_THREAD`
     events.
 
-14. A :event-type:`MEM_RETURN` event will be emitted containing details about
+15. A :event-type:`MEM_RETURN` event will be emitted containing details about
     currently live mblocks, how many we think we need and whether we could return
     excess to the OS.
 
@@ -373,7 +378,16 @@ Heap events and statistics
    :field CapSetId: heap capability set
    :field Word64: heap size in bytes
 
-   Report the heap size.
+   Report the heap size, calculated by the number of megablocks currently allocated.
+
+.. event-type:: BLOCKS_SIZE
+
+   :tag: 91
+   :length: fixed
+   :field CapSetId: heap capability set
+   :field Word64: heap size in bytes
+
+   Report the heap size, calculated by the number of blocks currently allocated.
 
 .. event-type:: HEAP_LIVE
 
diff --git a/includes/rts/EventLogFormat.h b/includes/rts/EventLogFormat.h
index 37b7bc363d..b8b261ae3d 100644
--- a/includes/rts/EventLogFormat.h
+++ b/includes/rts/EventLogFormat.h
@@ -128,6 +128,7 @@
  */
 
 #define EVENT_MEM_RETURN         90 /* (cap, current_mblocks, needed_mblocks, returned_mblocks) */
+#define EVENT_BLOCKS_SIZE        91 /* (heapcapset, size_bytes) */
 
 /* Range 100 - 139 is reserved for Mercury. */
 
diff --git a/rts/RtsProbes.d b/rts/RtsProbes.d
index e7b39e5a15..2a21ec9099 100644
--- a/rts/RtsProbes.d
+++ b/rts/RtsProbes.d
@@ -75,6 +75,7 @@ provider HaskellEvent {
   probe heap__allocated (EventCapNo, EventCapsetID, StgWord64);
   probe heap__size (EventCapsetID, StgWord);
   probe heap__live (EventCapsetID, StgWord);
+  probe blocks__size (EventCapsetID, StgWord);
 
   /* capability events */
   probe startup (EventCapNo);
diff --git a/rts/Stats.c b/rts/Stats.c
index 2770696b66..55e05974f5 100644
--- a/rts/Stats.c
+++ b/rts/Stats.c
@@ -633,6 +633,9 @@ stat_endGC (Capability *cap, gc_thread *initiating_gct, W_ live, W_ copied, W_ s
         traceEventHeapSize(cap,
                            CAPSET_HEAP_DEFAULT,
                            mblocks_allocated * MBLOCK_SIZE);
+        traceEventBlocksSize(cap,
+                           CAPSET_HEAP_DEFAULT,
+                           n_alloc_blocks * BLOCK_SIZE);
     }
     RELEASE_LOCK(&stats_mutex);
 }
diff --git a/rts/Trace.h b/rts/Trace.h
index eed362e7b6..a4b4cc173b 100644
--- a/rts/Trace.h
+++ b/rts/Trace.h
@@ -473,6 +473,8 @@ void dtraceUserMarkerWrapper(Capability *cap, char *msg);
                                 allocated)
 #define dtraceEventHeapSize(heap_capset, size)          \
     HASKELLEVENT_HEAP_SIZE(heap_capset, size)
+#define dtraceEventBlocksSize(heap_capset, size)        \
+    HASKELLEVENT_BLOCKS_SIZE(heap_capset, size)
 #define dtraceEventHeapLive(heap_capset, live)          \
     HASKELLEVENT_HEAP_LIVE(heap_capset, live)
 #define dtraceCapsetCreate(capset, capset_type)         \
@@ -539,6 +541,7 @@ void dtraceUserMarkerWrapper(Capability *cap, char *msg);
 #define dtraceEventHeapAllocated(cap, heap_capset,      \
                                  allocated)             /* nothing */
 #define dtraceEventHeapSize(heap_capset, size)          /* nothing */
+#define dtraceEventBlocksSize(heap_capset, size)        /* nothing */
 #define dtraceEventHeapLive(heap_capset, live)          /* nothing */
 #define dtraceCapCreate(cap)                            /* nothing */
 #define dtraceCapDelete(cap)                            /* nothing */
@@ -796,6 +799,14 @@ INLINE_HEADER void traceEventHeapSize(Capability *cap         STG_UNUSED,
     dtraceEventHeapSize(heap_capset, heap_size);
 }
 
+INLINE_HEADER void traceEventBlocksSize(Capability *cap         STG_UNUSED,
+                                        CapsetID    heap_capset STG_UNUSED,
+                                        W_        heap_size   STG_UNUSED)
+{
+    traceHeapEvent(cap, EVENT_BLOCKS_SIZE, heap_capset, heap_size);
+    dtraceEventBlocksSize(heap_capset, heap_size);
+}
+
 INLINE_HEADER void traceEventHeapLive(Capability *cap         STG_UNUSED,
                                       CapsetID    heap_capset STG_UNUSED,
                                       W_        heap_live   STG_UNUSED)
diff --git a/rts/eventlog/EventLog.c b/rts/eventlog/EventLog.c
index 237c9bad9d..ebb44a7c9e 100644
--- a/rts/eventlog/EventLog.c
+++ b/rts/eventlog/EventLog.c
@@ -132,7 +132,8 @@ char *EventDesc[] = {
   [EVENT_MEM_RETURN]          = "Memory return statistics",
   [EVENT_HEAP_INFO_GHC]       = "Heap static parameters",
   [EVENT_HEAP_ALLOCATED]      = "Total heap mem ever allocated",
-  [EVENT_HEAP_SIZE]           = "Current heap size",
+  [EVENT_HEAP_SIZE]           = "Current heap size (size of allocated mblocks)",
+  [EVENT_BLOCKS_SIZE]         = "Current heap size (size of allocated blocks)",
   [EVENT_HEAP_LIVE]           = "Current heap live data",
   [EVENT_CREATE_SPARK_THREAD] = "Create spark thread",
   [EVENT_LOG_MSG]             = "Log message",
@@ -443,6 +444,7 @@ init_event_types(void)
 
         case EVENT_HEAP_ALLOCATED:    // (heap_capset, alloc_bytes)
         case EVENT_HEAP_SIZE:         // (heap_capset, size_bytes)
+        case EVENT_BLOCKS_SIZE:       // (heap_capset, size_bytes)
         case EVENT_HEAP_LIVE:         // (heap_capset, live_bytes)
             eventTypes[t].size = sizeof(EventCapsetID) + sizeof(StgWord64);
             break;
@@ -1099,6 +1101,7 @@ void postHeapEvent (Capability    *cap,
     switch (tag) {
     case EVENT_HEAP_ALLOCATED:     // (heap_capset, alloc_bytes)
     case EVENT_HEAP_SIZE:          // (heap_capset, size_bytes)
+    case EVENT_BLOCKS_SIZE:        // (heap_capset, size_bytes)
     case EVENT_HEAP_LIVE:          // (heap_capset, live_bytes)
     {
         postCapsetID(eb, heap_capset);