wasi_runtime.ml

(* SPDX-License-Identifier: PMPL-1.0-or-later *)
(* SPDX-FileCopyrightText: 2024-2025 hyperpolymath *)

(** WASI runtime support - I/O bindings for WebAssembly System Interface.

    This module provides helper functions to generate WASM code that calls
    WASI system calls for I/O operations.
*)

open Wasm

(** WASI file descriptor constants *)
let fd_stdout = 1l
let fd_stderr = 2l

(** WASI clock-id constants (preview1 `wasi_snapshot_preview1`):
    0 = REALTIME, 1 = MONOTONIC, 2 = PROCESS_CPUTIME, 3 = THREAD_CPUTIME. *)
let clock_realtime = 0l
let clock_monotonic = 1l

(** Create the WASI `clock_time_get` import (ADR-015 S4a, #180).

    Signature: `(clockid: i32, precision: i64, time_out: i32) -> errno: i32`.
    Writes the timestamp (nanoseconds, i64) to `*time_out`. Through the
    S3 componentize on-ramp the wasmtime preview1->preview2 reactor
    adapter bridges this to `wasi:clocks/{monotonic,wall}-clock@0.2.*`
    on a real host. *)
let create_clock_time_get_import () : import * func_type =
  let func_type = {
    ft_params = [I32; I64; I32];  (* clockid, precision, time_out_ptr *)
    ft_results = [I32];           (* errno *)
  } in
  let import = {
    i_module = "wasi_snapshot_preview1";
    i_name = "clock_time_get";
    i_desc = ImportFunc 0;  (* Will be adjusted when added to module *)
  } in
  (import, func_type)

(** Emit a `clock_now_ms(clock_id)` sequence. The caller has placed
    [clock_arg_local] (the `i32` clock id) and allocated
    [scratch_local] (an `i32` heap-pointer local) and threaded the
    import [clock_func_idx]. Leaves the i32 monotonic/realtime
    millisecond count on the stack (= ns / 1_000_000, wrapped to i32 —
    documented lossy: 32-bit ms wraps after ~24 days, sufficient for
    typical use; the precise i64 reader is a follow-up).

    Layout: 8 bytes scratch (the i64 time_out the WASI host writes). *)
let gen_clock_now_ms
    (heap_ptr_global : int) (clock_arg_local : int)
    (scratch_local : int) (clock_func_idx : int)
    : instr list =
  [
    (* scratch = heap; heap += 8 *)
    GlobalGet heap_ptr_global;
    I32Const 8l; I32Add;
    GlobalSet heap_ptr_global;
    GlobalGet heap_ptr_global;
    I32Const 8l; I32Sub;
    LocalSet scratch_local;
    (* clock_time_get(clock_id, 0 /* precision */, scratch); drop errno *)
    LocalGet clock_arg_local;
    I64Const 0L;
    LocalGet scratch_local;
    Call clock_func_idx;
    Drop;
    (* return (i32) (i64_load(scratch) / 1_000_000) *)
    LocalGet scratch_local;
    I64Load (3, 0);
    I64Const 1_000_000L;
    I64DivU;
    I32WrapI64;
  ]

(** Create WASI fd_write import

    fd_write signature: (fd: i32, iovs: i32, iovs_len: i32, nwritten: i32) -> i32

    Returns (import, func_type_index)
*)
let create_fd_write_import () : import * func_type =
  let func_type = {
    ft_params = [I32; I32; I32; I32];  (* fd, iovs_ptr, iovs_len, nwritten_ptr *)
    ft_results = [I32];                 (* error code *)
  } in
  let import = {
    i_module = "wasi_snapshot_preview1";
    i_name = "fd_write";
    i_desc = ImportFunc 0;  (* Will be adjusted when added to module *)
  } in
  (import, func_type)

(** Generate code to print an integer to stdout

    This function:
    1. Converts int to string in memory (digit by digit)
    2. Creates iovec structure pointing to string
    3. Calls WASI fd_write

    Algorithm:
    - Handle negative sign separately
    - Extract digits using division and modulo
    - Write digits in reverse order (most significant first)

    Memory layout:
    - [0..15]: digit buffer (max 11 chars: "-2147483648")
    - [16..23]: iovec struct (buf_ptr, buf_len)
    - [24..27]: nwritten result

    Returns: code that leaves 0 on stack for success
*)
let gen_print_int (heap_ptr_global : int) (fd_write_idx : int) (num_local : int)
    : instr list =
  (* We need additional locals for the conversion:
     - buf_ptr: pointer to start of allocated buffer
     - write_ptr: current position while writing digits (counts backwards)
     - n: the number being converted (copy of num_local)
     - digit: current digit being extracted
     - is_negative: 1 if negative, 0 if positive
     - len: final string length
  *)

  (* Allocate 28 bytes total *)
  let total_size = 28 in
  let buf_local = num_local + 1 in       (* reuse locals after num_local *)
  let write_ptr_local = num_local + 2 in
  let n_local = num_local + 3 in
  let digit_local = num_local + 4 in
  let is_neg_local = num_local + 5 in
  let len_local = num_local + 6 in

  [
    (* Allocate memory *)
    GlobalGet heap_ptr_global;
    I32Const (Int32.of_int total_size);
    I32Add;
    GlobalSet heap_ptr_global;

    (* buf_ptr = heap_ptr - 28 *)
    GlobalGet heap_ptr_global;
    I32Const (Int32.of_int total_size);
    I32Sub;
    LocalTee buf_local;

    (* Copy number to n_local, check if negative *)
    LocalGet num_local;
    LocalTee n_local;
    I32Const 0l;
    I32LtS;  (* n < 0 ? *)
    LocalTee is_neg_local;

    (* If negative, negate n to make it positive *)
    If (BtEmpty, [
      I32Const 0l;
      LocalGet n_local;
      I32Sub;  (* n = -n *)
      LocalSet n_local;
    ], []);

    (* write_ptr starts at buf + 15 (end of buffer, write backwards) *)
    LocalGet buf_local;
    I32Const 15l;
    I32Add;
    LocalSet write_ptr_local;

    (* Extract digits loop - write from right to left *)
    Block (BtEmpty, [
      Loop (BtEmpty, [
        (* digit = n % 10 *)
        LocalGet n_local;
        I32Const 10l;
        I32RemU;
        LocalTee digit_local;

        (* *write_ptr = '0' + digit *)
        I32Const 48l;  (* ASCII '0' *)
        I32Add;
        LocalGet write_ptr_local;
        I32Store (0, 0);

        (* write_ptr-- *)
        LocalGet write_ptr_local;
        I32Const 1l;
        I32Sub;
        LocalSet write_ptr_local;

        (* n = n / 10 *)
        LocalGet n_local;
        I32Const 10l;
        I32DivU;
        LocalTee n_local;

        (* Continue if n > 0 *)
        I32Const 0l;
        I32GtU;
        BrIf 0;
      ])
    ]);

    (* If negative, add '-' sign *)
    LocalGet is_neg_local;
    If (BtEmpty, [
      I32Const 45l;  (* ASCII '-' *)
      LocalGet write_ptr_local;
      I32Store (0, 0);
      LocalGet write_ptr_local;
      I32Const 1l;
      I32Sub;
      LocalSet write_ptr_local;
    ], []);

    (* Calculate length: (buf + 15) - write_ptr *)
    LocalGet buf_local;
    I32Const 15l;
    I32Add;
    LocalGet write_ptr_local;
    I32Sub;
    LocalSet len_local;

    (* Actual string starts at write_ptr + 1 *)
    LocalGet write_ptr_local;
    I32Const 1l;
    I32Add;
    LocalSet write_ptr_local;

    (* Create iovec structure at buf + 16 *)
    (* iovec.buf_ptr = write_ptr (where string actually starts) *)
    LocalGet buf_local;
    I32Const 16l;
    I32Add;
    LocalGet write_ptr_local;
    I32Store (2, 0);

    (* iovec.buf_len = len *)
    LocalGet buf_local;
    I32Const 16l;
    I32Add;
    LocalGet len_local;
    I32Store (2, 4);

    (* Call fd_write(stdout, iovec_ptr, 1, nwritten_ptr) *)
    I32Const fd_stdout;
    LocalGet buf_local;
    I32Const 16l;
    I32Add;                       (* iovs = buf + 16 *)
    I32Const 1l;                  (* iovs_len = 1 *)
    LocalGet buf_local;
    I32Const 24l;
    I32Add;                       (* nwritten = buf + 24 *)
    Call fd_write_idx;

    (* Drop error code, return success *)
    Drop;
    I32Const 0l;
  ]

(** Generate code to print a newline *)
let gen_println (heap_ptr_global : int) (fd_write_idx : int) (temp_local : int)
    : instr list =
  let newline_byte = 10l in  (* ASCII '\n' *)
  (* Layout — every i32 store sits on a 4-byte boundary:
       offset  0..3:  iovec.buf_ptr (i32) — points at offset 12 below
       offset  4..7:  iovec.buf_len (i32) — always 1
       offset  8..11: nwritten     (i32) — fd_write writes here
       offset 12:     newline byte  ('\n', 1 byte)
       offset 13..15: padding so subsequent allocs stay aligned
     Total 16 bytes. The previous layout stored the newline at temp+0 and
     the iovec at temp+1, which traps under wasmtime's strict alignment
     check. *)
  [
    GlobalGet heap_ptr_global;
    I32Const 16l;
    I32Add;
    GlobalSet heap_ptr_global;

    GlobalGet heap_ptr_global;
    I32Const 16l;
    I32Sub;
    LocalSet temp_local;

    (* iovec.buf_ptr = temp + 12 (where the newline byte lives) *)
    LocalGet temp_local;
    LocalGet temp_local;
    I32Const 12l;
    I32Add;
    I32Store (2, 0);

    (* iovec.buf_len = 1 *)
    LocalGet temp_local;
    I32Const 1l;
    I32Store (2, 4);

    (* Write the newline byte at temp + 12. We use I32Store to lay down a
       full 4 bytes — the upper 3 are slack but harmless because fd_write
       only reads buf_len = 1. *)
    LocalGet temp_local;
    I32Const newline_byte;
    I32Store (2, 12);

    (* Call fd_write(stdout, iovec_ptr=temp, iovs_len=1, nwritten_ptr=temp+8) *)
    I32Const fd_stdout;
    LocalGet temp_local;
    I32Const 1l;
    LocalGet temp_local;
    I32Const 8l;
    I32Add;
    Call fd_write_idx;

    Drop;
    I32Const 0l;
  ]

(** Generate code to print a string (length-prefixed in memory).
    String layout: [len: i32][bytes...]
    Returns: code that leaves 0 on stack for success *)
let gen_print_str (heap_ptr_global : int) (str_ptr_local : int) (fd_write_idx : int) (temp_local : int)
    : instr list =
  [
    (* Allocate 12 bytes for iovec + nwritten *)
    GlobalGet heap_ptr_global;
    I32Const 12l;
    I32Add;
    GlobalSet heap_ptr_global;

    GlobalGet heap_ptr_global;
    I32Const 12l;
    I32Sub;
    LocalSet temp_local;

    (* iovec.buf_ptr = str_ptr + 4 *)
    LocalGet temp_local;
    LocalGet str_ptr_local;
    I32Const 4l;
    I32Add;
    I32Store (2, 0);

    (* iovec.buf_len = *str_ptr (length) *)
    LocalGet temp_local;
    I32Const 4l;
    I32Add;
    LocalGet str_ptr_local;
    I32Load (2, 0);
    I32Store (2, 0);

    (* Call fd_write(stdout, iovec_ptr, 1, nwritten_ptr) *)
    I32Const fd_stdout;
    LocalGet temp_local;           (* iovs *)
    I32Const 1l;                   (* iovs_len *)
    LocalGet temp_local;
    I32Const 8l;
    I32Add;                        (* nwritten *)
    Call fd_write_idx;

    Drop;
    I32Const 0l;
  ]