From fac47e8ecb550557ee2caa6cedd3545a5a281b03 Mon Sep 17 00:00:00 2001
From: Calvin Rose <calsrose@gmail.com>
Date: Tue, 17 Mar 2020 18:55:32 -0500
Subject: [PATCH] When marshalling a closure, try to detach funcenvs

If possible, this will reduce the need to marshal fibers
in many cases. Also add this logic to the GC so holding a closure
that originally came from a fiber that crashed does not cause that fiber
to hang around forever.
---
 src/core/fiber.c | 18 ++++++++++++++++++
 src/core/fiber.h |  1 +
 src/core/gc.c    |  4 ++++
 src/core/marsh.c |  1 +
 4 files changed, 24 insertions(+)

diff --git a/src/core/fiber.c b/src/core/fiber.c
index 6a4c140c..5370e7a5 100644
--- a/src/core/fiber.c
+++ b/src/core/fiber.c
@@ -230,6 +230,24 @@ static void janet_env_detach(JanetFuncEnv *env) {
     }
 }
 
+/* Detach a fiber from the env if the target fiber has stopped mutating */
+void janet_env_maybe_detach(JanetFuncEnv *env) {
+    /* Check for detachable closure envs */
+    if (env->offset) {
+        JanetFiberStatus s = janet_fiber_status(env->as.fiber);
+        int isFinished = s == JANET_STATUS_DEAD ||
+                         s == JANET_STATUS_ERROR ||
+                         s == JANET_STATUS_USER0 ||
+                         s == JANET_STATUS_USER1 ||
+                         s == JANET_STATUS_USER2 ||
+                         s == JANET_STATUS_USER3 ||
+                         s == JANET_STATUS_USER4;
+        if (isFinished) {
+            janet_env_detach(env);
+        }
+    }
+}
+
 /* Create a tail frame for a function */
 int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
     int32_t i;
diff --git a/src/core/fiber.h b/src/core/fiber.h
index 8afbe3f7..50daf0f1 100644
--- a/src/core/fiber.h
+++ b/src/core/fiber.h
@@ -73,5 +73,6 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func);
 int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func);
 void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun);
 void janet_fiber_popframe(JanetFiber *fiber);
+void janet_env_maybe_detach(JanetFuncEnv *env);
 
 #endif
diff --git a/src/core/gc.c b/src/core/gc.c
index ba3e3400..1f0a551a 100644
--- a/src/core/gc.c
+++ b/src/core/gc.c
@@ -27,6 +27,7 @@
 #include "symcache.h"
 #include "gc.h"
 #include "util.h"
+#include "fiber.h"
 #endif
 
 struct JanetScratch {
@@ -189,6 +190,9 @@ static void janet_mark_funcenv(JanetFuncEnv *env) {
     if (janet_gc_reachable(env))
         return;
     janet_gc_mark(env);
+    /* If closure env references a dead fiber, we can just copy out the stack frame we need so
+     * we don't need to keep around the whole dead fiber. */
+    janet_env_maybe_detach(env);
     if (env->offset) {
         /* On stack */
         janet_mark_fiber(env->as.fiber);
diff --git a/src/core/marsh.c b/src/core/marsh.c
index 1af1ba9f..b2bb15c2 100644
--- a/src/core/marsh.c
+++ b/src/core/marsh.c
@@ -184,6 +184,7 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
         }
     }
     janet_v_push(st->seen_envs, env);
+    janet_env_maybe_detach(env);
     pushint(st, env->offset);
     pushint(st, env->length);
     if (env->offset) {