Complete and fix the Miou_solo5 module
This commit is contained in:
parent
d003b295a2
commit
27cae3fd33
3 changed files with 68 additions and 49 deletions
|
|
@ -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
|
||||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in a new issue