Wasm runtime: implement more system primitives

runtime/wasm/deps.json

@@ -72,6 +72,15 @@
     "import": ["bindings", "wrap_meth_callback_unsafe"],
     "reaches": ["callback"]
   },
+  {
+    "name": "alloc_times",
+    "export": "caml_alloc_times"
+  },
+  {
+    "name": "times",
+    "import": ["bindings", "times"],
+    "reaches": ["alloc_times"]
+  },
   {
     "name": "alloc_tm",
     "export": "caml_alloc_tm"

runtime/wasm/fs.wat

@@ -28,6 +28,8 @@
       (func $file_exists (param anyref) (result (ref eq))))
    (import "bindings" "is_directory"
       (func $is_directory (param anyref) (result (ref eq))))
+   (import "bindings" "is_file"
+      (func $is_file (param anyref) (result (ref eq))))
    (import "bindings" "rename" (func $rename (param anyref) (param anyref)))
    (import "jslib" "wrap" (func $wrap (param anyref) (result (ref eq))))
    (import "jslib" "unwrap" (func $unwrap (param (ref eq)) (result anyref)))
@@ -162,4 +164,16 @@
          (catch $javascript_exception
             (call $caml_handle_sys_error (pop externref))
             (return (ref.i31 (i32.const 0))))))
+
+   (func (export "caml_sys_is_regular_file")
+      (param $name (ref eq)) (result (ref eq))
+      (try
+         (do
+            (return
+               (call $is_file
+                  (call $unwrap
+                     (call $caml_jsstring_of_string (local.get $name))))))
+         (catch $javascript_exception
+            (call $caml_handle_sys_error (pop externref))
+            (return (ref.i31 (i32.const 0))))))
 )

runtime/wasm/io.wat

@@ -311,6 +311,18 @@
       (param (ref eq) (ref eq)) (result (ref eq))
       (ref.i31 (i32.const 0)))
 
+   (func (export "caml_channel_descriptor")
+      (param $ch (ref eq)) (result (ref eq))
+      (local $fd i32)
+      (local.set $fd
+         (struct.get $channel $fd (ref.cast (ref $channel) (local.get $ch))))
+      (if (i32.eq (local.get $fd) (i32.const -1))
+         (then
+            (call $caml_raise_sys_error
+               (array.new_data $string $bad_file_descriptor
+                  (i32.const 0) (i32.const 19)))))
+      (ref.i31 (local.get $fd)))
+
    (func (export "caml_ml_close_channel")
       (param (ref eq)) (result (ref eq))
       (local $ch (ref $channel))
@@ -601,6 +613,17 @@
                   (struct.get $channel $fd (local.get $ch))))
             (i64.extend_i32_s (struct.get $channel $curr (local.get $ch))))))
 
+(;ZZZ
+   (func $check_valid_offset
+      (param $fd i32) (param $offset i64) (param $prev_offset i64)
+      (if (i32.or (i32.lt_s (local.get $offset (i64.const 0)))
+             (i32.gt_s (local.get $offset)
+                (call $file_size (local.get $fd)))))
+         (then
+            ;;;
+         )))
+;)
+
    (func $caml_seek_in
       (param $ch (ref $channel)) (param $dest i64) (result (ref eq))
       (local $fd i32) (local $offset i64)

runtime/wasm/runtime.js

@@ -70,6 +70,10 @@
 
   const fs_cst = fs?.constants;
 
+  const access_flags = fs
+    ? [fs_cst.R_OK, fs_cst.W_OK, fs_cst.X_OK, fs_cst.F_OK]
+    : [];
+
   const open_flags = fs
     ? [
         fs_cst.O_RDONLY,
@@ -374,6 +378,14 @@
       return pad ? " " + s : s;
     },
     gettimeofday: () => new Date().getTime() / 1000,
+    times: () => {
+      if (globalThis.process?.cpuUsage) {
+        var t = globalThis.process.cpuUsage();
+        return caml_alloc_times(t.user / 1e6, t.system / 1e6);
+      } else {
+        return call_alloc_times(performance.now() / 1000);
+      }
+    },
     gmtime: (t) => {
       var d = new Date(t * 1000);
       var d_num = d.getTime();
@@ -417,6 +429,11 @@
     mktime: (year, month, day, h, m, s) =>
       new Date(year, month, day, h, m, s).getTime(),
     random_seed: () => crypto.getRandomValues(new Int32Array(12)),
+    access: (p, flags) =>
+      fs.accessSync(
+        p,
+        access_flags.reduce((f, v, i) => (flags & (1 << i) ? f | v : f), 0),
+      ),
     open: (p, flags, perm) =>
       fs.openSync(
         p,
@@ -432,6 +449,7 @@
           ),
           l),
     read: (fd, b, o, l, p) => fs.readSync(fd, b, o, l, p),
+    fsync: (fd) => fs.fsyncSync(fd),
     file_size: (fd) => fs.fstatSync(fd, { bigint: true }).size,
     register_channel,
     unregister_channel,
@@ -440,6 +458,7 @@
     argv: () => (isNode ? process.argv.slice(1) : ["a.out"]),
     on_windows: () => on_windows,
     getenv: (n) => (isNode ? process.env[n] : null),
+    putenv: (n, v) => process.env[n] = v,
     system: (c) => {
       var res = require("node:child_process").spawnSync(c, {
         shell: true,
@@ -454,13 +473,25 @@
     chdir: (x) => process.chdir(x),
     mkdir: (p, m) => fs.mkdirSync(p, m),
     rmdir: (p) => fs.rmdirSync(p),
+    link: (d, s) => fs.linkSync(d, s),
+    symlink: (t, p, kind) => fs.symlinkSync(t, p, [null, "file", "dir"][kind]),
+    readlink: (p) => fs.readlinkSync(p),
     unlink: (p) => fs.unlinkSync(p),
     read_dir: (p) => fs.readdirSync(p),
+    opendir: (p) => fs.opendirSync(p),
+    readdir: (d) => {
+      var n = d.readSync()?.name;
+      return n === undefined ? null : n;
+    },
+    closedir: (d) => d.closeSync(),
     stat: (p, l) => alloc_stat(fs.statSync(p), l),
     lstat: (p, l) => alloc_stat(fs.lstatSync(p), l),
     fstat: (fd, l) => alloc_stat(fs.fstatSync(fd), l),
+    chmod: (p, perms) => fs.chmodSync(p, perms),
+    fchmod: (p, perms) => fs.fchmodSync(p, perms),
     file_exists: (p) => +fs.existsSync(p),
     is_directory: (p) => +fs.lstatSync(p).isDirectory(),
+    is_file: (p) => +fs.lstatSync(p).isFile(),
     utimes: (p, a, m) => fs.utimesSync(p, a, m),
     truncate: (p, l) => fs.truncateSync(p, l),
     ftruncate: (fd, l) => fs.ftruncateSync(fd, l),
@@ -586,6 +617,7 @@
 
   var {
     caml_callback,
+    caml_alloc_times,
     caml_alloc_tm,
     caml_alloc_stat,
     caml_start_fiber,

runtime/wasm/sys.wat

@@ -37,6 +37,8 @@
    (import "fail" "caml_raise_not_found" (func $caml_raise_not_found))
    (import "bindings" "argv" (func $argv (result (ref extern))))
    (import "bindings" "on_windows" (func $on_windows (result i32)))
+   (import "bindings" "isatty"
+      (func $isatty (param (ref eq)) (result (ref eq))))
    (import "bindings" "system" (func $system (param anyref) (result (ref eq))))
    (import "bindings" "getenv" (func $getenv (param anyref) (result anyref)))
    (import "bindings" "time" (func $time (result f64)))
@@ -48,6 +50,8 @@
       (tag $javascript_exception (param externref)))
    (import "jsstring" "jsstring_test"
       (func $jsstring_test (param anyref) (result i32)))
+   (import "io" "caml_channel_descriptor"
+      (func $caml_channel_descriptor (param (ref eq)) (result (ref eq))))
 
    (type $block (array (mut (ref eq))))
    (type $string (array (mut i8)))
@@ -162,8 +166,8 @@
          (ref.i31 (i32.const 0))))
 
    (func (export "caml_sys_isatty")
-      (param (ref eq)) (result (ref eq))
-      (ref.i31 (i32.const 0)))
+      (param $ch (ref eq)) (result (ref eq))
+      (return_call $isatty (call $caml_channel_descriptor (local.get $ch))))
 
    (func (export "caml_runtime_variant") (param (ref eq)) (result (ref eq))
       (array.new_fixed $string 0))