Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions ocaml/test/test_vdi_allowed_operations.ml
Original file line number Diff line number Diff line change
Expand Up @@ -123,8 +123,8 @@ let test_ca125187 () =
* the VBD is plugged after the VDI is marked with the copy operation. *)
let _, _ = setup_test ~__context
~vdi_fun:(fun vdi_ref ->
let host_ref = Helpers.get_localhost ~__context in
let vm_ref = Db.Host.get_control_domain ~__context ~self:host_ref in
let host_ref = Helpers.get_localhost ~__context in
let vm_ref = Db.Host.get_control_domain ~__context ~self:host_ref in
let vbd_ref = Ref.make () in
let (_: API.ref_VBD) = make_vbd ~__context
~ref:vbd_ref
Expand Down
12 changes: 4 additions & 8 deletions ocaml/xapi/helpers.ml
Original file line number Diff line number Diff line change
Expand Up @@ -513,23 +513,19 @@ let boot_method_of_vm ~__context ~vm =
(** Returns true if the supplied VM configuration is HVM.
NB that just because a VM's current configuration looks like HVM doesn't imply it
actually booted that way; you must check the boot_record to be sure *)
let is_hvm ~__context (x: API.vM_t) =
let vm_ref = Db.VM.get_by_uuid ~__context ~uuid:x.API.vM_uuid in
(not (is_domain_zero ~__context vm_ref)) && x.API.vM_HVM_boot_policy <> ""
let is_hvm (x: API.vM_t) = x.API.vM_HVM_boot_policy <> ""

let will_boot_hvm ~__context ~self = Db.VM.get_HVM_boot_policy ~__context ~self <> ""

let has_booted_hvm ~__context ~self =
let boot_record = get_boot_record ~__context ~self in
(not (is_domain_zero ~__context self)) && boot_record.API.vM_HVM_boot_policy <> ""
boot_record.API.vM_HVM_boot_policy <> ""

let has_booted_hvm_of_record ~__context r =
let vm_uuid = r.Db_actions.vM_uuid in
let vm_ref = Db.VM.get_by_uuid ~__context ~uuid:vm_uuid in
let boot_record =
get_boot_record_of_record ~__context
~string:r.Db_actions.vM_last_booted_record ~uuid:vm_uuid in
(not (is_domain_zero ~__context vm_ref)) && boot_record.API.vM_HVM_boot_policy <> ""
~string:r.Db_actions.vM_last_booted_record ~uuid:r.Db_actions.vM_uuid in
boot_record.API.vM_HVM_boot_policy <> ""

let is_running ~__context ~self = Db.VM.get_domid ~__context ~self <> -1L

Expand Down
2 changes: 1 addition & 1 deletion ocaml/xapi/import.ml
Original file line number Diff line number Diff line change
Expand Up @@ -410,7 +410,7 @@ module VM : HandlerTools = struct
{vm_record with API.vM_has_vendor_device = false;}
) in
let vm_record = {vm_record with API.
vM_memory_overhead = Memory_check.vm_compute_memory_overhead ~__context vm_record
vM_memory_overhead = Memory_check.vm_compute_memory_overhead vm_record
} in
let vm_record = {vm_record with API.vM_protection_policy = Ref.null} in
(* Full restore preserves UUIDs, so if we are replacing an existing VM the version number should be incremented *)
Expand Down
18 changes: 9 additions & 9 deletions ocaml/xapi/memory_check.ml
Original file line number Diff line number Diff line change
Expand Up @@ -21,21 +21,21 @@ let ( /// ) = Int64.div

(** Calculates the amounts of 'normal' and 'shadow' host memory needed *)
(** to run the given guest with the given amount of guest memory. *)
let vm_compute_required_memory ~__context vm_record guest_memory_kib =
let vm_compute_required_memory vm_record guest_memory_kib =
let vcpu_count = Int64.to_int vm_record.API.vM_VCPUs_max in
let multiplier =
if Helpers.is_hvm ~__context vm_record
if Helpers.is_hvm vm_record
then vm_record.API.vM_HVM_shadow_multiplier
else XenopsMemory.Linux.shadow_multiplier_default in
let target_mib = XenopsMemory.mib_of_kib_used guest_memory_kib in
let max_mib = XenopsMemory.mib_of_bytes_used vm_record.API.vM_memory_static_max in
let footprint_mib = (
if Helpers.is_hvm ~__context vm_record
if Helpers.is_hvm vm_record
then XenopsMemory.HVM.footprint_mib
else XenopsMemory.Linux.footprint_mib)
target_mib max_mib vcpu_count multiplier in
let shadow_mib = (
if Helpers.is_hvm ~__context vm_record
if Helpers.is_hvm vm_record
then XenopsMemory.HVM.shadow_mib
else XenopsMemory.Linux.shadow_mib)
max_mib vcpu_count multiplier in
Expand Down Expand Up @@ -78,7 +78,7 @@ let vm_compute_start_memory ~__context ?(policy=Dynamic_min) vm_record =
~memory_dynamic_min: vm_record.API.vM_memory_dynamic_min
~memory_dynamic_max: vm_record.API.vM_memory_dynamic_max
~memory_static_max: vm_record.API.vM_memory_static_max in
vm_compute_required_memory ~__context vm_record
vm_compute_required_memory vm_record
(XenopsMemory.kib_of_bytes_used memory_required)

(** Calculates the amount of memory required in both 'normal' and 'shadow'
Expand All @@ -101,7 +101,7 @@ let vm_compute_used_memory ~__context policy vm_ref =
let vm_compute_resume_memory ~__context vm_ref =
if Xapi_fist.disable_memory_checks () then 0L else
let vm_boot_record = Helpers.get_boot_record ~__context ~self:vm_ref in
let (_, shadow_bytes) = vm_compute_required_memory ~__context
let (_, shadow_bytes) = vm_compute_required_memory
vm_boot_record vm_boot_record.API.vM_memory_static_max in
(* CA-31759: use the live target field for this *)
(* rather than the LBR to make upgrade easy. *)
Expand All @@ -112,7 +112,7 @@ let vm_compute_resume_memory ~__context vm_ref =
let vm_compute_migrate_memory ~__context vm_ref =
if Xapi_fist.disable_memory_checks () then 0L else
let vm_record = Db.VM.get_record ~__context ~self:vm_ref in
let (_, shadow_bytes) = vm_compute_required_memory ~__context
let (_, shadow_bytes) = vm_compute_required_memory
vm_record vm_record.API.vM_memory_static_max in
(* Only used when in rolling upgrade mode (from a pre-ballooning product) *)
let current_memory_usage_bytes = vm_record.API.vM_memory_static_max in
Expand Down Expand Up @@ -243,13 +243,13 @@ let host_compute_memory_overhead ~__context ~host =
(* to time and simply fetch the existing cached value from the database. *)
Db.Host.get_memory_overhead ~__context ~self:host

let vm_compute_memory_overhead ~__context snapshot =
let vm_compute_memory_overhead snapshot =
let static_max_bytes = snapshot.API.vM_memory_static_max in
let static_max_mib = XenopsMemory.mib_of_bytes_used static_max_bytes in
let multiplier = snapshot.API.vM_HVM_shadow_multiplier in
let vcpu_count = Int64.to_int (snapshot.API.vM_VCPUs_max) in
let memory_overhead_mib = (
if Helpers.is_hvm ~__context snapshot
if Helpers.is_hvm snapshot
then XenopsMemory.HVM.overhead_mib
else XenopsMemory.Linux.overhead_mib)
static_max_mib vcpu_count multiplier in
Expand Down
4 changes: 2 additions & 2 deletions ocaml/xapi/memory_check.mli
Original file line number Diff line number Diff line change
Expand Up @@ -53,7 +53,7 @@ type accounting_policy =
val get_host_memory_summary : __context:Context.t -> host:API.ref_host ->
host_memory_summary

val vm_compute_required_memory : __context:Context.t -> API.vM_t -> int64 -> int64 * int64
val vm_compute_required_memory : API.vM_t -> int64 -> int64 * int64

val vm_compute_start_memory : __context:Context.t ->
?policy:accounting_policy -> API.vM_t -> int64 * int64
Expand Down Expand Up @@ -93,5 +93,5 @@ val host_compute_free_memory_with_maximum_compression : ?dump_stats:bool ->
val host_compute_memory_overhead : __context:Context.t -> host:[`host] Ref.t ->
int64

val vm_compute_memory_overhead : __context:Context.t -> API.vM_t -> int64
val vm_compute_memory_overhead : API.vM_t -> int64

5 changes: 2 additions & 3 deletions ocaml/xapi/xapi_vm_helpers.ml
Original file line number Diff line number Diff line change
Expand Up @@ -36,10 +36,9 @@ let compute_memory_overhead ~__context ~vm =
let snapshot = match Db.VM.get_power_state ~__context ~self:vm with
| `Paused | `Running | `Suspended -> Helpers.get_boot_record ~__context ~self:vm
| `Halted | _ -> Db.VM.get_record ~__context ~self:vm in
Memory_check.vm_compute_memory_overhead ~__context snapshot
Memory_check.vm_compute_memory_overhead snapshot

let update_memory_overhead ~__context ~vm =
Db.VM.set_memory_overhead ~__context ~self:vm ~value:(compute_memory_overhead ~__context ~vm)
let update_memory_overhead ~__context ~vm = Db.VM.set_memory_overhead ~__context ~self:vm ~value:(compute_memory_overhead ~__context ~vm)

(* Overrides for database set functions: ************************************************)
let set_actions_after_crash ~__context ~self ~value =
Expand Down
2 changes: 1 addition & 1 deletion ocaml/xapi/xapi_vm_migrate.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1099,7 +1099,7 @@ let handler req fd _ =
configure this to prevent the domain ballooning up and allocating more than target_kib
of guest memory on unpause. *)
let snapshot = { snapshot with API.vM_memory_target = XenopsMemory.bytes_of_kib target_kib } in
let overhead_bytes = Memory_check.vm_compute_memory_overhead ~__context snapshot in
let overhead_bytes = Memory_check.vm_compute_memory_overhead snapshot in
let free_memory_required_kib = Int64.add (XenopsMemory.kib_of_bytes_used overhead_bytes) memory_required_kib in
debug "overhead_bytes = %Ld; free_memory_required = %Ld KiB" overhead_bytes free_memory_required_kib;

Expand Down