Compare commits

..

No commits in common. "like-variants" and "main" have entirely different histories.

3 changed files with 11 additions and 19 deletions

View file

@ -2,9 +2,7 @@
(name miou_solo5) (name miou_solo5)
(public_name miou-solo5) (public_name miou-solo5)
(modules miou_solo5) (modules miou_solo5)
(libraries ohex jsonm logs miou) (libraries jsonm logs miou)
(flags
(:standard -no-keep-locs))
(wrapped false) (wrapped false)
(foreign_stubs (foreign_stubs
(language c) (language c)

View file

@ -215,8 +215,8 @@ let domain =
let blocking_read fd = let blocking_read fd =
let syscall = Miou.syscall () in let syscall = Miou.syscall () in
Log.debug (fun m -> m "append [%d] as a reader" fd); Log.debug (fun m -> m "append [%d] as a reader" fd);
let fn () = Handles.append domain.handles fd syscall in Handles.append domain.handles fd syscall;
Miou.suspend ~fn syscall Miou.suspend syscall
module Net = struct module Net = struct
type t = int type t = int
@ -229,16 +229,14 @@ module Net = struct
let mtu = Bytes.make 8 '\000' in let mtu = Bytes.make 8 '\000' in
match miou_solo5_net_acquire name handle mac mtu with match miou_solo5_net_acquire name handle mac mtu with
| 0 -> | 0 ->
let mac = Bytes.unsafe_to_string mac in
let handle = Int64.to_int (Bytes.get_int64_ne handle 0) in 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 let mtu = Int64.to_int (Bytes.get_int64_ne mtu 0) in
Log.debug (fun m -> m "%s (mtu:%d) -> %02d" (Ohex.encode mac) mtu handle);
Ok (handle, { mac; mtu }) Ok (handle, { mac; mtu })
| _ -> error_msgf "Impossible to connect the net-device %s" name | _ -> error_msgf "Impossible to connect the net-device %s" name
let read t ~off ~len bstr = let read t ~off ~len bstr =
let rec go read_size = let rec go read_size =
blocking_read t;
let result = miou_solo5_net_read t bstr off len read_size in let result = miou_solo5_net_read t bstr off len read_size in
match result with match result with
| 0 -> Int64.to_int (unsafe_get_int64_ne read_size 0) | 0 -> Int64.to_int (unsafe_get_int64_ne read_size 0)
@ -440,7 +438,7 @@ external miou_solo5_yield : (int[@untagged]) -> (int[@untagged])
= "unimplemented" "miou_solo5_yield" = "unimplemented" "miou_solo5_yield"
[@@noalloc] [@@noalloc]
type waiting = Infinity | Yield | Sleep of int type waiting = Infinity | Yield | Sleep
let wait_for ~block = let wait_for ~block =
match (sleeper (), block) with match (sleeper (), block) with
@ -448,7 +446,7 @@ let wait_for ~block =
| (None | Some _), false -> Yield | (None | Some _), false -> Yield
| Some point, true -> | Some point, true ->
let until = point - clock_monotonic () in let until = point - clock_monotonic () in
if until < 0 then Yield else Sleep until if until < 0 then Yield else Sleep
(* The behaviour of our select is a little different from what we're used to (* The behaviour of our select is a little different from what we're used to
seeing. Currently, only a read on a net device can produce a necessary seeing. Currently, only a read on a net device can produce a necessary
@ -482,26 +480,21 @@ let select ~block cancelled_syscalls =
action on the block device ([handles != 0]), we stop and send the action on the block device ([handles != 0]), we stop and send the
signals to Miou. If not, we take the opportunity to possibly go signals to Miou. If not, we take the opportunity to possibly go
further. *) further. *)
let deadline = if Queue.is_empty domain.blocks then max_int else 0 in
let signals = consume_block domain signals in let signals = consume_block domain signals in
handles := miou_solo5_yield deadline; handles := miou_solo5_yield 0;
if !handles == 0 then go signals else signals if !handles == 0 then go signals else signals
| Yield -> | Yield ->
(* Miou still has work to do but asks if there are any events. We ask (* Miou still has work to do but asks if there are any events. We ask
Solo5 if there are any and return the possible signals to Miou. *) Solo5 if there are any and return the possible signals to Miou. *)
handles := miou_solo5_yield 0; handles := miou_solo5_yield 0;
signals signals
| Sleep until -> | Sleep ->
(* We have a sleeper that is still active and will have to wait a while (* We have a sleeper that is still active and will have to wait a while
before consuming it. In the meantime, we take action on the block before consuming it. In the meantime, we take action on the block
devices and repeat our [select] if Solo5 tells us that there are no devices and repeat our [select] if Solo5 tells us that there are no
events ([handle == 0]). *) events ([handle == 0]). *)
let until = if Queue.is_empty domain.blocks then until else 0 in
let t0 = clock_monotonic () in
let signals = consume_block domain signals in let signals = consume_block domain signals in
let t1 = clock_monotonic () in handles := miou_solo5_yield 0;
let deadline = t1 + (until - (t1 - t0)) in
handles := miou_solo5_yield deadline;
if !handles == 0 then go signals else signals if !handles == 0 then go signals else signals
in in
let signals = consume_block domain [] in let signals = consume_block domain [] in

View file

@ -84,7 +84,8 @@ value miou_solo5_net_acquire(value vname, value vhandle, value vmac,
* small buffer and, on the OCaml side, we just need to read it. It's a bit * 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. */ * like the poor man's C-style reference passage in OCaml. */
value miou_solo5_net_read(intnat fd, value vbstr, intnat off, intnat len, value vread_size) { value miou_solo5_net_read(intnat fd, intnat off, intnat len, value vread_size,
value vbstr) {
CAMLparam1(vread_size); CAMLparam1(vread_size);
solo5_handle_t handle = fd; solo5_handle_t handle = fd;
size_t size = len; size_t size = len;