robur/miou-solo5
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Complete and fix the Miou_solo5 module

Browse source
This commit is contained in:
Calascibetta Romain 2024-12-05 20:04:42 +01:00
parent d003b295a2
commit 27cae3fd33
3 changed files with 68 additions and 49 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

55
lib/miou_solo5.ml
View file

@ -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
include Miou.Pqueue.Make (struct
module Heapq = 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
{
handles= Handles.create 0x100
; sleepers= Heapq.create ()
; blocks= Queue.create ()
}
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
| { time; _ } -> Some time
sleeper ()
| { 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 =
match (sleeper domain, block) with
let wait_for ~block =
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

8
lib/miou_solo5.mli
View file

@ -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
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.
\- 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.

54
lib/stubs.solo5.c
View file

@ -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,
value vbstr) {
intnat miou_solo5_block_read(intnat fd, intnat off, intnat len, 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,
value vbstr) {
intnat miou_solo5_block_write(intnat fd, intnat off, intnat len, 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,
value vread_size, value vbstr) {
intnat miou_solo5_net_read(intnat fd, intnat off, intnat len, value vread_size,
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,
value vbstr) {
intnat miou_solo5_net_write(intnat fd, intnat off, intnat len, 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);
}