fsevents: move free to finalizer (ocaml#7312)

turning off dune in watch mode on macos will no longer segfault sporadically Signed-off-by: Etienne Millon <[email protected]> Signed-off-by: Stephen Sherratt <[email protected]> Signed-off-by: Rudi Grinberg <[email protected]>
emillon · Mar 30, 2023 · 66dd937 · 66dd937
1 parent be43ee2
commit 66dd937
Show file tree

Hide file tree

Showing 2 changed files with 30 additions and 9 deletions.
diff --git a/CHANGES.md b/CHANGES.md
@@ -1,3 +1,9 @@
+3.7.1 (unreleased)
+------------------
+
+- Fix segfault on MacOS when dune was being shutdown while in watch mode.
+  (#7312, fixes #6151, @gridbugs, @emillon)
+
 3.7.0.post1 (2023-02-21)
 ------------------------
 

diff --git a/src/fsevents/fsevents_stubs.c b/src/fsevents/fsevents_stubs.c
@@ -39,6 +39,20 @@ static struct custom_operations dune_fsevents_runloop_ops = {
     custom_serialize_default,   custom_deserialize_default,
     custom_compare_ext_default, custom_fixed_length_default};
 
+#define Fsevents_val(v) (*(dune_fsevents_t **)Data_custom_val(v))
+
+static void dune_fsevents_t_finalize(value v_t) {
+  dune_fsevents_t *t = Fsevents_val(v_t);
+  caml_remove_global_root(&t->v_callback);
+  caml_stat_free(t);
+}
+
+static struct custom_operations dune_fsevents_t_ops = {
+    "dune.fsevents.fsevents_t", dune_fsevents_t_finalize,
+    custom_compare_default,     custom_hash_default,
+    custom_serialize_default,   custom_deserialize_default,
+    custom_compare_ext_default, custom_fixed_length_default};
+
 CAMLprim value dune_fsevents_runloop_current(value v_unit) {
   CAMLparam1(v_unit);
   dune_runloop *rl;
@@ -177,13 +191,16 @@ CAMLprim value dune_fsevents_create(value v_paths, value v_latency,
   t->v_callback = v_callback;
   t->stream = stream;
 
-  CAMLreturn(caml_copy_nativeint((intnat)t));
+  value v_ret = caml_alloc_custom(
+      &dune_fsevents_t_ops, sizeof(dune_fsevents_t *), 0, 1);
+  Fsevents_val(v_ret) = t;
+  CAMLreturn(v_ret);
 }
 
 CAMLprim value dune_fsevents_set_exclusion_paths(value v_t, value v_paths) {
   CAMLparam2(v_t, v_paths);
   CAMLlocal1(path);
-  dune_fsevents_t *t = (dune_fsevents_t *)Nativeint_val(v_t);
+  dune_fsevents_t *t = Fsevents_val(v_t);
   CFMutableArrayRef paths = paths_of_list(v_paths);
 
   bool ret = FSEventStreamSetExclusionPaths(t->stream, paths);
@@ -197,7 +214,7 @@ CAMLprim value dune_fsevents_set_exclusion_paths(value v_t, value v_paths) {
 
 CAMLprim value dune_fsevents_start(value v_t, value v_runloop) {
   CAMLparam2(v_t, v_runloop);
-  dune_fsevents_t *t = (dune_fsevents_t *)Nativeint_val(v_t);
+  dune_fsevents_t *t = Fsevents_val(v_t);
   dune_runloop *runloop = Runloop_val(v_runloop);
   t->runloop = runloop;
   FSEventStreamScheduleWithRunLoop(t->stream, runloop->runloop,
@@ -212,19 +229,17 @@ CAMLprim value dune_fsevents_start(value v_t, value v_runloop) {
 
 CAMLprim value dune_fsevents_stop(value v_t) {
   CAMLparam1(v_t);
-  dune_fsevents_t *t = (dune_fsevents_t *)Nativeint_val(v_t);
+  dune_fsevents_t *t = Fsevents_val(v_t);
   FSEventStreamStop(t->stream);
   FSEventStreamInvalidate(t->stream);
   FSEventStreamRelease(t->stream);
-  caml_remove_global_root(&t->v_callback);
-  caml_stat_free(t);
   CAMLreturn(Val_unit);
 }
 
 CAMLprim value dune_fsevents_runloop_get(value v_t) {
   CAMLparam1(v_t);
   CAMLlocal2(v_some, v_runloop);
-  dune_fsevents_t *t = (dune_fsevents_t *)Nativeint_val(v_t);
+  dune_fsevents_t *t = Fsevents_val(v_t);
   if (t->runloop == NULL) {
     CAMLreturn(Val_int(0));
   } else {
@@ -237,7 +252,7 @@ CAMLprim value dune_fsevents_runloop_get(value v_t) {
 
 CAMLprim value dune_fsevents_flush_async(value v_t) {
   CAMLparam1(v_t);
-  dune_fsevents_t *t = (dune_fsevents_t *)Nativeint_val(v_t);
+  dune_fsevents_t *t = Fsevents_val(v_t);
   CAMLlocal1(v_event);
   uint64_t id = FSEventStreamFlushAsync(t->stream);
   v_event = caml_copy_int64(id);
@@ -246,7 +261,7 @@ CAMLprim value dune_fsevents_flush_async(value v_t) {
 
 CAMLprim value dune_fsevents_flush_sync(value v_t) {
   CAMLparam1(v_t);
-  dune_fsevents_t *t = (dune_fsevents_t *)Nativeint_val(v_t);
+  dune_fsevents_t *t = Fsevents_val(v_t);
   caml_release_runtime_system();
   FSEventStreamFlushSync(t->stream);
   caml_acquire_runtime_system();