<commit_before>(*
 * Copyright (C) 2006-2009 Citrix Systems Inc.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published
 * by the Free Software Foundation; version 2.1 only. with the special
 * exception on linking described in file LICENSE.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU Lesser General Public License for more details.
 *)

(** *)
type domid = int

(* ** xenctrl.h ** *)

type vcpuinfo =
{
	online: bool;
	blocked: bool;
	running: bool;
	cputime: int64;
	cpumap: int32;
}

type runstateinfo = {
  state : int32;
  missed_changes: int32;
  state_entry_time : int64;
  time0 : int64;
  time1 : int64;
  time2 : int64;
  time3 : int64;
  time4 : int64;
  time5 : int64;
}

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 =
{
	nr_cpus          : int;
	threads_per_core : int;
	cores_per_socket : int;
	sockets_per_node : int;
	nr_nodes         : int;
	cpu_khz          : int;
	total_pages      : nativeint;
	free_pages       : nativeint;
	scrub_pages      : nativeint;
	(* XXX hw_cap *)
	capabilities     : physinfo_cap_flag list;
}

type version =
{
	major : int;
	minor : int;
	extra : string;
}


type compile_info =
{
	compiler : string;
	compile_by : string;
	compile_domain : string;
	compile_date : string;
}

type shutdown_reason = Poweroff | Reboot | Suspend | Crash | Halt

type domain_create_flag = CDF_HVM | CDF_HAP

exception Error of string

type handle

(* this is only use by coredumping *)
external sizeof_core_header: unit -> int
       = "stub_sizeof_core_header"
external sizeof_vcpu_guest_context: unit -> int
       = "stub_sizeof_vcpu_guest_context"
external sizeof_xen_pfn: unit -> int = "stub_sizeof_xen_pfn"
(* end of use *)

external interface_open: unit -> handle = "stub_xc_interface_open"
external interface_close: handle -> unit = "stub_xc_interface_close"

external using_injection: unit -> bool = "stub_xc_using_injection"

let with_intf f =
	let xc = interface_open () in
	let r = try f xc with exn -> interface_close xc; raise exn in
	interface_close xc;
	r

external _domain_create: handle -> int32 -> domain_create_flag list -> int array -> domid
       = "stub_xc_domain_create"

let domain_create handle n flags uuid =
	_domain_create handle n flags (Uuid.int_array_of_uuid uuid)

external _domain_sethandle: handle -> domid -> int array -> unit
                          = "stub_xc_domain_sethandle"

let domain_sethandle handle n uuid =
	_domain_sethandle handle n (Uuid.int_array_of_uuid uuid)

external domain_setvmxassist: handle -> domid -> bool -> unit
       = "stub_xc_domain_setvmxassist"

external domain_max_vcpus: handle -> domid -> int -> unit
       = "stub_xc_domain_max_vcpus"

external domain_pause: handle -> domid -> unit = "stub_xc_domain_pause"
external domain_unpause: handle -> domid -> unit = "stub_xc_domain_unpause"
external domain_resume_fast: handle -> domid -> unit = "stub_xc_domain_resume_fast"
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
       = "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 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_get_vcpuinfo: handle -> int -> int -> vcpuinfo
       = "stub_xc_vcpu_getinfo"
external domain_get_runstate_info : handle -> int -> runstateinfo<commit_msg>CA-35397: Increase the number of domain info structs returned per call from 2 to 100.<commit_after>(*
 * Copyright (C) 2006-2009 Citrix Systems Inc.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published
 * by the Free Software Foundation; version 2.1 only. with the special
 * exception on linking described in file LICENSE.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU Lesser General Public License for more details.
 *)

(** *)
type domid = int

(* ** xenctrl.h ** *)

type vcpuinfo =
{
	online: bool;
	blocked: bool;
	running: bool;
	cputime: int64;
	cpumap: int32;
}

type runstateinfo = {
  state : int32;
  missed_changes: int32;
  state_entry_time : int64;
  time0 : int64;
  time1 : int64;
  time2 : int64;
  time3 : int64;
  time4 : int64;
  time5 : int64;
}

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 =
{
	nr_cpus          : int;
	threads_per_core : int;
	cores_per_socket : int;
	sockets_per_node : int;
	nr_nodes         : int;
	cpu_khz          : int;
	total_pages      : nativeint;
	free_pages       : nativeint;
	scrub_pages      : nativeint;
	(* XXX hw_cap *)
	capabilities     : physinfo_cap_flag list;
}

type version =
{
	major : int;
	minor : int;
	extra : string;
}


type compile_info =
{
	compiler : string;
	compile_by : string;
	compile_domain : string;
	compile_date : string;
}

type shutdown_reason = Poweroff | Reboot | Suspend | Crash | Halt

type domain_create_flag = CDF_HVM | CDF_HAP

exception Error of string

type handle

(* this is only use by coredumping *)
external sizeof_core_header: unit -> int
       = "stub_sizeof_core_header"
external sizeof_vcpu_guest_context: unit -> int
       = "stub_sizeof_vcpu_guest_context"
external sizeof_xen_pfn: unit -> int = "stub_sizeof_xen_pfn"
(* end of use *)

external interface_open: unit -> handle = "stub_xc_interface_open"
external interface_close: handle -> unit = "stub_xc_interface_close"

external using_injection: unit -> bool = "stub_xc_using_injection"

let with_intf f =
	let xc = interface_open () in
	let r = try f xc with exn -> interface_close xc; raise exn in
	interface_close xc;
	r

external _domain_create: handle -> int32 -> domain_create_flag list -> int array -> domid
       = "stub_xc_domain_create"

let domain_create handle n flags uuid =
	_domain_create handle n flags (Uuid.int_array_of_uuid uuid)

external _domain_sethandle: handle -> domid -> int array -> unit
                          = "stub_xc_domain_sethandle"

let domain_sethandle handle n uuid =
	_domain_sethandle handle n (Uuid.int_array_of_uuid uuid)

external domain_setvmxassist: handle -> domid -> bool -> unit
       = "stub_xc_domain_setvmxassist"

external domain_max_vcpus: handle -> domid -> int -> unit
       = "stub_xc_domain_max_vcpus"

external domain_pause: handle -> domid -> unit = "stub_xc_domain_pause"
external domain_unpause: handle -> domid -> unit = "stub_xc_domain_unpause"
external domain_resume_fast: handle -> domid -> unit = "stub_xc_domain_resume_fast"
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
       = "stub_xc_domain_getinfolist"

let domain_getinfolist handle first_domain =
	let nb = 100 in
	let last_domid l = (List.hd l).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_get_vcpuinfo: handle -> int -> int -> vcpuinfo
       = "stub_xc_vcpu_getinfo"
external domain_get_runstate_info : handle -> int -> runstateinfo
{'fraction_non_alphanumeric': 0.08375411635565312, 'fraction_numerical': 0.011745334796926455, 'mean_word_length': 3.3655965500718734, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 85, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3238038', 'n_tokens_mistral': 3136, 'n_tokens_neox': 3109, 'n_words': 895}