forked from xapi-project/xen-api
-
Notifications
You must be signed in to change notification settings - Fork 0
/
squeeze.ml
628 lines (543 loc) · 25.8 KB
/
squeeze.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
(*
* 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.
*)
(**
Implement a simple 'proportional memory' policy where VMs are squeezed
equally to free memory. There is no direct attempt to respond to distress or
memory pressure information from within the guest. Guests which are stuck
(e.g. broken balloon driver or who cannot free any more memory) are observed
and worked around.
*)
(*
Remember:
Be tolerant of domains appearing or disappearing.
What if target <> memory_actual because of domU accounting errors.
Can we calibrate on boot if the offset is const?
*)
(* Make debug printing work both when linked into a daemon and from the commandline *)
let start = Unix.gettimeofday ()
module D = Debug.Debugger(struct let name = "xenops" end)
let debug_oc = ref stdout
let debug fmt =
Printf.kprintf
(fun x ->
Printf.fprintf !debug_oc "[%.2f] %s\n" (Unix.gettimeofday() -. start) x;
flush !debug_oc;
D.debug "%s" x
) fmt
let error fmt =
Printf.kprintf
(fun x ->
Printf.fprintf !debug_oc "[%.2f] %s\n" (Unix.gettimeofday() -. start) x;
flush !debug_oc;
D.error "%s" x
) fmt
(** Per-domain data *)
type domain = {
domid: int;
(** true if the domain has ballooning capability i.e. is not paused etc. *)
can_balloon: bool;
(** admin-imposed lower-limit on the balloon target *)
dynamic_min_kib: int64;
(** current balloon target requested by the system *)
target_kib: int64;
(** admin-imposed upper-limit on the balloon target *)
dynamic_max_kib: int64;
(** view from dom0 of how much memory this guest is using *)
memory_actual_kib: int64;
(** xen maxmem *)
memory_max_kib: int64;
(** amount by which the target may differ from memory_actual and be declared a 'hit' *)
inaccuracy_kib: int64;
}
let domain_make
domid can_balloon dynamic_min_kib target_kib dynamic_max_kib memory_actual_kib memory_max_kib inaccuracy_kib =
{
domid = domid;
can_balloon = can_balloon;
dynamic_min_kib = dynamic_min_kib;
target_kib = target_kib;
dynamic_max_kib = dynamic_max_kib;
memory_actual_kib = memory_actual_kib;
memory_max_kib = memory_max_kib;
inaccuracy_kib = inaccuracy_kib;
}
let domain_to_string_pairs (x: domain) =
let i64 = Int64.to_string and i = string_of_int in
[
"domid", i x.domid;
"can_balloon", string_of_bool x.can_balloon;
"dynamic_min_kib", i64 x.dynamic_min_kib;
"target_kib", i64 x.target_kib;
"dynamic_max_kib", i64 x.dynamic_max_kib;
"memory_actual_kib", i64 x.memory_actual_kib;
"memory_max_kib", i64 x.memory_max_kib;
"inaccuracy_kib", i64 x.inaccuracy_kib;
]
module IntMap = Map.Make(struct type t = int let compare = compare end)
(** Per-Host data *)
type host = {
(** VMs running on this host *)
domains: domain list;
domid_to_domain: domain IntMap.t;
(** total free memory on this host *)
free_mem_kib: int64;
}
let make_host ~domains ~free_mem_kib =
{
domains = domains;
domid_to_domain = List.fold_left (fun map domain -> IntMap.add domain.domid domain map) IntMap.empty domains;
free_mem_kib = free_mem_kib;
}
let string_pairs_to_string (x: (string * string) list) =
String.concat "; " (List.map (fun (k, v) -> k ^ "=" ^ v) x)
let domain_to_string d = string_pairs_to_string (domain_to_string_pairs d)
let host_to_string_pairs (x: host) =
let domains = (String.concat "; " (List.map domain_to_string x.domains)) in
[
"domains", "[" ^ domains ^ "]";
"free_mem_kib", Int64.to_string x.free_mem_kib;
]
(** The ballooning algorithm returns a list of actions to perform *)
type action = {
(** domid of domain to operate on *)
action_domid: int;
(** new balloon target to set *)
new_target_kib: int64;
}
let action_to_string_pairs (x: action) = [
"domid", string_of_int x.action_domid;
"new_target_kib", Int64.to_string x.new_target_kib;
]
let ( -* ) = Int64.sub
let ( +* ) = Int64.add
let ( ** ) = Int64.mul
let set_difference a b = List.filter (fun x -> not (List.mem x b)) a
let sum = List.fold_left ( +* ) 0L
(** The value returned from the 'free_memory' function *)
type result =
| Success
(** enough memory is now available *)
| Failed of int list
(** we have run out of options: all domains are either
fully-ballooned or are stuck (stuck domids returned) *)
| AdjustTargets of action list
(** we want to change the targets of some domains *)
type direction = Up | Down
let string_of_direction = function
| Some Up -> "^" | Some Down -> "v" | None -> "x"
let direction_of_actual inaccuracy_kib memory_actual_kib target_kib =
let delta_kib = memory_actual_kib -* target_kib in
let abs x = if x < 0L then 0L -* x else x in
if abs delta_kib <= inaccuracy_kib then None
else (if target_kib > memory_actual_kib then Some Down else Some Up)
let direction_of_int64 a b = if a = b then None else (if a > b then Some Down else Some Up)
(** Work around the fact that the target may not be hit precisely *)
let has_hit_target inaccuracy_kib memory_actual_kib target_kib =
direction_of_actual inaccuracy_kib memory_actual_kib target_kib = None
let short_string_of_domain domain =
Printf.sprintf "%d T%Ld A%Ld M%Ld %s%s" domain.domid
domain.target_kib domain.memory_actual_kib domain.memory_max_kib
(if domain.can_balloon then "B" else "?")
(string_of_direction (direction_of_actual domain.inaccuracy_kib domain.memory_actual_kib domain.target_kib))
(** Generic code to guesstimate if a balloon driver is stuck *)
module Stuckness_monitor = struct
(*
We keep some state to help us spot stuck / dead / unco-operative
balloon drivers. If a driver has been requested to release some memory
but nothing has changed after some threshold time, we mark it as stuck
and exclude it from our calculations. The effect is to ask the remaining
functioning balloon drivers to balloon down faster.
*)
let assume_balloon_driver_stuck_after = 5. (* seconds *)
type per_domain_state = {
mutable last_actual_kib: int64; (** last value of memory actual seen *)
mutable last_makingprogress_time: float; (** last time we saw progress towards the target *)
mutable stuck: bool;
}
type t = {
per_domain: (int, per_domain_state) Hashtbl.t;
}
(** Make a monitoring object *)
let make () : t =
{ per_domain = Hashtbl.create 10 }
(** Update our internal state given a snapshot of the outside world *)
let update (x: t) (host: host) (now: float) =
List.iter
(fun (domain: domain) ->
let direction = direction_of_actual domain.inaccuracy_kib domain.memory_actual_kib domain.target_kib in
if not(Hashtbl.mem x.per_domain domain.domid)
then Hashtbl.replace x.per_domain domain.domid
(* new domains are considered to be making progress now and not stuck *)
{ last_actual_kib = domain.memory_actual_kib;
last_makingprogress_time = now;
stuck = false };
let state = Hashtbl.find x.per_domain domain.domid in
let delta_actual = domain.memory_actual_kib -* state.last_actual_kib in
state.last_actual_kib <- domain.memory_actual_kib;
(* If memory_actual is moving towards the target then we say we are makingprogress *)
let makingprogress = (delta_actual > 0L && direction = Some Down) || (delta_actual < 0L && direction = Some Up) in
(* We keep track of the last time we were makingprogress. If we are makingprogress now
then we are not stuck. *)
if makingprogress then begin
state.last_makingprogress_time <- now;
state.stuck <- false;
end;
(* If there is a request (ie work to do) and we haven't been makingprogress for more than the
assume_balloon_driver_stuck_after then declare this domain stuck. *)
let request = direction <> None in (* ie target <> actual *)
if request && (now -. state.last_makingprogress_time > assume_balloon_driver_stuck_after)
then state.stuck <- true;
)
host.domains;
(* Clear out dead domains just in case someone keeps *)
(* one of these things around for a long time. *)
let live_domids = List.map (fun domain -> domain.domid) host.domains in
let to_delete = Hashtbl.fold
(fun domid _ acc ->
if List.mem domid live_domids then acc else domid :: acc
)
x.per_domain []
in
List.iter (Hashtbl.remove x.per_domain) to_delete
(** Return true if we think a particular driver is still making useful progress.
If it is not making progress it may have either hit its target or it may have failed. *)
let domid_is_active (x: t) domid (now: float) =
if not (Hashtbl.mem x.per_domain domid)
then false (* it must have been destroyed *)
else not (Hashtbl.find x.per_domain domid).stuck
end
type fistpoint =
| DisableTwoPhaseTargetSets (** this prevents free memory going to 0 and allowing all low memory to be allocated *)
| DisableInaccuracyCompensation (** don't factor balloon driver inaccuracy into calculations *)
(** The minimum amount we will free by setting target = dynamic_min *)
let min_freeable ?(fistpoints=[]) domain =
if List.mem DisableInaccuracyCompensation fistpoints
then max 0L (domain.memory_actual_kib -* domain.dynamic_min_kib)
else max 0L (domain.memory_actual_kib -* domain.dynamic_min_kib -* 2L ** domain.inaccuracy_kib)
(** The minimum amount we will allocate by setting target = dynamic_max *)
let min_allocatable domain = max 0L (domain.dynamic_max_kib -* domain.memory_actual_kib -* 2L ** domain.inaccuracy_kib)
(** The range between dynamic_min and dynamic_max i.e. the total amount we may vary the balloon target
NOT the total amount the memory_actual may vary. *)
let range domain = max 0L (domain.dynamic_max_kib -* domain.dynamic_min_kib)
module type POLICY = sig
val compute_target_adjustments: ?fistpoints:(fistpoint list) -> bool -> host -> int64 -> (domain * int64) list
end
(**
Represents an algorithm which attempts to (i) free memory; and (ii) balance
memory between VMs on a host by setting balloon targets.
*)
module Proportional = struct
(** Constrains [value] within the range [minimum] ... [maximum]. *)
let constrain minimum maximum value =
assert (minimum < maximum);
if value < minimum then minimum else
if value > maximum then maximum else
if classify_float value = FP_nan then minimum else (* arbitrary *)
value
(**
Given an amount of theoretically surplus memory (= host free memory +
that which would be freed by ballooning down to dynamic_min) produce a
set of balloon-target-set actions to divide it up amongst the given VMs
so that (target - min) / (max - min) is the same for all VMs.
*)
let allocate_memory_in_proportion verbose surplus_memory_kib domains =
(* We allocate surplus memory in proportion to each domain's dynamic_range: *)
let allocate gamma domain = Int64.of_float (gamma *. (Int64.to_float (range domain))) in
(* gamma = the proportion where 0 <= gamma <= 1 *)
let total_range = sum (List.map range domains) in
let gamma' = Int64.to_float surplus_memory_kib /. (Int64.to_float total_range) in
let gamma = constrain 0. 1. gamma' in
if verbose then begin
debug "total_range = %Ld gamma = %f gamma' = %f" total_range gamma gamma';
debug "Total additional memory over dynamic_min = %Ld KiB; will set gamma = %.2f (leaving unallocated %Ld KiB)" surplus_memory_kib gamma
(if total_range = 0L then 0L else Int64.of_float (Int64.to_float total_range *. (gamma' -. gamma)));
end;
List.map (fun domain -> domain, domain.dynamic_min_kib +* (allocate gamma domain)) domains
(* Given a set of domains and a host free memory target, return balloon target adjustments *)
let compute_target_adjustments ?fistpoints verbose (host: host) host_target_kib =
(* If all domains balloon down to dynamic_min: *)
let maximum_free_mem_kib = host.free_mem_kib +* (sum (List.map (min_freeable ?fistpoints) host.domains)) in
let surplus_memory_kib = max 0L (maximum_free_mem_kib -* host_target_kib) in
allocate_memory_in_proportion verbose surplus_memory_kib host.domains
end
module Policy = (Proportional: POLICY)
module Squeezer = struct
(** State maintained between invocations of the algorithm function *)
type t = {
stuckness: Stuckness_monitor.t;
non_active_domids: int list; (* domids are unique and constant *)
}
let make () = { stuckness = Stuckness_monitor.make (); non_active_domids = [] }
(**
Takes a view of the host state and amount of free memory desired and
returns a list of ballooning actions which may help achieve the goal.
*)
let one_iteration ?(fistpoints=[]) verbose success_condition (x: t) (host: host) host_target_kib (now: float) =
(* 1. Compute which domains are still considered active *)
Stuckness_monitor.update x.stuckness host now;
let active_domains =
List.filter (fun domain ->
domain.can_balloon
&& (Stuckness_monitor.domid_is_active x.stuckness domain.domid now))
host.domains in
let non_active_domids = List.map (fun d -> d.domid) (set_difference host.domains active_domains) in
let declared_inactive_domids = set_difference non_active_domids x.non_active_domids in
let declared_active_domids = set_difference x.non_active_domids non_active_domids in
if verbose then begin
List.iter
(fun d ->
debug "domid %d has been declared inactive" d
) declared_inactive_domids;
List.iter
(fun d ->
debug "domid %d has been declared active" d
) declared_active_domids;
end;
let x = { x with non_active_domids = non_active_domids } in
(* 2. Compute how we would adjust the domain memory targets *)
let targets = Policy.compute_target_adjustments ~fistpoints verbose { host with domains = active_domains } host_target_kib in
let maximum_possible_free_memory_kib = host.free_mem_kib +* (sum (List.map (min_freeable ~fistpoints) active_domains)) in
if verbose
then debug "Maximum possible free memory if all active domains balloon down to dynamic_min = %Ld" maximum_possible_free_memory_kib;
(* Xen heap workaround: *)
let is_freeing_memory (domain, new_target_kib) = not (has_hit_target domain.inaccuracy_kib domain.memory_actual_kib new_target_kib) && new_target_kib < domain.memory_actual_kib in
let freeing, allocating = List.partition is_freeing_memory targets in
let allocation_phase = freeing = [] in
let targets =
if List.mem DisableTwoPhaseTargetSets fistpoints
then targets
else (if allocation_phase then allocating else freeing) in
(* Have all the non-stuck domains reached their current targets? *)
let all p xs = List.fold_left (&&) true (List.map p xs) in
let hit_target domain = has_hit_target domain.inaccuracy_kib domain.memory_actual_kib domain.target_kib in
let all_targets_reached = all hit_target active_domains in
let max_target domain = domain.target_kib = domain.dynamic_max_kib in
let cant_allocate_any_more = all max_target active_domains in
(* Note the asymmetry between:
1. increasing free memory: if we think we can't free enough then we give up
2. reducing free memory: we wait until as much as possible is allocated *)
let success = success_condition host.free_mem_kib in
let target_too_big = maximum_possible_free_memory_kib < host_target_kib in
let no_target_changes = List.filter (fun (domain, target) -> domain.target_kib <> target) targets = [] in
if verbose
then debug "current host free mem = %Ld KiB (aiming for %Ld KiB);%s; all domain targets%s reached%s; %s"
host.free_mem_kib host_target_kib
(if success then " OK"
else if target_too_big then " cannot free enough"
else if cant_allocate_any_more then " cannot allocate enough" else "")
(if all_targets_reached then "" else " not")
(if no_target_changes then "" else "; however about to adjust targets")
(if allocation_phase then "allocation phase" else "freeing phase");
(* If we have to blame a domain for being stuck, we don't blame it if it can't balloon. *)
let non_active_domains = List.concat (List.map (fun d -> try [ IntMap.find d host.domid_to_domain ] with Not_found -> []) non_active_domids) in
let non_active_can_balloon_domains = List.filter (fun d -> d.can_balloon) non_active_domains in
let non_active_can_balloon_domids = List.map (fun d -> d.domid) non_active_can_balloon_domains in
(* 1. In all cases we wait for all targets to be reached and to be stable.
2. If targets are reached and stable we evaluate our success condition and succeed/fail accordingly. *)
let action =
if not all_targets_reached || not no_target_changes
then AdjustTargets (List.map (fun (d, t) -> { action_domid = d.domid; new_target_kib = t}) targets)
else
if success then Success
else Failed non_active_can_balloon_domids in
x, declared_active_domids, declared_inactive_domids, action
end
module Gnuplot = struct
type colspec = Dynamic_min | Memory_actual | Dynamic_max | Target
let write_header oc cols =
let all = List.concat [ if List.mem Dynamic_min cols then [ "dynamic_min" ] else [];
if List.mem Dynamic_max cols then [ "dynamic_max" ] else [];
if List.mem Memory_actual cols then [ "memory_actual" ] else [];
if List.mem Target cols then [ "target" ] else [] ] in
Printf.fprintf oc "# for each domain: %s\n" (String.concat " " all)
let write_row oc host cols time =
Printf.fprintf oc "%.2f %Ld " time host.free_mem_kib;
List.iter
(fun domain ->
if List.mem Dynamic_min cols
then Printf.fprintf oc " %Ld " domain.dynamic_min_kib;
if List.mem Dynamic_max cols
then Printf.fprintf oc " %Ld " domain.dynamic_max_kib;
if List.mem Memory_actual cols
then Printf.fprintf oc " %Ld " domain.memory_actual_kib;
if List.mem Target cols
then Printf.fprintf oc " %Ld " domain.target_kib
)
host.domains;
Printf.fprintf oc "\n"
let write_gp stem host cols =
let oc = open_out (Printf.sprintf "%s.gp" stem) in
Printf.fprintf oc "set xlabel 'time/seconds'\n";
Printf.fprintf oc "set ylabel 'memory/KiB'\n";
Printf.fprintf oc "plot \"%s.dat\" using 1:2 title \"free host memory\" \
with lines " stem;
let col = ref 3 in
List.iter
(fun domain ->
if List.mem Dynamic_min cols
then (Printf.fprintf oc ", \"%s.dat\" using 1:%d title \"domid %d \
dynamic_min\" with points " stem !col domain.domid; incr col);
if List.mem Dynamic_max cols
then (Printf.fprintf oc ", \"%s.dat\" using 1:%d title \"domid %d \
dynamic_max\" with points " stem !col domain.domid; incr col);
if List.mem Memory_actual cols
then (Printf.fprintf oc ", \"%s.dat\" using 1:%d title \"domid %d \
memory_actual\" with lines " stem !col domain.domid; incr col);
if List.mem Target cols
then (Printf.fprintf oc ", \"%s.dat\" using 1:%d title \"domid %d \
target\" with lines " stem !col domain.domid; incr col);
)
host.domains;
close_out oc
end
type io = {
verbose: bool;
make_host: unit -> string * host;
domain_setmaxmem: int -> int64 -> unit;
execute_action: action -> unit;
wait: float -> unit;
gettimeofday: unit -> float;
target_host_free_mem_kib: int64;
free_memory_tolerance_kib: int64;
}
exception Cannot_free_this_much_memory of int64 * int64 (** even if we balloon everyone down we can't free this much *)
exception Domains_refused_to_cooperate of int list (** these VMs didn't release memory and we failed *)
let change_host_free_memory ?fistpoints io required_mem_kib success_condition =
(* XXX: debugging *)
if io.verbose
then debug "change_host_free_memory required_mem = %Ld KiB" required_mem_kib;
let acc = ref (Squeezer.make ()) in
let finished = ref false in
while not (!finished) do
let t = io.gettimeofday () in
let host_debug_string, host = io.make_host () in
let acc', declared_active_domids, declared_inactive_domids, result =
Squeezer.one_iteration ?fistpoints io.verbose success_condition !acc host required_mem_kib t in
acc := acc';
(* Set the max_mem of a domain as follows:
If the VM has never been run && is paused -> use initial-reservation
If the VM is active -> use target
If the VM is inactive -> use min(target, actual)
So active VMs may move up or down towards their target and either get there
(while we actively monitor them) or are declared inactive.
Inactive VMs are allowed to free memory while we aren't looking but
they are not to allocate more.
Note that the concept of having 'never been run' is hidden from us by the
'make_host' function above. The data we receive here will show either an
inactive (paused) domain with target=actual=initial_reservation or an
active (unpaused) domain. So the we need only deal with 'active' vs 'inactive'.
*)
(* Compile a list of new targets *)
let new_targets = match result with
| AdjustTargets actions ->
List.map (fun a -> a.action_domid, a.new_target_kib) actions
| _ -> [] in
let new_target_direction domain =
let new_target = if List.mem_assoc domain.domid new_targets then Some(List.assoc domain.domid new_targets) else None in
match new_target with
| None -> string_of_direction None
| Some t -> string_of_direction (direction_of_int64 domain.target_kib t) in
let debug_string = String.concat "; " (host_debug_string :: (List.map (fun domain -> short_string_of_domain domain ^ (new_target_direction domain)) host.domains)) in
debug "%s" debug_string;
(* For each domid, decide what maxmem should be *)
let maxmems = IntMap.mapi
(fun domid domain ->
if List.mem domid declared_inactive_domids
then
(* CA-41832: clip the target of an 'inactive' domain to within the dynamic min-max range.
The danger here is that a domain might be using less than dynamic min now, but might
suddenly wake up and allocate memory belonging to someone else later. *)
let ideal_kib = min domain.target_kib domain.memory_actual_kib in
min domain.dynamic_max_kib (max domain.dynamic_min_kib ideal_kib)
else
if List.mem_assoc domid new_targets
then List.assoc domid new_targets
else domain.target_kib) host.domid_to_domain in
IntMap.iter io.domain_setmaxmem maxmems;
begin match result with
| Success ->
if io.verbose
then debug "Success: Host free memory = %Ld KiB" required_mem_kib;
finished := true
| Failed [] ->
if io.verbose
then debug "Failed to free %Ld KiB of memory: operation impossible within current dynamic_min limits of balloonable domains" required_mem_kib;
raise (Cannot_free_this_much_memory (required_mem_kib, host.free_mem_kib));
| Failed [ 0 ] ->
(* CA-75568: dom0 is changing its memory allocation without being asked *)
if io.verbose
then error "Failed to free %Ld KiB of memory: domain 0 has failed to meet its memory target" required_mem_kib;
raise (Cannot_free_this_much_memory (required_mem_kib, host.free_mem_kib));
| Failed domids ->
let s = String.concat ", " (List.map string_of_int domids) in
if io.verbose
then debug "Failed to free %Ld KiB of memory: the following domains have failed to meet their targets: [ %s ]"
required_mem_kib s;
raise (Domains_refused_to_cooperate domids)
| AdjustTargets actions ->
(* Set all the balloon targets *)
List.iter io.execute_action actions;
io.wait 1.
end
done
let free_memory fistpoints io required_mem_kib =
change_host_free_memory ?fistpoints io (required_mem_kib +* io.target_host_free_mem_kib) (fun x -> x >= (required_mem_kib +* io.target_host_free_mem_kib))
let free_memory_range ?fistpoints io min_kib max_kib =
(* First compute the 'ideal' amount of free memory based on the proportional allocation policy *)
let domain = { domid = -1;
can_balloon = true;
dynamic_min_kib = min_kib; dynamic_max_kib = max_kib;
target_kib = min_kib;
memory_actual_kib = 0L;
memory_max_kib = 0L;
inaccuracy_kib = 4L;
} in
let host = snd(io.make_host ())in
let host' = { host with domains = domain :: host.domains } in
let adjustments = Policy.compute_target_adjustments io.verbose host' io.target_host_free_mem_kib in
let target =
if List.mem_assoc domain adjustments
then List.assoc domain adjustments
else min_kib in
debug "free_memory_range ideal target = %Ld" target;
change_host_free_memory ?fistpoints io (target +* io.target_host_free_mem_kib) (fun x -> x >= (min_kib +* io.target_host_free_mem_kib));
let host = snd(io.make_host ()) in
let usable_free_mem_kib = host.free_mem_kib -* io.target_host_free_mem_kib in
if usable_free_mem_kib < min_kib then begin
debug "WARNING usable_free_mem_kib (%Ld) < min_kib (%Ld) (difference = %Ld KiB)" usable_free_mem_kib min_kib (min_kib -* usable_free_mem_kib);
end;
max min_kib (min usable_free_mem_kib max_kib)
let is_balanced ?fistpoints io x = Int64.sub x io.target_host_free_mem_kib < io.free_memory_tolerance_kib
let balance_memory ?fistpoints io =
try
change_host_free_memory ?fistpoints io io.target_host_free_mem_kib (is_balanced io);
with e -> debug "balance memory caught: %s" (Printexc.to_string e)
(** Return true if the host memory is currently unbalanced and needs rebalancing *)
let is_host_memory_unbalanced ?fistpoints io =
let debug_string, host = io.make_host () in
let domains = List.map (fun d -> d.domid, d) host.domains in
let _, _, _, result = Squeezer.one_iteration ?fistpoints false
(is_balanced io) (Squeezer.make ()) host
io.target_host_free_mem_kib (io.gettimeofday ()) in
let is_new_target a =
let existing = (List.assoc a.action_domid domains).target_kib in
a.new_target_kib <> existing in
match result with
| AdjustTargets ts ->
if List.fold_left (||) false (List.map is_new_target ts) then begin
debug "Memory is not currently balanced";
debug "%s" debug_string;
true
end else false
| _ -> false