Report heap overflow in the same way as stack overflow
authorSimon Marlow <marlowsd@gmail.com>
Sat, 1 Apr 2017 23:52:40 +0000 (19:52 -0400)
committerBen Gamari <ben@smart-cactus.org>
Sun, 2 Apr 2017 16:01:47 +0000 (12:01 -0400)
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

includes/Rts.h
libraries/base/GHC/Conc.hs
libraries/base/GHC/Conc/Sync.hs
libraries/base/GHC/TopHandler.hs
rts/RtsSymbols.c
rts/RtsUtils.c
rts/RtsUtils.h
rts/sm/CNF.c
rts/sm/GC.c
rts/sm/Storage.c
testsuite/tests/rts/T1791/T1791.stderr [deleted file]

index fc010d4..be49b32 100644 (file)
@@ -218,7 +218,8 @@ void getWin32ProgArgv(int *argc, wchar_t **argv[]);
 void setWin32ProgArgv(int argc, wchar_t *argv[]);
 #endif
 
-void stackOverflow(StgTSO* tso);
+void reportStackOverflow(StgTSO* tso);
+void reportHeapOverflow(void);
 
 void stg_exit(int n) GNU_ATTRIBUTE(__noreturn__);
 
index afc0a97..74d14ba 100644 (file)
@@ -110,7 +110,7 @@ module GHC.Conc
         , setUncaughtExceptionHandler
         , getUncaughtExceptionHandler
 
-        , reportError, reportStackOverflow
+        , reportError, reportStackOverflow, reportHeapOverflow
         ) where
 
 import GHC.Conc.IO
index a70e103..78a0334 100644 (file)
@@ -91,7 +91,7 @@ module GHC.Conc.Sync
         , setUncaughtExceptionHandler
         , getUncaughtExceptionHandler
 
-        , reportError, reportStackOverflow
+        , reportError, reportStackOverflow, reportHeapOverflow
 
         , sharedCAF
         ) where
@@ -883,7 +883,7 @@ sharedCAF a get_or_set =
 reportStackOverflow :: IO ()
 reportStackOverflow = do
      ThreadId tid <- myThreadId
-     callStackOverflowHook tid
+     c_reportStackOverflow tid
 
 reportError :: SomeException -> IO ()
 reportError ex = do
@@ -892,8 +892,11 @@ reportError ex = do
 
 -- SUP: Are the hooks allowed to re-enter Haskell land?  If so, remove
 -- the unsafe below.
-foreign import ccall unsafe "stackOverflow"
-        callStackOverflowHook :: ThreadId# -> IO ()
+foreign import ccall unsafe "reportStackOverflow"
+        c_reportStackOverflow :: ThreadId# -> IO ()
+
+foreign import ccall unsafe "reportHeapOverflow"
+        reportHeapOverflow :: IO ()
 
 {-# NOINLINE uncaughtExceptionHandler #-}
 uncaughtExceptionHandler :: IORef (SomeException -> IO ())
index f1c87e5..58da871 100644 (file)
@@ -177,8 +177,9 @@ real_handler exit se = do
 
       Just UserInterrupt -> exitInterrupted
 
-      Just HeapOverflow -> exit 251
-           -- the RTS has already emitted a message to stderr
+      Just HeapOverflow -> do
+           reportHeapOverflow
+           exit 251
 
       _ -> case fromException se of
            -- only the main thread gets ExitException exceptions
index 0180554..7db5a27 100644 (file)
       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)                         \
index 31dc060..85f951a 100644 (file)
@@ -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
 }
-
index 8f4e806..6514e35 100644 (file)
@@ -34,8 +34,6 @@ void stgFree(void* p);
  * Misc other utilities
  * -------------------------------------------------------------------------- */
 
-void heapOverflow(void);
-
 char *time_str(void);
 char *showStgWord64(StgWord64, char *, bool);
 
index 7dfaced..624dba3 100644 (file)
@@ -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
index 358700e..0dafb8c 100644 (file)
@@ -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.
    -------------------------------------------------------------------------- */
 
index a527e4f..43f67f4 100644 (file)
@@ -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.
diff --git a/testsuite/tests/rts/T1791/T1791.stderr b/testsuite/tests/rts/T1791/T1791.stderr
deleted file mode 100644 (file)
index fa8ef2d..0000000
+++ /dev/null
@@ -1,3 +0,0 @@
-T1791: Heap exhausted;
-T1791: Current maximum heap size is 8388608 bytes (8 MB).
-T1791: Use `+RTS -M<size>' to increase it.