Complete and fix the Miou_solo5 module

lib/miou_solo5.ml

@@ -137,7 +137,6 @@ module Handles = struct
     tbl.contents <- contents
 
   let add tbl k v = tbl.contents <- (k, v) :: tbl.contents
-  let clear tbl = tbl.contents <- []
   let create _ = { contents= [] }
 
   let append t k v =
@@ -158,17 +157,13 @@ end
 
 type elt = { time: int; syscall: Miou.syscall; mutable cancelled: bool }
 
-module Heapq = struct
+module Heapq = Miou.Pqueue.Make (struct
-  include Miou.Pqueue.Make (struct
     type t = elt
 
     let dummy = { time= 0; syscall= Obj.magic (); cancelled= false }
     let compare { time= a; _ } { time= b; _ } = Int.compare a b
   end)
 
-  let rec drop heapq = try delete_min_exn heapq; drop heapq with _ -> ()
-end
-
 type action = Rd of arguments | Wr of arguments
 
 and arguments = {
@@ -186,24 +181,14 @@ type domain = {
 }
 
 let domain =
-  let rec split_from_parent v =
-    Handles.clear v.handles;
-    Heapq.drop v.sleepers;
-    Queue.clear v.blocks;
-    make ()
-  and make () =
   {
     handles= Handles.create 0x100
   ; sleepers= Heapq.create ()
   ; blocks= Queue.create ()
   }
-  in
-  let key = Stdlib.Domain.DLS.new_key ~split_from_parent make in
-  fun () -> Stdlib.Domain.DLS.get key
 
 let blocking_read fd =
   let syscall = Miou.syscall () in
-  let domain = domain () in
   Log.debug (fun m -> m "append [%d] as a reader" fd);
   Handles.append domain.handles fd syscall;
   Miou.suspend syscall
@@ -297,7 +282,6 @@ module Block = struct
         t.pagesize;
     let syscall = Miou.syscall () in
     let args = { t; bstr; off; syscall; cancelled= false } in
-    let domain = domain () in
     Queue.push (Rd args) domain.blocks;
     Miou.suspend syscall
 
@@ -313,7 +297,6 @@ module Block = struct
         t.pagesize;
     let syscall = Miou.syscall () in
     let args = { t; bstr; off; syscall; cancelled= false } in
-    let domain = domain () in
     Queue.push (Wr args) domain.blocks;
     Miou.suspend syscall
 end
@@ -328,20 +311,20 @@ external clock_wall : unit -> (int[@untagged])
 
 let sleep until =
   let syscall = Miou.syscall () in
-  let domain = domain () in
   let elt = { time= clock_monotonic () + until; syscall; cancelled= false } in
   Heapq.insert elt domain.sleepers;
   Miou.suspend syscall
 
 (* poll part of Miou_solo5 *)
 
-let rec sleeper domain =
+let rec sleeper () =
   match Heapq.find_min_exn domain.sleepers with
   | exception Heapq.Empty -> None
   | { cancelled= true; _ } ->
       Heapq.delete_min_exn domain.sleepers;
-      sleeper domain
+      sleeper ()
-  | { time; _ } -> Some time
+  | { time; _ } ->
+      Some time
 
 let in_the_past t = t == 0 || t <= clock_monotonic ()
 
@@ -375,23 +358,24 @@ let rec consume_block domain signals =
   | Wr { t; bstr; off; syscall; _ } ->
       Block.unsafe_write t ~off bstr;
       Miou.signal syscall :: signals
+  | exception Queue.Empty -> signals
 
 let clean domain uids =
-  let to_keep syscall =
+  let to_delete syscall =
     let uid = Miou.uid syscall in
-    List.exists (fun uid' -> uid != uid') uids
+    List.exists (fun uid' -> uid == uid') uids
   in
   let fn0 (handle, syscalls) =
-    match List.filter to_keep syscalls with
+    match List.filter (Fun.negate to_delete) syscalls with
     | [] -> None
     | syscalls -> Some (handle, syscalls)
   in
   let fn1 (({ syscall; _ } : elt) as elt) =
-    if not (to_keep syscall) then elt.cancelled <- true
+    if to_delete syscall then elt.cancelled <- true
   in
   let fn2 = function
     | Rd ({ syscall; _ } as elt) | Wr ({ syscall; _ } as elt) ->
-        if not (to_keep syscall) then elt.cancelled <- true
+        if to_delete syscall then elt.cancelled <- true
   in
   Handles.filter_map fn0 domain.handles;
   Heapq.iter fn1 domain.sleepers;
@@ -403,8 +387,8 @@ external miou_solo5_yield : (int[@untagged]) -> (int[@untagged])
 
 type waiting = Infinity | Yield | Sleep
 
-let wait_for ~block domain =
+let wait_for ~block =
-  match (sleeper domain, block) with
+  match (sleeper (), block) with
   | None, true -> Infinity
   | (None | Some _), false -> Yield
   | Some point, true ->
@@ -432,11 +416,10 @@ let wait_for ~block domain =
    writing, on the other hand, is direct. *)
 
 let select ~block cancelled_syscalls =
-  let domain = domain () in
   clean domain cancelled_syscalls;
   let handles = ref 0 in
   let rec go signals =
-    match wait_for ~block domain with
+    match wait_for ~block with
     | Infinity ->
         (* Miou tells us we can wait forever ([block = true]) and we have no
            sleepers. So we're going to: take action on the block devices and ask

lib/miou_solo5.mli

@@ -21,14 +21,14 @@
     Writing a packet to the net device is direct and failsafe. In other words,
     we don't need to wait for anything to happen before writing to the net
     device (if an error occurs on your host system, the Solo5 tender will fail
-    - and by extension, so will your unikernel). So, from the scheduler's point
+    \- and by extension, so will your unikernel). So, from the scheduler's point
     of view, writing to the net device is atomic and is never suspended by the
     scheduler in order to have the opportunity to execute other tasks.
 
     However, this is not the case when reading the net device. You might expect
     to read packages, but they might not be available at the time you try to
     read them. Miou_solo5 will make a first attempt at reading and if it fails,
-    the scheduler will ‘suspend’ the reading task (and everything that follows
+    the scheduler will "suspend" the reading task (and everything that follows
     from it) to observe at another point in the life of unikernel whether a
     packet has just arrived.
 

lib/stubs.solo5.c

@@ -1,7 +1,9 @@
 #include "solo5.h"
 
-#include <caml/memory.h>
 #include <caml/bigarray.h>
+#include <caml/memory.h>
+#include <caml/callback.h>
+#include <string.h>
 
 /* We currently have no need for these functions. They consist of releasing the
  * GC lock when we do operations with Solo5 with bigstrings, because of the
@@ -20,8 +22,7 @@ extern void caml_leave_blocking_section(void);
  * solo5_handle_set_t, which can only contain file-descriptors with a value
  * between 0 and 63. */
 
-intnat miou_solo5_block_read(intnat fd, intnat off, intnat len,
+intnat miou_solo5_block_read(intnat fd, intnat off, intnat len, value vbstr) {
-                             value vbstr) {
   solo5_handle_t handle = fd;
   solo5_off_t offset = off;
   size_t size = len;
@@ -31,8 +32,7 @@ intnat miou_solo5_block_read(intnat fd, intnat off, intnat len,
   return result;
 }
 
-intnat miou_solo5_block_write(intnat fd, intnat off, intnat len,
+intnat miou_solo5_block_write(intnat fd, intnat off, intnat len, value vbstr) {
-                              value vbstr) {
   solo5_handle_t handle = fd;
   solo5_off_t offset = off;
   size_t size = len;
@@ -48,8 +48,8 @@ intnat miou_solo5_block_write(intnat fd, intnat off, intnat len,
  * small buffer and, on the OCaml side, we just need to read it. It's a bit
  * like the poor man's C-style reference passage in OCaml. */
 
-intnat miou_solo5_net_read(intnat fd, intnat off, intnat len,
+intnat miou_solo5_net_read(intnat fd, intnat off, intnat len, value vread_size,
-                           value vread_size, value vbstr) {
+                           value vbstr) {
   CAMLparam1(vread_size);
   solo5_handle_t handle = fd;
   size_t size = len;
@@ -61,8 +61,7 @@ intnat miou_solo5_net_read(intnat fd, intnat off, intnat len,
   CAMLreturn(Val_long(result));
 }
 
-intnat miou_solo5_net_write(intnat fd, intnat off, intnat len,
+intnat miou_solo5_net_write(intnat fd, intnat off, intnat len, value vbstr) {
-                            value vbstr) {
   solo5_handle_t handle = fd;
   size_t size = len;
   solo5_result_t result;
@@ -70,3 +69,40 @@ intnat miou_solo5_net_write(intnat fd, intnat off, intnat len,
   result = solo5_net_write(handle, buf, size);
   return result;
 }
+
+intnat miou_solo5_yield(intnat ts) {
+  solo5_time_t deadline = ts;
+  solo5_handle_set_t handles;
+  solo5_yield(deadline, &handles);
+  return handles;
+}
+
+#ifndef __unused
+# if defined(_MSC_VER) && _MSC_VER >= 1500
+#  define __unused(x) __pragma( warning (push) ) \
+    __pragma( warning (disable:4189 ) ) \
+    x \
+    __pragma( warning (pop))
+# else
+#  define __unused(x) x __attribute__((unused))
+# endif
+#endif
+#define __unit() value __unused(unit)
+
+intnat miou_solo5_clock_monotonic(__unit ()) {
+  return (solo5_clock_monotonic());
+}
+
+intnat miou_solo5_clock_wall(__unit ()) {
+  return (solo5_clock_wall());
+}
+
+extern void _nolibc_init(uintptr_t, size_t);
+static char *unused_argv[] = { "uniker.ml", NULL };
+
+int solo5_app_main(const struct solo5_start_info *si)  {
+  _nolibc_init(si->heap_start, si->heap_size);
+  caml_startup(unused_argv);
+
+  return (0);
+}