From 12ad4d417b89462ba8e19a3c7772a931b3a93f0e Mon Sep 17 00:00:00 2001
From: Demi Obenour <demiobenour@gmail.com>
Date: Tue, 10 Jan 2017 13:33:31 -0500
Subject: 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
---
 rts/TopHandler.c | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 62 insertions(+)
 create mode 100644 rts/TopHandler.c

(limited to 'rts/TopHandler.c')

diff --git a/rts/TopHandler.c b/rts/TopHandler.c
new file mode 100644
index 0000000000..ff53b32338
--- /dev/null
+++ b/rts/TopHandler.c
@@ -0,0 +1,62 @@
+#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
+}
-- 
cgit v1.2.1