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  | X86_EMU_VPCI
44
45type xen_x86_arch_domainconfig = {
46  emulation_flags: x86_arch_emulation_flags list;
47}
48
49type arch_domainconfig =
50  | ARM of xen_arm_arch_domainconfig
51  | X86 of xen_x86_arch_domainconfig
52
53type domain_create_flag =
54  | CDF_HVM
55  | CDF_HAP
56  | CDF_S3_INTEGRITY
57  | CDF_OOS_OFF
58  | CDF_XS_DOMAIN
59  | CDF_IOMMU
60
61type domain_create_iommu_opts =
62  | IOMMU_NO_SHAREPT
63
64type domctl_create_config = {
65  ssidref: int32;
66  handle: string;
67  flags: domain_create_flag list;
68  iommu_opts: domain_create_iommu_opts list;
69  max_vcpus: int;
70  max_evtchn_port: int;
71  max_grant_frames: int;
72  max_maptrack_frames: int;
73  arch: arch_domainconfig;
74}
75
76type domaininfo = {
77  domid : domid;
78  dying : bool;
79  shutdown : bool;
80  paused : bool;
81  blocked : bool;
82  running : bool;
83  hvm_guest : bool;
84  shutdown_code : int;
85  total_memory_pages : nativeint;
86  max_memory_pages : nativeint;
87  shared_info_frame : int64;
88  cpu_time : int64;
89  nr_online_vcpus : int;
90  max_vcpu_id : int;
91  ssidref : int32;
92  handle : int array;
93  arch_config : arch_domainconfig;
94}
95type sched_control = { weight : int; cap : int; }
96type physinfo_cap_flag =
97  | CAP_HVM
98  | CAP_PV
99  | CAP_DirectIO
100  | CAP_HAP
101  | CAP_Shadow
102  | CAP_IOMMU_HAP_PT_SHARE
103
104type physinfo = {
105  threads_per_core : int;
106  cores_per_socket : int;
107  nr_cpus          : int;
108  max_node_id      : int;
109  cpu_khz          : int;
110  total_pages      : nativeint;
111  free_pages       : nativeint;
112  scrub_pages      : nativeint;
113  capabilities     : physinfo_cap_flag list;
114  max_nr_cpus      : int; (** compile-time max possible number of nr_cpus *)
115}
116type version = { major : int; minor : int; extra : string; }
117type compile_info = {
118  compiler : string;
119  compile_by : string;
120  compile_domain : string;
121  compile_date : string;
122}
123type shutdown_reason = Poweroff | Reboot | Suspend | Crash | Watchdog | Soft_reset
124
125exception Error of string
126type handle
127external interface_open : unit -> handle = "stub_xc_interface_open"
128external interface_close : handle -> unit = "stub_xc_interface_close"
129
130(** [with_intf f] runs [f] with a global handle that is opened on demand
131 * and kept open. Conceptually, a client should use either
132 * interface_open and interface_close or with_intf although mixing both
133 * is possible *)
134val with_intf : (handle -> 'a) -> 'a
135(** [get_handle] returns the global handle used by [with_intf] *)
136val get_handle: unit -> handle option
137(** [close handle] closes the handle maintained by [with_intf]. This
138 * should only be closed before process exit. It must not be called from
139 * a function called directly or indirectly by with_intf as this
140 * would invalidate the handle that with_intf passes to its argument. *)
141val close_handle: unit -> unit
142
143external domain_create : handle -> domctl_create_config -> domid
144  = "stub_xc_domain_create"
145external domain_sethandle : handle -> domid -> string -> unit = "stub_xc_domain_sethandle"
146external domain_max_vcpus : handle -> domid -> int -> unit
147  = "stub_xc_domain_max_vcpus"
148external domain_pause : handle -> domid -> unit = "stub_xc_domain_pause"
149external domain_unpause : handle -> domid -> unit = "stub_xc_domain_unpause"
150external domain_resume_fast : handle -> domid -> unit
151  = "stub_xc_domain_resume_fast"
152external domain_destroy : handle -> domid -> unit = "stub_xc_domain_destroy"
153external domain_shutdown : handle -> domid -> shutdown_reason -> unit
154  = "stub_xc_domain_shutdown"
155external _domain_getinfolist : handle -> domid -> int -> domaininfo list
156  = "stub_xc_domain_getinfolist"
157val domain_getinfolist : handle -> domid -> domaininfo list
158external domain_getinfo : handle -> domid -> domaininfo
159  = "stub_xc_domain_getinfo"
160external domain_get_vcpuinfo : handle -> int -> int -> vcpuinfo
161  = "stub_xc_vcpu_getinfo"
162external domain_ioport_permission: handle -> domid -> int -> int -> bool -> unit
163       = "stub_xc_domain_ioport_permission"
164external domain_iomem_permission: handle -> domid -> nativeint -> nativeint -> bool -> unit
165       = "stub_xc_domain_iomem_permission"
166external domain_irq_permission: handle -> domid -> int -> bool -> unit
167       = "stub_xc_domain_irq_permission"
168external vcpu_affinity_set : handle -> domid -> int -> bool array -> unit
169  = "stub_xc_vcpu_setaffinity"
170external vcpu_affinity_get : handle -> domid -> int -> bool array
171  = "stub_xc_vcpu_getaffinity"
172external vcpu_context_get : handle -> domid -> int -> string
173  = "stub_xc_vcpu_context_get"
174external sched_id : handle -> int = "stub_xc_sched_id"
175external sched_credit_domain_set : handle -> domid -> sched_control -> unit
176  = "stub_sched_credit_domain_set"
177external sched_credit_domain_get : handle -> domid -> sched_control
178  = "stub_sched_credit_domain_get"
179external shadow_allocation_set : handle -> domid -> int -> unit
180  = "stub_shadow_allocation_set"
181external shadow_allocation_get : handle -> domid -> int
182  = "stub_shadow_allocation_get"
183external evtchn_alloc_unbound : handle -> domid -> domid -> int
184  = "stub_xc_evtchn_alloc_unbound"
185external evtchn_reset : handle -> domid -> unit = "stub_xc_evtchn_reset"
186external readconsolering : handle -> string = "stub_xc_readconsolering"
187external send_debug_keys : handle -> string -> unit = "stub_xc_send_debug_keys"
188external physinfo : handle -> physinfo = "stub_xc_physinfo"
189external pcpu_info: handle -> int -> int64 array = "stub_xc_pcpu_info"
190external domain_setmaxmem : handle -> domid -> int64 -> unit
191  = "stub_xc_domain_setmaxmem"
192external domain_set_memmap_limit : handle -> domid -> int64 -> unit
193  = "stub_xc_domain_set_memmap_limit"
194external domain_memory_increase_reservation :
195  handle -> domid -> int64 -> unit
196  = "stub_xc_domain_memory_increase_reservation"
197external map_foreign_range :
198  handle -> domid -> int -> nativeint -> Xenmmap.mmap_interface
199  = "stub_map_foreign_range"
200
201external domain_assign_device: handle -> domid -> (int * int * int * int) -> unit
202       = "stub_xc_domain_assign_device"
203external domain_deassign_device: handle -> domid -> (int * int * int * int) -> unit
204       = "stub_xc_domain_deassign_device"
205external domain_test_assign_device: handle -> domid -> (int * int * int * int) -> bool
206       = "stub_xc_domain_test_assign_device"
207
208external version : handle -> version = "stub_xc_version_version"
209external version_compile_info : handle -> compile_info
210  = "stub_xc_version_compile_info"
211external version_changeset : handle -> string = "stub_xc_version_changeset"
212external version_capabilities : handle -> string
213  = "stub_xc_version_capabilities"
214
215type featureset_index = Featureset_raw | Featureset_host | Featureset_pv | Featureset_hvm
216external get_cpu_featureset : handle -> featureset_index -> int64 array = "stub_xc_get_cpu_featureset"
217
218external pages_to_kib : int64 -> int64 = "stub_pages_to_kib"
219val pages_to_mib : int64 -> int64
220external watchdog : handle -> int -> int32 -> int
221  = "stub_xc_watchdog"
222