Report heap overflow in the same way as stack overflow

Now that we throw an exception for heap overflow, we should only print
the heap overflow message in the main thread when the HeapOverflow
exception is caught, rather than as a side effect in the GC.

Stack overflows were already done this way, I just made heap overflow
consistent with stack overflow, and did some related cleanup.

Fixes broken T2592(profasm) which was reporting the heap overflow
message twice (you would only notice when building with profiling
libs enabled).

Test Plan: validate

Reviewers: bgamari, niteria, austin, DemiMarie, hvr, erikd

Reviewed By: bgamari

Subscribers: rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D3394

6 files changed, 22 insertions, 20 deletions

diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c
index 0180554437..7db5a27cf1 100644
--- a/rts/RtsSymbols.c
+++ b/rts/RtsSymbols.c
@@ -755,7 +755,8 @@
       SymI_HasProto(shutdownHaskellAndExit)                             \
       SymI_HasProto(stable_name_table)                                  \
       SymI_HasProto(stable_ptr_table)                                   \
-      SymI_HasProto(stackOverflow)                                      \
+      SymI_HasProto(reportStackOverflow)                                \
+      SymI_HasProto(reportHeapOverflow)                                 \
       SymI_HasProto(stg_CAF_BLACKHOLE_info)                             \
       SymI_HasProto(stg_BLACKHOLE_info)                                 \
       SymI_HasProto(__stg_EAGER_BLACKHOLE_info)                         \
diff --git a/rts/RtsUtils.c b/rts/RtsUtils.c
index 31dc060244..85f951addd 100644
--- a/rts/RtsUtils.c
+++ b/rts/RtsUtils.c
@@ -131,13 +131,11 @@ stgFree(void* p)
 }
 
 /* -----------------------------------------------------------------------------
-   Stack overflow
-
-   Not sure if this belongs here.
+   Stack/heap overflow
    -------------------------------------------------------------------------- */
 
 void
-stackOverflow(StgTSO* tso)
+reportStackOverflow(StgTSO* tso)
 {
     rtsConfig.stackOverflowHook(tso->tot_stack_size * sizeof(W_));
 
@@ -147,16 +145,11 @@ stackOverflow(StgTSO* tso)
 }
 
 void
-heapOverflow(void)
+reportHeapOverflow(void)
 {
-    if (!heap_overflow)
-    {
-        /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-        rtsConfig.outOfHeapHook(0/*unknown request size*/,
-                                (W_)RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
-
-        heap_overflow = true;
-    }
+    /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
+    rtsConfig.outOfHeapHook(0/*unknown request size*/,
+                            (W_)RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
 }
 
 /* -----------------------------------------------------------------------------
@@ -351,4 +344,3 @@ void checkFPUStack(void)
     }
 #endif
 }
-
diff --git a/rts/RtsUtils.h b/rts/RtsUtils.h
index 8f4e8066f2..6514e351d1 100644
--- a/rts/RtsUtils.h
+++ b/rts/RtsUtils.h
@@ -34,8 +34,6 @@ void stgFree(void* p);
  * Misc other utilities
  * -------------------------------------------------------------------------- */
 
-void heapOverflow(void);
-
 char *time_str(void);
 char *showStgWord64(StgWord64, char *, bool);
 
diff --git a/rts/sm/CNF.c b/rts/sm/CNF.c
index 7dfaced7ef..624dba30b2 100644
--- a/rts/sm/CNF.c
+++ b/rts/sm/CNF.c
@@ -176,8 +176,8 @@ compactAllocateBlockInternal(Capability            *cap,
         n_blocks >= HS_INT32_MAX)   // avoid overflow when
                                     // calling allocGroup() below
     {
-        heapOverflow();
-        // heapOverflow() doesn't exit (see #2592), but we aren't
+        reportHeapOverflow();
+        // reportHeapOverflow() doesn't exit (see #2592), but we aren't
         // in a position to do a clean shutdown here: we
         // either have to allocate the memory or exit now.
         // Allocating the memory would be bad, because the user
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 358700e499..0dafb8c3ea 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -157,6 +157,7 @@ static void wakeup_gc_threads       (uint32_t me, bool idle_cap[]);
 static void shutdown_gc_threads     (uint32_t me, bool idle_cap[]);
 static void collect_gct_blocks      (void);
 static void collect_pinned_object_blocks (void);
+static void heapOverflow            (void);
 
 #if defined(DEBUG)
 static void gcCAFs                  (void);
@@ -796,6 +797,16 @@ GarbageCollect (uint32_t collect_gen,
 }
 
 /* -----------------------------------------------------------------------------
+   Heap overflow is indicated by setting a flag that the caller of
+   GarbageCollect can check.  (not ideal, TODO: better)
+   -------------------------------------------------------------------------- */
+
+static void heapOverflow(void)
+{
+    heap_overflow = true;
+}
+
+/* -----------------------------------------------------------------------------
    Initialise the gc_thread structures.
    -------------------------------------------------------------------------- */
 
diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index a527e4f962..43f67f4899 100644
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -845,7 +845,7 @@ allocate (Capability *cap, W_ n)
             req_blocks >= HS_INT32_MAX)   // avoid overflow when
                                           // calling allocGroup() below
         {
-            heapOverflow();
+            reportHeapOverflow();
             // heapOverflow() doesn't exit (see #2592), but we aren't
             // in a position to do a clean shutdown here: we
             // either have to allocate the memory or exit now.