2018-10-23 22:13:47 +00:00
|
|
|
(* (c) 2017, 2018 Hannes Mehnert, all rights reserved *)
|
2018-10-22 21:20:00 +00:00
|
|
|
|
|
|
|
type 'a t
|
|
|
|
|
2018-10-23 22:03:36 +00:00
|
|
|
val init : Vmm_commands.version -> 'a t
|
2018-10-22 21:20:00 +00:00
|
|
|
|
|
|
|
type service_out = [
|
2018-10-23 22:03:36 +00:00
|
|
|
| `Stat of Vmm_commands.wire
|
|
|
|
| `Log of Vmm_commands.wire
|
|
|
|
| `Cons of Vmm_commands.wire
|
2018-10-22 21:20:00 +00:00
|
|
|
]
|
|
|
|
|
2018-10-23 22:03:36 +00:00
|
|
|
type out = [ service_out | `Data of Vmm_commands.wire ]
|
2018-10-22 21:20:00 +00:00
|
|
|
|
2018-10-22 22:54:05 +00:00
|
|
|
val handle_shutdown : 'a t -> Vmm_core.id -> Vmm_core.vm ->
|
2018-10-22 21:20:00 +00:00
|
|
|
[ `Exit of int | `Signal of int | `Stop of int ] -> 'a t * out list
|
|
|
|
|
2018-10-23 22:03:36 +00:00
|
|
|
val handle_command : 'a t -> Vmm_commands.wire ->
|
2018-10-22 21:20:00 +00:00
|
|
|
'a t * out list *
|
2018-10-25 23:11:41 +00:00
|
|
|
[ `Create of 'c t -> 'c -> ('c t * out list * Vmm_core.id * Vmm_core.vm, [> `Msg of string ]) result
|
2018-10-31 21:40:09 +00:00
|
|
|
| `Loop
|
2018-10-22 21:20:00 +00:00
|
|
|
| `End
|
2018-10-25 23:11:41 +00:00
|
|
|
| `Wait of 'a * out
|
2018-10-22 21:20:00 +00:00
|
|
|
| `Wait_and_create of 'a * ('a t -> 'a t * out list *
|
2018-10-22 22:54:05 +00:00
|
|
|
[ `Create of 'd t -> 'd -> ('d t * out list * Vmm_core.id * Vmm_core.vm, [> Rresult.R.msg ]) result
|
2018-10-22 21:20:00 +00:00
|
|
|
| `End ]) ]
|
|
|
|
|
2018-10-25 23:11:41 +00:00
|
|
|
val setup_stats : 'a t -> Vmm_core.id -> Vmm_core.vm -> 'a t * out
|