1(*
2 * Copyright (C) 2006-2007 XenSource Ltd.
3 * Copyright (C) 2008      Citrix Ltd.
4 * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
5 *
6 * This program is free software; you can redistribute it and/or modify
7 * it under the terms of the GNU Lesser General Public License as published
8 * by the Free Software Foundation; version 2.1 only. with the special
9 * exception on linking described in file LICENSE.
10 *
11 * This program is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 * GNU Lesser General Public License for more details.
15 *)
16
17type domid = int
18type vcpuinfo = {
19  online : bool;
20  blocked : bool;
21  running : bool;
22  cputime : int64;
23  cpumap : int32;
24}
25
26type xen_arm_arch_domainconfig = {
27  gic_version: int;
28  nr_spis: int;
29  clock_frequency: int32;
30}
31
32type x86_arch_emulation_flags =
33  | X86_EMU_LAPIC
34  | X86_EMU_HPET
35  | X86_EMU_PM
36  | X86_EMU_RTC
37  | X86_EMU_IOAPIC
38  | X86_EMU_PIC
39  | X86_EMU_VGA
40  | X86_EMU_IOMMU
41  | X86_EMU_PIT
42  | X86_EMU_USE_PIRQ
43
44type xen_x86_arch_domainconfig = {
45  emulation_flags: x86_arch_emulation_flags list;
46}
47
48type arch_domainconfig =
49  | ARM of xen_arm_arch_domainconfig
50  | X86 of xen_x86_arch_domainconfig
51
52type domaininfo = {
53  domid : domid;
54  dying : bool;
55  shutdown : bool;
56  paused : bool;
57  blocked : bool;
58  running : bool;
59  hvm_guest : bool;
60  shutdown_code : int;
61  total_memory_pages : nativeint;
62  max_memory_pages : nativeint;
63  shared_info_frame : int64;
64  cpu_time : int64;
65  nr_online_vcpus : int;
66  max_vcpu_id : int;
67  ssidref : int32;
68  handle : int array;
69  arch_config : arch_domainconfig;
70}
71type sched_control = { weight : int; cap : int; }
72type physinfo_cap_flag = CAP_HVM | CAP_DirectIO
73type physinfo = {
74  threads_per_core : int;
75  cores_per_socket : int;
76  nr_cpus          : int;
77  max_node_id      : int;
78  cpu_khz          : int;
79  total_pages      : nativeint;
80  free_pages       : nativeint;
81  scrub_pages      : nativeint;
82  capabilities     : physinfo_cap_flag list;
83  max_nr_cpus      : int; (** compile-time max possible number of nr_cpus *)
84}
85type version = { major : int; minor : int; extra : string; }
86type compile_info = {
87  compiler : string;
88  compile_by : string;
89  compile_domain : string;
90  compile_date : string;
91}
92type shutdown_reason = Poweroff | Reboot | Suspend | Crash | Watchdog | Soft_reset
93
94type domain_create_flag = CDF_HVM | CDF_HAP
95
96exception Error of string
97type handle
98external sizeof_core_header : unit -> int = "stub_sizeof_core_header"
99external sizeof_vcpu_guest_context : unit -> int
100  = "stub_sizeof_vcpu_guest_context"
101external sizeof_xen_pfn : unit -> int = "stub_sizeof_xen_pfn"
102external interface_open : unit -> handle = "stub_xc_interface_open"
103external interface_close : handle -> unit = "stub_xc_interface_close"
104val with_intf : (handle -> 'a) -> 'a
105val domain_create : handle -> int32 -> domain_create_flag list -> string -> arch_domainconfig -> domid
106val domain_sethandle : handle -> domid -> string -> unit
107external domain_max_vcpus : handle -> domid -> int -> unit
108  = "stub_xc_domain_max_vcpus"
109external domain_pause : handle -> domid -> unit = "stub_xc_domain_pause"
110external domain_unpause : handle -> domid -> unit = "stub_xc_domain_unpause"
111external domain_resume_fast : handle -> domid -> unit
112  = "stub_xc_domain_resume_fast"
113external domain_destroy : handle -> domid -> unit = "stub_xc_domain_destroy"
114external domain_shutdown : handle -> domid -> shutdown_reason -> unit
115  = "stub_xc_domain_shutdown"
116external _domain_getinfolist : handle -> domid -> int -> domaininfo list
117  = "stub_xc_domain_getinfolist"
118val domain_getinfolist : handle -> domid -> domaininfo list
119external domain_getinfo : handle -> domid -> domaininfo
120  = "stub_xc_domain_getinfo"
121external domain_get_vcpuinfo : handle -> int -> int -> vcpuinfo
122  = "stub_xc_vcpu_getinfo"
123external domain_ioport_permission: handle -> domid -> int -> int -> bool -> unit
124       = "stub_xc_domain_ioport_permission"
125external domain_iomem_permission: handle -> domid -> nativeint -> nativeint -> bool -> unit
126       = "stub_xc_domain_iomem_permission"
127external domain_irq_permission: handle -> domid -> int -> bool -> unit
128       = "stub_xc_domain_irq_permission"
129external vcpu_affinity_set : handle -> domid -> int -> bool array -> unit
130  = "stub_xc_vcpu_setaffinity"
131external vcpu_affinity_get : handle -> domid -> int -> bool array
132  = "stub_xc_vcpu_getaffinity"
133external vcpu_context_get : handle -> domid -> int -> string
134  = "stub_xc_vcpu_context_get"
135external sched_id : handle -> int = "stub_xc_sched_id"
136external sched_credit_domain_set : handle -> domid -> sched_control -> unit
137  = "stub_sched_credit_domain_set"
138external sched_credit_domain_get : handle -> domid -> sched_control
139  = "stub_sched_credit_domain_get"
140external shadow_allocation_set : handle -> domid -> int -> unit
141  = "stub_shadow_allocation_set"
142external shadow_allocation_get : handle -> domid -> int
143  = "stub_shadow_allocation_get"
144external evtchn_alloc_unbound : handle -> domid -> domid -> int
145  = "stub_xc_evtchn_alloc_unbound"
146external evtchn_reset : handle -> domid -> unit = "stub_xc_evtchn_reset"
147external readconsolering : handle -> string = "stub_xc_readconsolering"
148external send_debug_keys : handle -> string -> unit = "stub_xc_send_debug_keys"
149external physinfo : handle -> physinfo = "stub_xc_physinfo"
150external pcpu_info: handle -> int -> int64 array = "stub_xc_pcpu_info"
151external domain_setmaxmem : handle -> domid -> int64 -> unit
152  = "stub_xc_domain_setmaxmem"
153external domain_set_memmap_limit : handle -> domid -> int64 -> unit
154  = "stub_xc_domain_set_memmap_limit"
155external domain_memory_increase_reservation :
156  handle -> domid -> int64 -> unit
157  = "stub_xc_domain_memory_increase_reservation"
158external map_foreign_range :
159  handle -> domid -> int -> nativeint -> Xenmmap.mmap_interface
160  = "stub_map_foreign_range"
161external domain_get_pfn_list :
162  handle -> domid -> nativeint -> nativeint array
163  = "stub_xc_domain_get_pfn_list"
164
165external domain_assign_device: handle -> domid -> (int * int * int * int) -> unit
166       = "stub_xc_domain_assign_device"
167external domain_deassign_device: handle -> domid -> (int * int * int * int) -> unit
168       = "stub_xc_domain_deassign_device"
169external domain_test_assign_device: handle -> domid -> (int * int * int * int) -> bool
170       = "stub_xc_domain_test_assign_device"
171
172external version : handle -> version = "stub_xc_version_version"
173external version_compile_info : handle -> compile_info
174  = "stub_xc_version_compile_info"
175external version_changeset : handle -> string = "stub_xc_version_changeset"
176external version_capabilities : handle -> string
177  = "stub_xc_version_capabilities"
178
179type featureset_index = Featureset_raw | Featureset_host | Featureset_pv | Featureset_hvm
180external get_cpu_featureset : handle -> featureset_index -> int64 array = "stub_xc_get_cpu_featureset"
181
182type core_magic = Magic_hvm | Magic_pv
183type core_header = {
184  xch_magic : core_magic;
185  xch_nr_vcpus : int;
186  xch_nr_pages : nativeint;
187  xch_index_offset : int64;
188  xch_ctxt_offset : int64;
189  xch_pages_offset : int64;
190}
191external marshall_core_header : core_header -> string
192  = "stub_marshall_core_header"
193val coredump : handle -> domid -> Unix.file_descr -> unit
194external pages_to_kib : int64 -> int64 = "stub_pages_to_kib"
195val pages_to_mib : int64 -> int64
196external watchdog : handle -> int -> int32 -> int
197  = "stub_xc_watchdog"
198
199external domain_set_machine_address_size: handle -> domid -> int -> unit
200  = "stub_xc_domain_set_machine_address_size"
201external domain_get_machine_address_size: handle -> domid -> int
202       = "stub_xc_domain_get_machine_address_size"
203
204external domain_cpuid_set: handle -> domid -> (int64 * (int64 option))
205                        -> string option array
206                        -> string option array
207       = "stub_xc_domain_cpuid_set"
208external domain_cpuid_apply_policy: handle -> domid -> unit
209       = "stub_xc_domain_cpuid_apply_policy"
210