1 files changed, 27 insertions, 0 deletions
diff --git a/src/libexpr/primops.cc b/src/libexpr/primops.cc
index 0c4381b11..2dd242a43 100644
--- a/src/libexpr/primops.cc
+++ b/src/libexpr/primops.cc
@@ -397,6 +397,32 @@ static void prim_trace(EvalState & state, const Pos & pos, Value * * args, Value
 }
 
 
+#if HAVE_BOEHMGC
+void canaryFinalizer(GC_PTR obj, GC_PTR client_data)
+{
+    Value * v = (Value *) obj;
+    EvalState & state(* (EvalState *) client_data);
+    printMsg(lvlError, format("canary ‘%1%’ garbage-collected") % v->string.s);
+    auto i = state.gcCanaries.find(v);
+    assert(i != state.gcCanaries.end());
+    state.gcCanaries.erase(i);
+}
+#endif
+
+
+void prim_gcCanary(EvalState & state, const Pos & pos, Value * * args, Value & v)
+{
+    string s = state.forceStringNoCtx(*args[0], pos);
+    state.mkList(v, 1);
+    Value * canary = v.list.elems[0] = state.allocValue();
+#if HAVE_BOEHMGC
+    state.gcCanaries.insert(canary);
+    GC_register_finalizer(canary, canaryFinalizer, &state, 0, 0);
+#endif
+    mkString(*canary, s);
+}
+
+
 /*************************************************************
  * Derivations
  *************************************************************/
@@ -1393,6 +1419,7 @@ void EvalState::createBaseEnv()
     addPrimOp("__tryEval", 1, prim_tryEval);
     addPrimOp("__getEnv", 1, prim_getEnv);
     addPrimOp("__trace", 2, prim_trace);
+    addPrimOp("__gcCanary", 1, prim_gcCanary);
 
     // Paths
     addPrimOp("__toPath", 1, prim_toPath);