Commit 12ad4d41 authored by dobenour's avatar dobenour Committed by Ben Gamari

Throw an exception on heap overflow

This changes heap overflow to throw a HeapOverflow exception instead of
killing the process.

Test Plan: GHC CI

Reviewers: simonmar, austin, hvr, erikd, bgamari

Reviewed By: simonmar, bgamari

Subscribers: thomie

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

GHC Trac Issues: #1791
parent e8d74321
......@@ -14,10 +14,17 @@ The highlights since the 8.0 branch are:
- TODO FIXME
- SCC annotations can now be used for declarations.
- Heap overflow throws an exception in certain circumstances.
Full details
------------
- Heap overflow throws a catchable exception, provided that it was detected
by the RTS during a GC cycle due to the program exceeding a limit set by
``+RTS -M``, and not due to an allocation being refused by the operating
system. This exception is thrown to the same thread that receives
``UserInterrupt`` exceptions, and may be caught by user programs.
Language
~~~~~~~~
......
......@@ -644,6 +644,20 @@ performance.
``-F`` parameter will be reduced in order to avoid exceeding the
maximum heap size.
.. rts-flag:: -Mgrace= ⟨size⟩
:default: 1M
.. index::
single: heap size, grace
If the program's heap exceeds the value set by :rts-flag:`-M`, the
RTS throws an exception to the program, and the program gets an
additional quota of allocation before the exception is raised
again, the idea being so that the program can execute its
exception handlers. ``-Mgrace=`` controls the size of this
additional quota.
.. rts-flag:: --numa
--numa=<mask>
......
......@@ -15,6 +15,10 @@
#define RTS_FLAGS_H
#include <stdio.h>
#include <stdint.h>
#include <stdbool.h>
#include "stg/Types.h"
#include "Time.h"
/* For defaults, see the @initRtsFlagsDefaults@ routine. */
......@@ -71,6 +75,12 @@ typedef struct _GC_FLAGS {
* to handle the exception before we
* raise it again.
*/
StgWord heapLimitGrace; /* units: *blocks*
* After a HeapOverflow exception has
* been raised, how much extra space is
* given to the thread to handle the
* exception before we raise it again.
*/
bool numa; /* Use NUMA */
StgWord numaMask;
......
......@@ -207,8 +207,15 @@ data AsyncException
-- live data it has. Notes:
--
-- * It is undefined which thread receives this exception.
-- GHC currently throws this to the same thread that
-- receives 'UserInterrupt', but this may change in the
-- future.
--
-- * GHC currently does not throw 'HeapOverflow' exceptions.
-- * The GHC RTS currently can only recover from heap overflow
-- if it detects that an explicit memory limit (set via RTS flags).
-- has been exceeded. Currently, failure to allocate memory from
-- the operating system results in immediate termination of the
-- program.
| ThreadKilled
-- ^This exception is raised by another thread
-- calling 'Control.Concurrent.killThread', or by the system
......
......@@ -3,6 +3,7 @@
, NoImplicitPrelude
, MagicHash
, UnboxedTuples
, UnliftedFFITypes
#-}
{-# OPTIONS_HADDOCK hide #-}
......@@ -50,6 +51,30 @@ import GHC.ConsoleHandler
import Data.Dynamic (toDyn)
#endif
-- Note [rts_setMainThread must be called unsafely]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- rts_setMainThread must be called as unsafe, because it
-- dereferences the Weak# and manipulates the raw Haskell value
-- behind it. Therefore, it must not race with a garbage collection.
-- Note [rts_setMainThread has an unsound type]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- 'rts_setMainThread' is imported with type Weak# ThreadId -> IO (),
-- but this is an unsound type for it: it grabs the /key/ of the
-- 'Weak#' object, which isn't tracked by the type at all.
-- That this works at all is a consequence of the fact that
-- 'mkWeakThreadId' produces a 'Weak#' with a 'ThreadId#' as the key
-- This is fairly robust, in that 'mkWeakThreadId' wouldn't work
-- otherwise, but it still is sufficiently non-trivial to justify an
-- ASSERT in rts/TopHandler.c.
-- see Note [rts_setMainThread must be called unsafely] and
-- Note [rts_setMainThread has an unsound type]
foreign import ccall unsafe "rts_setMainThread"
setMainThread :: Weak# ThreadId -> IO ()
-- | 'runMainIO' is wrapped around 'Main.main' (or whatever main is
-- called in the program). It catches otherwise uncaught exceptions,
-- and also flushes stdout\/stderr before exiting.
......@@ -58,6 +83,7 @@ runMainIO main =
do
main_thread_id <- myThreadId
weak_tid <- mkWeakThreadId main_thread_id
case weak_tid of (Weak w) -> setMainThread w
install_interrupt_handler $ do
m <- deRefWeak weak_tid
case m of
......@@ -149,7 +175,10 @@ real_handler exit se = do
reportStackOverflow
exit 2
Just UserInterrupt -> exitInterrupted
Just UserInterrupt -> exitInterrupted
Just HeapOverflow -> exit 251
-- the RTS has already emitted a message to stderr
_ -> case fromException se of
-- only the main thread gets ExitException exceptions
......
......@@ -129,7 +129,7 @@ void initRtsFlagsDefaults(void)
maxStkSize = 8 * 1024 * 1024;
RtsFlags.GcFlags.statsFile = NULL;
RtsFlags.GcFlags.giveStats = NO_GC_STATS;
RtsFlags.GcFlags.giveStats = COLLECT_GC_STATS;
RtsFlags.GcFlags.maxStkSize = maxStkSize / sizeof(W_);
RtsFlags.GcFlags.initialStkSize = 1024 / sizeof(W_);
......@@ -141,6 +141,7 @@ void initRtsFlagsDefaults(void)
RtsFlags.GcFlags.nurseryChunkSize = 0;
RtsFlags.GcFlags.minOldGenSize = (1024 * 1024) / BLOCK_SIZE;
RtsFlags.GcFlags.maxHeapSize = 0; /* off by default */
RtsFlags.GcFlags.heapLimitGrace = (1024 * 1024);
RtsFlags.GcFlags.heapSizeSuggestion = 0; /* none */
RtsFlags.GcFlags.heapSizeSuggestionAuto = false;
RtsFlags.GcFlags.pcFreeHeap = 3; /* 3% */
......@@ -428,6 +429,11 @@ usage_text[] = {
" -xq The allocation limit given to a thread after it receives",
" an AllocationLimitExceeded exception. (default: 100k)",
"",
" -Mgrace=<n>",
" The amount of allocation after the program receives a",
" HeapOverflow exception before the exception is thrown again, if",
" the program is still exceeding the heap limit.",
"",
"RTS options may also be specified using the GHCRTS environment variable.",
"",
"Other RTS options may be available for programs compiled a different way.",
......@@ -905,11 +911,16 @@ error = true;
case 'M':
OPTION_UNSAFE;
RtsFlags.GcFlags.maxHeapSize =
decodeSize(rts_argv[arg], 2, BLOCK_SIZE, HS_WORD_MAX)
/ BLOCK_SIZE;
/* user give size in *bytes* but "maxHeapSize" is in
* *blocks* */
if (0 == strncmp("grace=", rts_argv[arg] + 2, 6)) {
RtsFlags.GcFlags.heapLimitGrace =
decodeSize(rts_argv[arg], 8, BLOCK_SIZE, HS_WORD_MAX);
} else {
RtsFlags.GcFlags.maxHeapSize =
decodeSize(rts_argv[arg], 2, BLOCK_SIZE, HS_WORD_MAX)
/ BLOCK_SIZE;
// user give size in *bytes* but "maxHeapSize" is in
// *blocks*
}
break;
case 'm':
......
......@@ -36,6 +36,7 @@
#include "LinkerInternals.h"
#include "LibdwPool.h"
#include "sm/CNF.h"
#include "TopHandler.h"
#if defined(PROFILING)
# include "ProfHeap.h"
......@@ -242,6 +243,9 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
getStablePtr((StgPtr)runHandlersPtr_closure);
#endif
// Initialize the top-level handler system
initTopHandler();
/* initialise the shared Typeable store */
initGlobalStore();
......@@ -414,6 +418,9 @@ hs_exit_(bool wait_foreign)
/* free the Static Pointer Table */
exitStaticPtrTable();
/* remove the top-level handler */
exitTopHandler();
/* free the stable pointer table */
exitStableTables();
......
......@@ -10,6 +10,7 @@
#include "RtsSymbols.h"
#include "Rts.h"
#include "TopHandler.h"
#include "HsFFI.h"
#include "sm/Storage.h"
......@@ -747,6 +748,7 @@
SymI_HasProto(rts_setThreadAllocationCounter) \
SymI_HasProto(rts_enableThreadAllocationLimit) \
SymI_HasProto(rts_disableThreadAllocationLimit) \
SymI_HasProto(rts_setMainThread) \
SymI_HasProto(setProgArgv) \
SymI_HasProto(startupHaskell) \
SymI_HasProto(shutdownHaskell) \
......
......@@ -42,6 +42,7 @@
#include "ThreadPaused.h"
#include "Messages.h"
#include "Stable.h"
#include "TopHandler.h"
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
......@@ -72,9 +73,14 @@ StgTSO *blocked_queue_tl = NULL;
StgTSO *sleeping_queue = NULL; // perhaps replace with a hash table?
#endif
/* Set to true when the latest garbage collection failed to reclaim
* enough space, and the runtime should proceed to shut itself down in
* an orderly fashion (emitting profiling info etc.)
// Bytes allocated since the last time a HeapOverflow exception was thrown by
// the RTS
uint64_t allocated_bytes_at_heapoverflow = 0;
/* Set to true when the latest garbage collection failed to reclaim enough
* space, and the runtime should proceed to shut itself down in an orderly
* fashion (emitting profiling info etc.), OR throw an exception to the main
* thread, if it is still alive.
*/
bool heap_overflow = false;
......@@ -1888,24 +1894,46 @@ delete_threads_and_gc:
releaseGCThreads(cap, idle_cap);
}
#endif
if (heap_overflow && sched_state < SCHED_INTERRUPTING) {
// GC set the heap_overflow flag, so we should proceed with
// an orderly shutdown now. Ultimately we want the main
// thread to return to its caller with HeapExhausted, at which
// point the caller should call hs_exit(). The first step is
// to delete all the threads.
//
// Another way to do this would be to raise an exception in
// the main thread, which we really should do because it gives
// the program a chance to clean up. But how do we find the
// main thread? It should presumably be the same one that
// gets ^C exceptions, but that's all done on the Haskell side
// (GHC.TopHandler).
sched_state = SCHED_INTERRUPTING;
goto delete_threads_and_gc;
}
// GC set the heap_overflow flag. We should throw an exception if we
// can, or shut down otherwise.
// Get the thread to which Ctrl-C is thrown
StgTSO *main_thread = getTopHandlerThread();
if (main_thread == NULL) {
// GC set the heap_overflow flag, and there is no main thread to
// throw an exception to, so we should proceed with an orderly
// shutdown now. Ultimately we want the main thread to return to
// its caller with HeapExhausted, at which point the caller should
// call hs_exit(). The first step is to delete all the threads.
sched_state = SCHED_INTERRUPTING;
goto delete_threads_and_gc;
}
heap_overflow = false;
const uint64_t allocation_count = getAllocations();
if (RtsFlags.GcFlags.heapLimitGrace <
allocation_count - allocated_bytes_at_heapoverflow ||
allocated_bytes_at_heapoverflow == 0) {
allocated_bytes_at_heapoverflow = allocation_count;
// We used to simply exit, but throwing an exception gives the
// program a chance to clean up. It also lets the exception be
// caught.
// FIXME this is not a good way to tell a program to release
// resources. It is neither reliable (the RTS crashes if it fails
// to allocate memory from the OS) nor very usable (it is always
// thrown to the main thread, which might not be able to do anything
// useful with it). We really should have a more general way to
// release resources in low-memory conditions. Nevertheless, this
// is still a big improvement over just exiting.
// FIXME again: perhaps we should throw a synchronous exception
// instead an asynchronous one, or have a way for the program to
// register a handler to be called when heap overflow happens.
throwToSelf(cap, main_thread, heapOverflow_closure);
}
}
#ifdef SPARKBALANCE
/* JB
Once we are all together... this would be the place to balance all
......@@ -2608,6 +2636,8 @@ initScheduler(void)
ACQUIRE_LOCK(&sched_mutex);
allocated_bytes_at_heapoverflow = 0;
/* A capability holds the state a native thread needs in
* order to execute STG code. At least one capability is
* floating around (only THREADED_RTS builds have more than one).
......
#include "Rts.h"
#include "Stable.h"
#include "TopHandler.h"
#ifdef THREADED_RTS
static Mutex m; // Protects the operations on topHandlerPtr,
// which aren't atomic
#endif
static StgStablePtr topHandlerPtr;
void rts_setMainThread(StgWeak *weak) {
ACQUIRE_LOCK(&m);
if (topHandlerPtr != NULL) {
freeStablePtr(topHandlerPtr); // OK to do under the lock
}
topHandlerPtr = getStablePtr((StgPtr)weak);
// referent is a Weak#
ASSERT(weak->header.info == &stg_WEAK_info);
// See Note [rts_setMainThread has an unsound type] in
// libraries/base/GHC/TopHandler.hs.
ASSERT(weak->key->header.info == &stg_TSO_info);
RELEASE_LOCK(&m);
}
StgTSO *getTopHandlerThread(void) {
ACQUIRE_LOCK(&m);
StgWeak *weak = (StgWeak*)deRefStablePtr(topHandlerPtr);
RELEASE_LOCK(&m);
const StgInfoTable *info = weak->header.info;
if (info == &stg_WEAK_info) {
StgClosure *key = ((StgWeak*)weak)->key;
// See Note [rts_setMainThread has an unsound type] in
// libraries/base/GHC/TopHandler.hs.
ASSERT(key->header.info == &stg_TSO_info);
return (StgTSO *)key;
} else if (info == &stg_DEAD_WEAK_info) {
return NULL;
} else {
barf("getTopHandlerThread: neither a WEAK nor a DEAD_WEAK: %p %p %d",
weak, info, info->type);
return NULL;
}
}
void initTopHandler(void) {
#ifdef THREADED_RTS
initMutex(&m);
#endif
topHandlerPtr = NULL;
}
void exitTopHandler(void) {
freeStablePtr(topHandlerPtr);
topHandlerPtr = NULL;
#ifdef THREADED_RTS
closeMutex(&m);
#endif
}
/* -----------------------------------------------------------------------------
*
* (c) The GHC Team, 2016
*
* Top-level handler support
*
* ---------------------------------------------------------------------------*/
#include <BeginPrivate.h>
#include <rts/Types.h>
#include <rts/storage/Closures.h>
#include <stg/Types.h>
#include <rts/Stable.h>
// Initialize the top handler subsystem
void initTopHandler(void);
// Exit the top handler subsystem
void exitTopHandler(void);
// Get the thread that handles ctrl-c, etc
// Returns NULL if there is no such thread
StgTSO *getTopHandlerThread(void);
#include <EndPrivate.h>
// Called from Haskell
void rts_setMainThread(StgWeak *ptr);
TOP=../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
T1791:
'$(TEST_HC)' T1791.hs -o T1791 -O -rtsopts
import Control.Exception
force :: [a] -> [a]
force [] = []
force x@(a:b) = x `seq` a : force b
{-# NOINLINE infiniteList #-}
infiniteList :: [Int]
infiniteList = [1..]
heapOverflow :: IO ()
heapOverflow = do
evaluate $ length infiniteList -- Force the list
evaluate infiniteList -- So that the list cannot be garbage collected.
return ()
main :: IO ()
main = heapOverflow `catch` \x -> case x of
HeapOverflow -> putStrLn "Heap overflow caught!"
_ -> throwIO x
T1791: Heap exhausted;
T1791: Current maximum heap size is 8388608 bytes (8 MB).
T1791: Use `+RTS -M<size>' to increase it.
test('T1791',
[ exit_code(0), extra_clean(['T1791.hi', 'T1791']) ],
run_command,
['''"$MAKE" -s --no-print-directory T1791 >/dev/null && ./T1791 +RTS -M8M'''])
"Test.ManyQueue.testManyQueue'1P3C"
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment