diff --git a/lib/miou_solo5.ml b/lib/miou_solo5.ml index a4fb665..adf5649 100644 --- a/lib/miou_solo5.ml +++ b/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 - 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 diff --git a/lib/miou_solo5.mli b/lib/miou_solo5.mli index 534ade7..a1e98c9 100644 --- a/lib/miou_solo5.mli +++ b/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 - 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. diff --git a/lib/stubs.solo5.c b/lib/stubs.solo5.c index d068815..192c59f 100644 --- a/lib/stubs.solo5.c +++ b/lib/stubs.solo5.c @@ -1,7 +1,9 @@ #include "solo5.h" -#include #include +#include +#include +#include /* 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); +}