[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index] [Xen-devel] [PATCH] Encapsulate several OCaml types within xenctrl
This is done mainly because OCaml record type fields share the same namespace. Due to this, several fields of the modified types were hidden, and therefore inaccessible. Encapsulating the types within their own modules (in a standard way), puts the field names within sub-namespaces, and so makes all fields accessible. Note that this is not a backward-compatible change. For example, code in xcp's xen-api component needs to be modified accordingly. Signed-off-by: Rok Strnisa <rok.strnisa@xxxxxxxxxx> diff --git a/tools/ocaml/libs/xc/xenctrl.ml b/tools/ocaml/libs/xc/xenctrl.ml --- a/tools/ocaml/libs/xc/xenctrl.ml +++ b/tools/ocaml/libs/xc/xenctrl.ml @@ -19,75 +19,80 @@ type domid = int (* ** xenctrl.h ** *) -type vcpuinfo = -{ - online: bool; - blocked: bool; - running: bool; - cputime: int64; - cpumap: int32; -} +module Vcpu_info = struct + type t = { + online : bool; + blocked : bool; + running : bool; + cputime : int64; + cpumap : int32; + } +end -type domaininfo = -{ - domid : domid; - dying : bool; - shutdown : bool; - paused : bool; - blocked : bool; - running : bool; - hvm_guest : bool; - shutdown_code : int; - total_memory_pages: nativeint; - max_memory_pages : nativeint; - shared_info_frame : int64; - cpu_time : int64; - nr_online_vcpus : int; - max_vcpu_id : int; - ssidref : int32; - handle : int array; -} +module Domain_info = struct + type t = { + domid : domid; + dying : bool; + shutdown : bool; + paused : bool; + blocked : bool; + running : bool; + hvm_guest : bool; + shutdown_code : int; + total_memory_pages : nativeint; + max_memory_pages : nativeint; + shared_info_frame : int64; + cpu_time : int64; + nr_online_vcpus : int; + max_vcpu_id : int; + ssidref : int32; + handle : int array; + } +end -type sched_control = -{ - weight : int; - cap : int; -} +module Sched_control = struct + type t = { + weight : int; + cap : int; + } +end -type physinfo_cap_flag = - | CAP_HVM - | CAP_DirectIO +module Phys_info = struct + type cap_flag = + | CAP_HVM + | CAP_DirectIO -type physinfo = -{ - threads_per_core : int; - cores_per_socket : int; - nr_cpus : int; - max_node_id : int; - cpu_khz : int; - total_pages : nativeint; - free_pages : nativeint; - scrub_pages : nativeint; - (* XXX hw_cap *) - capabilities : physinfo_cap_flag list; - max_nr_cpus : int; -} + type t = { + threads_per_core : int; + cores_per_socket : int; + nr_cpus : int; + max_node_id : int; + cpu_khz : int; + total_pages : nativeint; + free_pages : nativeint; + scrub_pages : nativeint; + (* XXX hw_cap *) + capabilities : cap_flag list; + max_nr_cpus : int; + } +end -type version = -{ - major : int; - minor : int; - extra : string; -} +module Version = struct + type t = { + major : int; + minor : int; + extra : string; + } +end - -type compile_info = -{ - compiler : string; - compile_by : string; - compile_domain : string; - compile_date : string; -} +module Compile_info = struct + type t = { + compiler : string; + compile_by : string; + compile_domain : string; + compile_date : string; + } +end type shutdown_reason = Poweroff | Reboot | Suspend | Crash | Halt @@ -148,21 +153,21 @@ external domain_destroy: handle -> domid external domain_shutdown: handle -> domid -> shutdown_reason -> unit = "stub_xc_domain_shutdown" -external _domain_getinfolist: handle -> domid -> int -> domaininfo list +external _domain_getinfolist: handle -> domid -> int -> Domain_info.t list = "stub_xc_domain_getinfolist" let domain_getinfolist handle first_domain = let nb = 2 in - let last_domid l = (List.hd l).domid + 1 in + let last_domid l = (List.hd l).Domain_info.domid + 1 in let rec __getlist from = let l = _domain_getinfolist handle from nb in (if List.length l = nb then __getlist (last_domid l) else []) @ l in List.rev (__getlist first_domain) -external domain_getinfo: handle -> domid -> domaininfo= "stub_xc_domain_getinfo" +external domain_getinfo: handle -> domid -> Domain_info.t = "stub_xc_domain_getinfo" -external domain_get_vcpuinfo: handle -> int -> int -> vcpuinfo +external domain_get_vcpuinfo: handle -> int -> int -> Vcpu_info.t = "stub_xc_vcpu_getinfo" external domain_ioport_permission: handle -> domid -> int -> int -> bool -> unit @@ -182,9 +187,9 @@ external vcpu_context_get: handle -> dom external sched_id: handle -> int = "stub_xc_sched_id" -external sched_credit_domain_set: handle -> domid -> sched_control -> unit +external sched_credit_domain_set: handle -> domid -> Sched_control.t -> unit = "stub_sched_credit_domain_set" -external sched_credit_domain_get: handle -> domid -> sched_control +external sched_credit_domain_get: handle -> domid -> Sched_control.t = "stub_sched_credit_domain_get" external shadow_allocation_set: handle -> domid -> int -> unit @@ -199,7 +204,7 @@ external evtchn_reset: handle -> domid - external readconsolering: handle -> string = "stub_xc_readconsolering" external send_debug_keys: handle -> string -> unit = "stub_xc_send_debug_keys" -external physinfo: handle -> physinfo = "stub_xc_physinfo" +external physinfo: handle -> Phys_info.t = "stub_xc_physinfo" external pcpu_info: handle -> int -> int64 array = "stub_xc_pcpu_info" external domain_setmaxmem: handle -> domid -> int64 -> unit @@ -237,8 +242,8 @@ external domain_deassign_device: handle external domain_test_assign_device: handle -> domid -> (int * int * int * int) -> bool = "stub_xc_domain_test_assign_device" -external version: handle -> version = "stub_xc_version_version" -external version_compile_info: handle -> compile_info +external version: handle -> Version.t = "stub_xc_version_version" +external version_compile_info: handle -> Compile_info.t = "stub_xc_version_compile_info" external version_changeset: handle -> string = "stub_xc_version_changeset" external version_capabilities: handle -> string = @@ -271,10 +276,10 @@ let coredump xch domid fd = let info = domain_getinfo xch domid in - let nrpages = info.total_memory_pages in - let ctxt = Array.make info.max_vcpu_id None in + let nrpages = info.Domain_info.total_memory_pages in + let ctxt = Array.make info.Domain_info.max_vcpu_id None in let nr_vcpus = ref 0 in - for i = 0 to info.max_vcpu_id - 1 + for i = 0 to info.Domain_info.max_vcpu_id - 1 do ctxt.(i) <- try let v = vcpu_context_get xch domid i in @@ -296,7 +301,7 @@ let coredump xch domid fd = in let header = { - xch_magic = if info.hvm_guest then Magic_hvm else Magic_pv; + xch_magic = if info.Domain_info.hvm_guest then Magic_hvm else Magic_pv; xch_nr_vcpus = !nr_vcpus; xch_nr_pages = nrpages; xch_ctxt_offset = Int64.of_int (sizeof_core_header ()); @@ -306,7 +311,7 @@ let coredump xch domid fd = } in dump (marshall_core_header header); - for i = 0 to info.max_vcpu_id - 1 + for i = 0 to info.Domain_info.max_vcpu_id - 1 do match ctxt.(i) with | None -> () diff --git a/tools/ocaml/libs/xc/xenctrl.mli b/tools/ocaml/libs/xc/xenctrl.mli --- a/tools/ocaml/libs/xc/xenctrl.mli +++ b/tools/ocaml/libs/xc/xenctrl.mli @@ -15,52 +15,71 @@ *) type domid = int -type vcpuinfo = { - online : bool; - blocked : bool; - running : bool; - cputime : int64; - cpumap : int32; -} -type domaininfo = { - domid : domid; - dying : bool; - shutdown : bool; - paused : bool; - blocked : bool; - running : bool; - hvm_guest : bool; - shutdown_code : int; - total_memory_pages : nativeint; - max_memory_pages : nativeint; - shared_info_frame : int64; - cpu_time : int64; - nr_online_vcpus : int; - max_vcpu_id : int; - ssidref : int32; - handle : int array; -} -type sched_control = { weight : int; cap : int; } -type physinfo_cap_flag = CAP_HVM | CAP_DirectIO -type physinfo = { - threads_per_core : int; - cores_per_socket : int; - nr_cpus : int; - max_node_id : int; - cpu_khz : int; - total_pages : nativeint; - free_pages : nativeint; - scrub_pages : nativeint; - capabilities : physinfo_cap_flag list; - max_nr_cpus : int; (** compile-time max possible number of nr_cpus *) -} -type version = { major : int; minor : int; extra : string; } -type compile_info = { - compiler : string; - compile_by : string; - compile_domain : string; - compile_date : string; -} +module Vcpu_info : sig + type t = { + online : bool; + blocked : bool; + running : bool; + cputime : int64; + cpumap : int32; + } +end +module Domain_info : sig + type t = { + domid : domid; + dying : bool; + shutdown : bool; + paused : bool; + blocked : bool; + running : bool; + hvm_guest : bool; + shutdown_code : int; + total_memory_pages : nativeint; + max_memory_pages : nativeint; + shared_info_frame : int64; + cpu_time : int64; + nr_online_vcpus : int; + max_vcpu_id : int; + ssidref : int32; + handle : int array; + } +end +module Sched_control : sig + type t = { + weight : int; + cap : int; + } +end +module Phys_info : sig + type cap_flag = CAP_HVM | CAP_DirectIO + type t = { + threads_per_core : int; + cores_per_socket : int; + nr_cpus : int; + max_node_id : int; + cpu_khz : int; + total_pages : nativeint; + free_pages : nativeint; + scrub_pages : nativeint; + capabilities : cap_flag list; + max_nr_cpus : int; (** compile-time max possible number of nr_cpus *) + } +end +module Version : sig + type t = { + major : int; + minor : int; + extra : string; + } +end +module Compile_info : sig + type t = { + compiler : string; + compile_by : string; + compile_domain : string; + compile_date : string; + } +end type shutdown_reason = Poweroff | Reboot | Suspend | Crash | Halt type domain_create_flag = CDF_HVM | CDF_HAP @@ -86,12 +105,12 @@ external domain_resume_fast : handle -> external domain_destroy : handle -> domid -> unit = "stub_xc_domain_destroy" external domain_shutdown : handle -> domid -> shutdown_reason -> unit = "stub_xc_domain_shutdown" -external _domain_getinfolist : handle -> domid -> int -> domaininfo list +external _domain_getinfolist : handle -> domid -> int -> Domain_info.t list = "stub_xc_domain_getinfolist" -val domain_getinfolist : handle -> domid -> domaininfo list -external domain_getinfo : handle -> domid -> domaininfo +val domain_getinfolist : handle -> domid -> Domain_info.t list +external domain_getinfo : handle -> domid -> Domain_info.t = "stub_xc_domain_getinfo" -external domain_get_vcpuinfo : handle -> int -> int -> vcpuinfo +external domain_get_vcpuinfo : handle -> int -> int -> Vcpu_info.t = "stub_xc_vcpu_getinfo" external domain_ioport_permission: handle -> domid -> int -> int -> bool -> unit = "stub_xc_domain_ioport_permission" @@ -106,9 +125,9 @@ external vcpu_affinity_get : handle -> d external vcpu_context_get : handle -> domid -> int -> string = "stub_xc_vcpu_context_get" external sched_id : handle -> int = "stub_xc_sched_id" -external sched_credit_domain_set : handle -> domid -> sched_control -> unit +external sched_credit_domain_set : handle -> domid -> Sched_control.t -> unit = "stub_sched_credit_domain_set" -external sched_credit_domain_get : handle -> domid -> sched_control +external sched_credit_domain_get : handle -> domid -> Sched_control.t = "stub_sched_credit_domain_get" external shadow_allocation_set : handle -> domid -> int -> unit = "stub_shadow_allocation_set" @@ -119,7 +138,7 @@ external evtchn_alloc_unbound : handle - external evtchn_reset : handle -> domid -> unit = "stub_xc_evtchn_reset" external readconsolering : handle -> string = "stub_xc_readconsolering" external send_debug_keys : handle -> string -> unit = "stub_xc_send_debug_keys" -external physinfo : handle -> physinfo = "stub_xc_physinfo" +external physinfo : handle -> Phys_info.t = "stub_xc_physinfo" external pcpu_info: handle -> int -> int64 array = "stub_xc_pcpu_info" external domain_setmaxmem : handle -> domid -> int64 -> unit = "stub_xc_domain_setmaxmem" @@ -142,8 +161,8 @@ external domain_deassign_device: handle external domain_test_assign_device: handle -> domid -> (int * int * int * int) -> bool = "stub_xc_domain_test_assign_device" -external version : handle -> version = "stub_xc_version_version" -external version_compile_info : handle -> compile_info +external version : handle -> Version.t = "stub_xc_version_version" +external version_compile_info : handle -> Compile_info.t = "stub_xc_version_compile_info" external version_changeset : handle -> string = "stub_xc_version_changeset" external version_capabilities : handle -> string diff --git a/tools/ocaml/xenstored/domains.ml b/tools/ocaml/xenstored/domains.ml --- a/tools/ocaml/xenstored/domains.ml +++ b/tools/ocaml/xenstored/domains.ml @@ -36,10 +36,11 @@ let cleanup xc doms = Hashtbl.iter (fun id _ -> if id <> 0 then try let info = Xenctrl.domain_getinfo xc id in - if info.Xenctrl.shutdown || info.Xenctrl.dying then ( + if info.Xenctrl.Domain_info.shutdown || info.Xenctrl.Domain_info.dying then ( debug "Domain %u died (dying=%b, shutdown %b -- code %d)" - id info.Xenctrl.dying info.Xenctrl.shutdown info.Xenctrl.shutdown_code; - if info.Xenctrl.dying then + id info.Xenctrl.Domain_info.dying info.Xenctrl.Domain_info.shutdown + info.Xenctrl.Domain_info.shutdown_code; + if info.Xenctrl.Domain_info.dying then dead_dom := id :: !dead_dom else notify := true; _______________________________________________ Xen-devel mailing list Xen-devel@xxxxxxxxxxxxx http://lists.xen.org/xen-devel
|
Lists.xenproject.org is hosted with RackSpace, monitoring our |