From a38a6219c2706d5f6c2f130764ede91a2b647490 Mon Sep 17 00:00:00 2001
From: haskal <haskal@awoo.systems>
Date: Wed, 14 Oct 2020 22:18:35 -0400
Subject: [PATCH] install top level error escape handler

---
 main_bc.c | 20 +++++++++++++++++---
 run.rkt   |  2 ++
 2 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/main_bc.c b/main_bc.c
index e741e26..5207566 100644
--- a/main_bc.c
+++ b/main_bc.c
@@ -1,6 +1,7 @@
 #define MZ_PRECISE_GC
 
 #include <racket/scheme.h>
+#include <stdint.h>
 #include <stdio.h>
 
 extern const char _binary_app_zo_start;
@@ -56,9 +57,14 @@ static void bc_setup_ffi_table(Scheme_Env* parent) {
 static int run_bc(Scheme_Env* e, int argc, char* argv[]) {
     (void)argc;
     (void)argv;
+    volatile mz_jmp_buf* save;
+    mz_jmp_buf fresh;
+    int rv = 0;
+    size_t load_size = ((uintptr_t) &_binary_app_zo_end) - ((uintptr_t) &_binary_app_zo_start);
     Scheme_Object* l = NULL;
     Scheme_Object* a[2] = { NULL, NULL };
 
+    // gc setup
     MZ_GC_DECL_REG(5);
     MZ_GC_VAR_IN_REG(0, e);
     MZ_GC_VAR_IN_REG(1, l);
@@ -67,7 +73,6 @@ static int run_bc(Scheme_Env* e, int argc, char* argv[]) {
 
     bc_setup_ffi_table(e);
 
-    size_t load_size = ((uintptr_t) &_binary_app_zo_end) - ((uintptr_t) &_binary_app_zo_start);
     scheme_register_embedded_load(load_size, &_binary_app_zo_start);
     scheme_embedded_load(load_size, &_binary_app_zo_start, 1);
 
@@ -78,10 +83,19 @@ static int run_bc(Scheme_Env* e, int argc, char* argv[]) {
     a[0] = l;
     a[1] = scheme_false;
 
-    scheme_dynamic_require(2, a);
+    save = scheme_current_thread->error_buf;
+    scheme_current_thread->error_buf = &fresh;
 
+    if (scheme_setjmp(scheme_error_buf)) {
+        fprintf(stderr, "[WRAPPER] encountered top-level racket error. aborting\n");
+        rv = -1;
+    } else {
+        scheme_dynamic_require(2, a);
+    }
+
+    scheme_current_thread->error_buf = (mz_jmp_buf*) save;
     MZ_GC_UNREG();
-    return 0;
+    return rv;
 }
 
 int main(int argc, char *argv[]) {
diff --git a/run.rkt b/run.rkt
index f1c6f7a..30f1382 100644
--- a/run.rkt
+++ b/run.rkt
@@ -15,3 +15,5 @@
 (displayln "calling")
 (func)
 (displayln "back")
+
+; (error "meow meow")