Runtime: fix memory leak wrt channels

Author: hhugo

CHANGES.md

@@ -8,6 +8,7 @@
 
 ## Bug fixes
 * Fix small bug in global data flow analysis (#1768)
+* Runtime: no longer leak channels
 
 # 5.9.1 (02-12-2024) - Lille
 

dune-project

@@ -20,7 +20,7 @@
  (depends
   (ocaml (and (>= 4.08) (< 5.4)))
   (num :with-test)
-  (ppx_expect (and (>= v0.14.2) :with-test))
+  (ppx_expect (and (>= v0.16.1) :with-test))
   (ppxlib (>= 0.15.0))
   (re :with-test)
   (cmdliner (>= 1.1.0))

js_of_ocaml-compiler.opam

@@ -15,7 +15,7 @@ depends: [
   "dune" {>= "3.17"}
   "ocaml" {>= "4.08" & < "5.4"}
   "num" {with-test}
-  "ppx_expect" {>= "v0.14.2" & with-test}
+  "ppx_expect" {>= "v0.16.1" & with-test}
   "ppxlib" {>= "0.15.0"}
   "re" {with-test}
   "cmdliner" {>= "1.1.0"}

runtime/js/io.js

@@ -25,12 +25,17 @@ var caml_sys_fds = new Array(3);
 //Provides: caml_sys_close
 //Requires: caml_sys_fds
 function caml_sys_close(fd) {
-  var file = caml_sys_fds[fd];
-  if (file) file.close();
+  var x = caml_sys_fds[fd];
+  if (x && x.file) x.file.close();
   delete caml_sys_fds[fd];
   return 0;
 }
 
+//Provides: MlChanid
+function MlChanid(id) {
+  this.id = id;
+}
+
 //Provides: caml_sys_open
 //Requires: caml_raise_sys_error
 //Requires: MlFakeFd_out
@@ -39,11 +44,16 @@ function caml_sys_close(fd) {
 //Requires: fs_node_supported
 //Requires: caml_sys_fds
 //Requires: caml_sys_open_for_node
+//Requires: MlChanid
 function caml_sys_open_internal(file, idx) {
+  var chanid;
   if (idx === undefined) {
     idx = caml_sys_fds.length;
-  }
-  caml_sys_fds[idx] = file;
+    chanid = new MlChanid(idx);
+  } else if (caml_sys_fds[idx]) {
+    chanid = caml_sys_fds[idx].chanid;
+  } else chanid = new MlChanid(idx);
+  caml_sys_fds[idx] = { file: file, chanid: chanid };
   return idx | 0;
 }
 function caml_sys_open(name, flags, _perms) {
@@ -125,41 +135,59 @@ function caml_ml_set_channel_name(chanid, name) {
 }
 
 //Provides: caml_ml_channels
-var caml_ml_channels = new Array();
+//Requires: MlChanid
+function caml_ml_channels_state() {
+  this.map = new globalThis.WeakMap();
+  this.opened = new globalThis.Set();
+}
+caml_ml_channels_state.prototype.close = function (chanid) {
+  this.opened.delete(chanid);
+};
+caml_ml_channels_state.prototype.get = function (chanid) {
+  return this.map.get(chanid);
+};
+caml_ml_channels_state.prototype.set = function (chanid, val) {
+  if (val.opened) this.opened.add(chanid);
+  return this.map.set(chanid, val);
+};
+caml_ml_channels_state.prototype.all = function () {
+  return this.opened.values();
+};
+
+var caml_ml_channels = new caml_ml_channels_state();
+
+//Provides: caml_ml_channel_get
+//Requires: caml_ml_channels
+function caml_ml_channel_get(id) {
+  return caml_ml_channels.get(id);
+}
 
 //Provides: caml_ml_channel_redirect
 //Requires: caml_ml_channel_get, caml_ml_channels
 function caml_ml_channel_redirect(captured, into) {
   var to_restore = caml_ml_channel_get(captured);
   var new_ = caml_ml_channel_get(into);
-  caml_ml_channels[captured] = new_; // XXX
+  caml_ml_channels.set(captured, new_);
   return to_restore;
 }
 
 //Provides: caml_ml_channel_restore
 //Requires: caml_ml_channels
 function caml_ml_channel_restore(captured, to_restore) {
-  caml_ml_channels[captured] = to_restore; // XXX
+  caml_ml_channels.set(captured, to_restore);
   return 0;
 }
 
-//Provides: caml_ml_channel_get
-//Requires: caml_ml_channels
-function caml_ml_channel_get(id) {
-  return caml_ml_channels[id]; // XXX
-}
-
 //Provides: caml_ml_out_channels_list
 //Requires: caml_ml_channels
+//Requires: caml_ml_channel_get
+//Requires: caml_sys_fds
 function caml_ml_out_channels_list() {
   var l = 0;
-  for (var c = 0; c < caml_ml_channels.length; c++) {
-    if (
-      caml_ml_channels[c] &&
-      caml_ml_channels[c].opened &&
-      caml_ml_channels[c].out
-    )
-      l = [0, caml_ml_channels[c].fd, l];
+  var keys = caml_ml_channels.all();
+  for (var k of keys) {
+    var chan = caml_ml_channel_get(k);
+    if (chan.opened && chan.out) l = [0, k, l];
   }
   return l;
 }
@@ -169,7 +197,9 @@ function caml_ml_out_channels_list() {
 //Requires: caml_raise_sys_error
 //Requires: caml_sys_open
 function caml_ml_open_descriptor_out(fd) {
-  var file = caml_sys_fds[fd];
+  var s = caml_sys_fds[fd],
+    file = s.file,
+    chanid = s.chanid;
   if (file.flags.rdonly) caml_raise_sys_error("fd " + fd + " is readonly");
   var buffered = file.flags.buffered !== undefined ? file.flags.buffered : 1;
   var channel = {
@@ -182,16 +212,18 @@ function caml_ml_open_descriptor_out(fd) {
     buffer: new Uint8Array(65536),
     buffered: buffered,
   };
-  caml_ml_channels[channel.fd] = channel;
-  return channel.fd;
+  caml_ml_channels.set(chanid, channel);
+  return chanid;
 }
 
 //Provides: caml_ml_open_descriptor_in
 //Requires: caml_ml_channels, caml_sys_fds
 //Requires: caml_raise_sys_error
 //Requires: caml_sys_open
 function caml_ml_open_descriptor_in(fd) {
-  var file = caml_sys_fds[fd];
+  var s = caml_sys_fds[fd],
+    file = s.file,
+    chanid = s.chanid;
   if (file.flags.wronly) caml_raise_sys_error("fd " + fd + " is writeonly");
   var refill = null;
   var channel = {
@@ -205,8 +237,8 @@ function caml_ml_open_descriptor_in(fd) {
     buffer: new Uint8Array(65536),
     refill: refill,
   };
-  caml_ml_channels[channel.fd] = channel;
-  return channel.fd;
+  caml_ml_channels.set(chanid, channel);
+  return chanid;
 }
 
 //Provides: caml_ml_open_descriptor_in_with_flags
@@ -253,10 +285,12 @@ function caml_ml_is_binary_mode(chanid) {
 //Provides: caml_ml_close_channel
 //Requires: caml_ml_flush, caml_ml_channel_get
 //Requires: caml_sys_close
+//Requires: caml_ml_channels
 function caml_ml_close_channel(chanid) {
   var chan = caml_ml_channel_get(chanid);
   if (chan.opened) {
     chan.opened = false;
+    caml_ml_channels.close(chanid);
     caml_sys_close(chan.fd);
     chan.fd = -1;
     chan.buffer = new Uint8Array(0);

runtime/js/parsing.js

@@ -24,6 +24,7 @@ var caml_parser_trace = 0;
 //Requires: caml_lex_array, caml_parser_trace,caml_jsstring_of_string
 //Requires: caml_ml_output, caml_ml_string_length, caml_string_of_jsbytes
 //Requires: caml_jsbytes_of_string, MlBytes
+//Requires: caml_sys_fds
 function caml_parse_engine(tables, env, cmd, arg) {
   var ERRCODE = 256;
 
@@ -82,7 +83,7 @@ function caml_parse_engine(tables, env, cmd, arg) {
 
   function log(x) {
     var s = caml_string_of_jsbytes(x + "\n");
-    caml_ml_output(2, s, 0, caml_ml_string_length(s));
+    caml_ml_output(caml_sys_fds[2].chanid, s, 0, caml_ml_string_length(s));
   }
 
   function token_name(names, number) {