Add some tests

dune-project

@@ -1,2 +1,3 @@
 (lang dune 3.0)
 (name miou-solo5)
+(cram enable)

lib/miou_solo5.ml

@@ -44,13 +44,21 @@ let bigstring_blit_from_string src ~src_off dst ~dst_off ~len =
     bigstring_set_uint8 dst (dst_off + i) v
   done
 
+external miou_solo5_net_acquire :
+     string
+  -> bytes
+  -> bytes
+  -> bytes
+  -> (int[@untagged]) = "unimplemented" "miou_solo5_net_acquire"
+[@@noalloc]
+
 external miou_solo5_net_read :
      (int[@untagged])
   -> bigstring
   -> (int[@untagged])
   -> (int[@untagged])
   -> bytes
-  -> int = "unimplemented" "miou_solo5_net_read"
+  -> (int[@untagged]) = "unimplemented" "miou_solo5_net_read"
 [@@noalloc]
 
 external miou_solo5_net_write :
@@ -61,6 +69,14 @@ external miou_solo5_net_write :
   -> (int[@untagged]) = "unimplemented" "miou_solo5_net_write"
 [@@noalloc]
 
+external miou_solo5_block_acquire :
+     string
+  -> bytes
+  -> bytes
+  -> bytes
+  -> (int[@untagged]) = "unimplemented" "miou_solo5_block_acquire"
+[@@noalloc]
+
 external miou_solo5_block_read :
      (int[@untagged])
   -> (int[@untagged])
@@ -80,10 +96,24 @@ external miou_solo5_block_write :
 external unsafe_get_int64_ne : bytes -> int -> int64 = "%caml_bytes_get64u"
 
 let invalid_argf fmt = Format.kasprintf invalid_arg fmt
+let failwithf fmt = Format.kasprintf failwith fmt
+let error_msgf fmt = Format.kasprintf (fun msg -> Error (`Msg msg)) fmt
 
 module Block_direct = struct
   type t = { handle: int; pagesize: int }
 
+  let connect name =
+    let handle = Bytes.make 8 '\000' in
+    let _len = Bytes.make 8 '\000' in
+    let pagesize = Bytes.make 8 '\000' in
+    match miou_solo5_block_acquire name handle _len pagesize with
+    | 0 ->
+        let handle = Int64.to_int (Bytes.get_int64_ne handle 0) in
+        let _len = Int64.to_int (Bytes.get_int64_ne _len 0) in
+        let pagesize = Int64.to_int (Bytes.get_int64_ne pagesize 0) in
+        Ok { handle; pagesize }
+    | _ -> error_msgf "Impossible to connect the block-device %s" name
+
   let unsafe_read t ~off bstr =
     match miou_solo5_block_read t.handle off t.pagesize bstr with
     | 0 -> ()
@@ -195,16 +225,31 @@ let blocking_read fd =
 
 module Net = struct
   type t = int
+  type mac = string
+  type cfg = { mac : mac; mtu : int }
 
-  let rec read t ~off ~len bstr =
-    let read_size = Bytes.make 8 '\000' in
-    let result = miou_solo5_net_read t bstr off len read_size in
-    let read_size = Int64.to_int (unsafe_get_int64_ne read_size 0) in
-    match result with
-    | 0 -> read_size
-    | 1 -> blocking_read t; read t ~off ~len bstr
-    | 2 -> invalid_arg "Miou_solo5.Net.read"
-    | _ -> assert false (* UNSPEC *)
+  let connect name =
+    let handle = Bytes.make 8 '\000' in
+    let mac = Bytes.make 6 '\000' in
+    let mtu = Bytes.make 8 '\000' in
+    match miou_solo5_net_acquire name handle mac mtu with
+    | 0 ->
+        let handle = Int64.to_int (Bytes.get_int64_ne handle 0) in
+        let mac = Bytes.unsafe_to_string mac in
+        let mtu = Int64.to_int (Bytes.get_int64_ne mtu 0) in
+        Ok (handle, { mac; mtu })
+    | _ -> error_msgf "Impossible to connect the net-device %s" name
+
+  let read t ~off ~len bstr =
+    let rec go read_size =
+      let result = miou_solo5_net_read t bstr off len read_size in
+      match result with
+      | 0 -> Int64.to_int (unsafe_get_int64_ne read_size 0)
+      | 1 -> blocking_read t; go read_size
+      | 2 -> invalid_arg "Miou_solo5.Net.read"
+      | _ -> assert false (* UNSPEC *)
+    in
+    go (Bytes.make 8 '\000')
 
   let read_bigstring t ?(off = 0) ?len bstr =
     let len =
@@ -215,14 +260,28 @@ module Net = struct
     read t ~off ~len bstr
 
   let read_bytes =
+    (* NOTE(dinosaure): Using [bstr] as a global is safe for 2 reasons. We
+       don't have several domains with Solo5, so there can't be a data-race on
+       this value. Secondly, we ensure that as soon as Solo5 writes to it, we
+       save the bytes in the buffer given by the user without giving the
+       scheduler a chance to execute another task (such as another
+       [read_bytes]). *)
     let bstr = Bigarray.(Array1.create char c_layout 0x7ff) in
     fun t ?(off = 0) ?len buf ->
+      let read_size = Bytes.make 8 '\000' in
       let rec go dst_off dst_len =
         if dst_len > 0 then begin
           let len = Int.min (Bigarray.Array1.dim bstr) dst_len in
-          let len = read_bigstring t ~off:0 ~len bstr in
-          bigstring_blit_to_bytes bstr ~src_off:0 buf ~dst_off ~len;
-          if len > 0 then go (dst_off + len) (dst_len - len) else dst_off - off
+          let result = miou_solo5_net_read t bstr off len read_size in
+          match result with
+          | 0 ->
+            let len = Int64.to_int (unsafe_get_int64_ne read_size 0) in
+            bigstring_blit_to_bytes bstr ~src_off:0 buf ~dst_off ~len;
+            if len > 0 then go (dst_off + len) (dst_len - len) else dst_off - off
+          | 1 ->
+            blocking_read t; go dst_off dst_len
+          | 2 -> invalid_arg "Miou_solo5.Net.read"
+          | _ -> assert false (* UNSPEC *)
         end
         else dst_off - off
       in
@@ -449,4 +508,30 @@ let select ~block cancelled_syscalls =
   collect_sleepers domain signals
 
 let events _domain = { Miou.interrupt= ignore; select; finaliser= ignore }
-let run ?g fn = Miou.run ~events ?g ~domains:0 fn
+
+type 'a device =
+  | Net : string -> (Net.t * Net.cfg) device
+  | Block : string -> Block.t device
+
+let net name = Net name
+let block name = Block name
+
+type ('k, 'res) devices =
+  | [] : (unit -> 'res, 'res) devices
+  | ( :: ) : 'a device * ('k, 'res) devices -> ('a -> 'k, 'res) devices
+
+let rec go : type k res. ((unit -> res) -> res) -> (k, res) devices -> k -> res
+  = fun run -> function
+  | [] -> fun fn -> run fn
+  | Net device :: devices ->
+    begin match Net.connect device with
+    | Ok (t, cfg) -> fun f -> let r = f (t, cfg) in go run devices r
+    | Error (`Msg msg) -> failwithf "%s." msg end
+  | Block device :: devices ->
+    begin match Block.connect device with
+    | Ok t -> fun f -> let r = f t in go run devices r
+    | Error (`Msg msg) -> failwithf "%s." msg end
+
+let run ?g devices fn =
+  let run fn = Miou.run ~events ~domains:0 ?g fn in
+  go run devices fn

lib/miou_solo5.mli

@@ -27,18 +27,18 @@
 
     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
-    from it) to observe at another point in the life of unikernel whether a
-    packet has just arrived.
+    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 from it) to observe at another point in the life of unikernel
+    whether a packet has just arrived.
 
     Reading the net device is currently the only operation where suspension is
     necessary. In this way, the scheduler can take the opportunity to perform
     other tasks if reading failed in the first place. It is at the next
     iteration of the scheduler (after it has executed at least one other task)
-    that Miou_solo5 will ask the tender if a packet has just arrived. If this is
-    the case, the scheduler will resume the read task, otherwise it will keep it
-    in a suspended state until the next iteration.
+    that [Miou_solo5] will ask the tender if a packet has just arrived. If this
+    is the case, the scheduler will resume the read task, otherwise it will
+    keep it in a suspended state until the next iteration.
 
     {2 Block devices.}
 
@@ -73,19 +73,72 @@
     later date without the current time at which the operation is carried out
     having any effect on the result. For example, scheduling reads on a block
     device that is read-only is probably more interesting than using atomic
-    reads (whether the read is done at time T0 or T1, the result remains the
-    same). *)
+    reads (whether the read is done at time [T0] or [T1], the result remains
+    the same).
+
+    {2 The scheduler.}
+
+    [Miou_solo5] is based on the Miou scheduler. Basically, this scheduler
+    allows the user to perform tasks in parallel. However, Solo5 does {b not}
+    have more than a single core. Parallel tasks are therefore {b unavailable}
+    \- in other words, the user should {b not} use [Miou.call] but only
+    [Miou.async].
+    
+    Finally, the scheduler works in such a way that scheduled read/write
+    operations on a block device are relegated to the lowest priority tasks.
+    However, this does not mean that [Miou_solo5] is a scheduler that tries to
+    complete as many tasks as possible before reaching an I/O operation (such
+    as waiting for a packet - {!val:Net.read} - or reading/writing a block
+    device). Miou and [Miou_solo5] aim to increase the availability of an
+    application: in other words, as soon as there is an opportunity to execute a
+    task other than the current one, Miou will take it.
+
+    In this case, all the operations (except atomic ones) present in this
+    module give Miou the opportunity to suspend the current task and execute
+    another task.
+*)
 
 type bigstring =
   (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
 
 module Net : sig
   type t
+  (** The type of network interfaces. *)
+
+  type mac = private string
+  (** The type of the hardware addres (MAC) of an ethernet interface. *)
+
+  type cfg = { mac : mac; mtu : int }
 
   val read_bigstring : t -> ?off:int -> ?len:int -> bigstring -> int
+  (** [read_bigstring t ?off ?len bstr] reads [len] (defaults to
+      [Bigarray.Array1.dim bstr - off]) bytes from the net device [t], storing
+      them in byte sequence [bstr], starting at position [off] (defaults to
+      [0]) in [bstr]. Return the number of bytes actually read.
+
+      [read_bigstring] attempts an initial read. If it fails, we give the
+      scheduler the opportunity to execute another task. The current task will
+      be resumed as soon as bytes are available in the given net-device [t].
+
+      @raise Invalid_argument if [off] and [len] do not designate a valid range
+      of [bstr]. *)
+
   val read_bytes : t -> ?off:int -> ?len:int -> bytes -> int
+  (** [read_bytes] is {!val:read_bigstring} but for [bytes]. However, this
+      function uses an internal buffer (of a fixed size) which transmits the
+      bytes from the net-device to the [byte] given by the user. If the [byte]
+      given by the user is larger than the internal buffer, several actual
+      reads are made.
+
+      This means that a single [read_bytes] can give the scheduler several
+      opportunities to execute other tasks.
+
+      @raise Invalid_argument if [off] and [len] do not designate a valid range
+      of [bstr]. *)
+
   val write_bigstring : t -> ?off:int -> ?len:int -> bigstring -> unit
   val write_string : t -> ?off:int -> ?len:int -> string -> unit
+  val connect : string -> (t * cfg, [> `Msg of string ]) result
 end
 
 module Block : sig
@@ -95,15 +148,47 @@ module Block : sig
   val atomic_write : t -> off:int -> bigstring -> unit
   val read : t -> off:int -> bigstring -> unit
   val write : t -> off:int -> bigstring -> unit
+  val connect : string -> (t, [> `Msg of string ]) result
 end
 
 external clock_monotonic : unit -> (int[@untagged])
   = "unimplemented" "miou_solo5_clock_monotonic"
 [@@noalloc]
+(** [clock_monotonic ()] returns monotonic time since an unspecified period in
+    the past.
+
+    The monotonic clock corresponds to the CPU time spent since the boot time.
+    The monotonic clock cannot be relied upon to provide accurate results -
+    unless great care is taken to correct the possible flaws. Indeed, if the
+    unikernel is suspended (by the host system), the monotonic clock will no
+    longer be aligned with the "real time elapsed" since the boot.
+
+    This operation is {b atomic}. In other words, it does not give the scheduler
+    the opportunity to execute another task. *)
 
 external clock_wall : unit -> (int[@untagged])
   = "unimplemented" "miou_solo5_clock_wall"
 [@@noalloc]
+(** [clock_wall ()] returns wall clock in UTC since the UNIX epoch (1970-01-01).
+
+    The wall clock corresponds to the host's clock. Indeed, each time
+    [clock_wall ()] is called, a syscall/hypercall is made to get the host's
+    clock. Compared to the monotonic clock, getting the host's clock may take
+    some time.
+
+    This operation is atomic. In other words, it does not give the scheduler the
+    opportunity to execute another task. *)
 
 val sleep : int -> unit
-val run : ?g:Random.State.t -> (unit -> 'a) -> 'a
+(** [sleep ns] blocks (suspends) the current task for [ns] nanoseconds. *)
+
+type 'a device
+
+val net : string -> (Net.t * Net.cfg) device
+val block : string -> Block.t device
+
+type ('k, 'res) devices =
+  | [] : (unit -> 'res, 'res) devices
+  | ( :: ) : 'a device * ('k, 'res) devices -> ('a -> 'k, 'res) devices
+
+val run : ?g:Random.State.t -> ('a, 'b) devices -> 'a -> 'b

lib/stubs.solo5.c

@@ -22,6 +22,23 @@ 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_acquire(value vname, value vhandle, value vlen, value vpage) {
+  CAMLparam4(vname, vhandle, vlen, vpage);
+  solo5_result_t result;
+  solo5_handle_t handle;
+  struct solo5_block_info bi;
+
+  result = solo5_block_acquire(String_val(vname), &handle, &bi);
+
+  if (result == SOLO5_R_OK) {
+    memcpy(Bytes_val(vhandle), (uint64_t *) &handle, sizeof(uint64_t));
+    memcpy(Bytes_val(vlen), (uint64_t *) &bi.capacity, sizeof(uint64_t));
+    memcpy(Bytes_val(vpage), (uint64_t *) &bi.block_size, sizeof(uint64_t));
+  }
+
+  CAMLreturn(Val_long(result));
+}
+
 intnat miou_solo5_block_read(intnat fd, intnat off, intnat len, value vbstr) {
   solo5_handle_t handle = fd;
   solo5_off_t offset = off;
@@ -42,6 +59,23 @@ intnat miou_solo5_block_write(intnat fd, intnat off, intnat len, value vbstr) {
   return result;
 }
 
+intnat miou_solo5_net_acquire(value vname, value vhandle, value vmac, value vmtu) {
+  CAMLparam3(vname, vmac, vmtu);
+  solo5_result_t result;
+  solo5_handle_t handle;
+  struct solo5_net_info ni;
+
+  result = solo5_net_acquire(String_val(vname), &handle, &ni);
+
+  if (result == SOLO5_R_OK) {
+    memcpy(Bytes_val(vhandle), (uint64_t *) &handle, sizeof(uint64_t));
+    memcpy(Bytes_val(vmac), ni.mac_address, SOLO5_NET_ALEN);
+    memcpy(Bytes_val(vmtu), (uint64_t *) &ni.mtu, sizeof(uint64_t));
+  }
+
+  CAMLreturn(Val_long(result));
+}
+
 /* Instead of passing the [read_size] result in data that would be allocated on
  * the C side, the OCaml side allocates a small buffer of 8 bytes to store the
  * number of bytes that Solo5 was able to read. memcpy saves our result in this

test/dune

@@ -5,9 +5,27 @@
  (link_flags :standard -cclib "-z solo5-abi=hvt")
  (enabled_if (= %{context_name} "solo5"))
  (libraries miou-solo5)
- (foreign_stubs (language c) (names manifest)))
+ (foreign_stubs (language c) (names manifest.sleep)))
+
+(executable
+ (name schedule)
+ (modules schedule)
+ (modes native)
+ (link_flags :standard -cclib "-z solo5-abi=hvt")
+ (enabled_if (= %{context_name} "solo5"))
+ (libraries miou-solo5)
+ (foreign_stubs (language c) (names manifest.schedule)))
 
 (rule
- (targets manifest.c)
- (deps manifest.json)
- (action (run solo5-elftool gen-manifest manifest.json manifest.c)))
+ (targets manifest.sleep.c)
+ (deps none.json)
+ (action (run solo5-elftool gen-manifest none.json manifest.sleep.c)))
+
+(rule
+ (targets manifest.schedule.c)
+ (deps none.json)
+ (action (run solo5-elftool gen-manifest none.json manifest.schedule.c)))
+
+(cram
+ (enabled_if (= %{context_name} "solo5"))
+ (deps sleep.exe schedule.exe))

test/run.t

@@ -0,0 +1,31 @@
+Tests some simple unikernels
+  $ solo5-hvt sleep.exe
+              |      ___|
+    __|  _ \  |  _ \ __ \
+  \__ \ (   | | (   |  ) |
+  ____/\___/ _|\___/____/
+  Solo5: Bindings version v0.9.0
+  Solo5: Memory map: 512 MB addressable:
+  Solo5:   reserved @ (0x0 - 0xfffff)
+  Solo5:       text @ (0x100000 - 0x1bafff)
+  Solo5:     rodata @ (0x1bb000 - 0x1eafff)
+  Solo5:       data @ (0x1eb000 - 0x250fff)
+  Solo5:       heap >= 0x251000 < stack < 0x20000000
+  Hello
+  World
+  Solo5: solo5_exit(0) called
+  $ solo5-hvt schedule.exe
+              |      ___|
+    __|  _ \  |  _ \ __ \
+  \__ \ (   | | (   |  ) |
+  ____/\___/ _|\___/____/
+  Solo5: Bindings version v0.9.0
+  Solo5: Memory map: 512 MB addressable:
+  Solo5:   reserved @ (0x0 - 0xfffff)
+  Solo5:       text @ (0x100000 - 0x1bafff)
+  Solo5:     rodata @ (0x1bb000 - 0x1eafff)
+  Solo5:       data @ (0x1eb000 - 0x250fff)
+  Solo5:       heap >= 0x251000 < stack < 0x20000000
+  Hello
+  World
+  Solo5: solo5_exit(0) called

test/schedule.ml

@@ -0,0 +1,5 @@
+let () = Miou_solo5.run [] @@ fun () ->
+  let prm = Miou.async @@ fun () ->
+    print_endline "World" in
+  print_endline "Hello";
+  Miou.await_exn prm

test/sleep.ml

@@ -1,23 +1,7 @@
 let _1s = 1_000_000_000
 
-let sleep_and ns fn =
-  Miou_solo5.sleep ns;
-  fn ()
-
-let rec repeat_until n fn =
-  if n > 0 then begin
-    fn ();
-    repeat_until (n - 1) fn
-  end
-
-let () = Miou_solo5.run @@ fun () ->
-  let prm0 = Miou.async @@ fun () ->
-    repeat_until 3 @@ fun () ->
-    sleep_and _1s @@ fun () ->
-    print_endline "Hello" in
-  let prm1 = Miou.async @@ fun () ->
-    repeat_until 3 @@ fun () ->
-    sleep_and _1s @@ fun () ->
-    print_endline "World" in
-  let res = Miou.await_all [ prm0; prm1 ] in
-  List.iter (function Ok () -> () | Error exn -> raise exn) res
+let () = Miou_solo5.run [] @@ fun () ->
+  Miou_solo5.sleep _1s;
+  print_endline "Hello";
+  Miou_solo5.sleep _1s;
+  print_endline "World"