NUMA claim handling improvements

ocaml/xapi-idl/memory/memory.ml

@@ -185,6 +185,7 @@ type memory_config = {
   ; shadow_mib: int64
   ; required_host_free_mib: int64
   ; overhead_mib: int64
+  ; build_claim_pages: int64
 }
 
 module Memory_model (D : MEMORY_MODEL_DATA) = struct
@@ -228,14 +229,16 @@ module Memory_model (D : MEMORY_MODEL_DATA) = struct
   let shadow_multiplier_default = 1.0
 
   let full_config static_max_mib video_mib target_mib vcpus shadow_multiplier =
+    let build_start_mib = build_start_mib static_max_mib target_mib video_mib in
     {
       build_max_mib= build_max_mib static_max_mib video_mib
-    ; build_start_mib= build_start_mib static_max_mib target_mib video_mib
+    ; build_start_mib
     ; xen_max_mib= xen_max_mib static_max_mib
     ; shadow_mib= shadow_mib static_max_mib vcpus shadow_multiplier
     ; required_host_free_mib=
         footprint_mib target_mib static_max_mib vcpus shadow_multiplier
     ; overhead_mib= overhead_mib static_max_mib vcpus shadow_multiplier
+    ; build_claim_pages= pages_of_mib build_start_mib
     }
 end
 

ocaml/xenopsd/lib/xenops_server.ml

@@ -155,7 +155,8 @@ type atomic =
   | VM_create_device_model of (Vm.id * bool)
   | VM_destroy_device_model of Vm.id
   | VM_destroy of Vm.id
-  | VM_create of (Vm.id * int64 option * Vm.id option * bool) (*no_sharept*)
+  | VM_create of (Vm.id * (int64 * int64 option) option * Vm.id option * bool)
+    (*no_sharept*)
   | VM_build of (Vm.id * bool)
   | VM_shutdown_domain of (Vm.id * shutdown_request * float)
   | VM_s3suspend of Vm.id
@@ -330,6 +331,7 @@ type vm_receive_op = {
   ; vmr_socket: Unix.file_descr
   ; vmr_handshake: string option  (** handshake protocol *)
   ; vmr_compressed: bool
+  ; vmr_memory_total_source: int64 option [@default None]
 }
 [@@deriving rpcty]
 
@@ -2317,19 +2319,26 @@ let rec perform_atomic ~progress_callback ?result (op : atomic)
   | VM_destroy id ->
       debug "VM.destroy %s" id ;
       B.VM.destroy t (VM_DB.read_exn id)
-  | VM_create (id, memory_upper_bound, final_id, no_sharept) ->
+  | VM_create (id, memory_upper_bound_and_source, final_id, no_sharept) ->
       let num_of_vbds = List.length (VBD_DB.vbds id) in
       let num_of_vifs = List.length (VIF_DB.vifs id) in
+      let memory_upper_bound = Option.map fst memory_upper_bound_and_source
+      and memory_total_source =
+        Option.map snd memory_upper_bound_and_source |> Option.join
+      in
       debug
-        "VM.create %s memory_upper_bound = %s, num_of_vbds = %d, num_of_vifs = \
-         %d"
+        "VM.create %s memory_upper_bound = %s, memory_total_source = %s, \
+         num_of_vbds = %d, num_of_vifs = %d"
         id
         (Option.value ~default:"None"
            (Option.map Int64.to_string memory_upper_bound)
         )
+        (Option.value ~default:"None"
+           (Option.map Int64.to_string memory_total_source)
+        )
         num_of_vbds num_of_vifs ;
-      B.VM.create t memory_upper_bound (VM_DB.read_exn id) final_id no_sharept
-        num_of_vbds num_of_vifs
+      B.VM.create t memory_upper_bound memory_total_source (VM_DB.read_exn id)
+        final_id no_sharept num_of_vbds num_of_vifs
   | VM_build (id, force) ->
       debug "VM.build %s" id ;
       let vbds : Vbd.t list = VBD_DB.vbds id |> vbd_plug_order in
@@ -2897,7 +2906,10 @@ and perform_exn ?result (op : operation) (t : Xenops_task.task_handle) : unit =
             Request.write (fun _ -> ()) request fd
           in
           do_request vm_fd
-            [("memory_limit", Int64.to_string state.Vm.memory_limit)]
+            [
+              ("memory_limit", Int64.to_string state.Vm.memory_limit)
+            ; ("memory_total_source", Int64.to_string state.Vm.memory_actual)
+            ]
             url ;
           let first_handshake () =
             ( match Handshake.recv vm_fd with
@@ -3004,6 +3016,7 @@ and perform_exn ?result (op : operation) (t : Xenops_task.task_handle) : unit =
         vmr_id= id
       ; vmr_final_id= final_id
       ; vmr_memory_limit= memory_limit
+      ; vmr_memory_total_source= memory_total_source
       ; vmr_socket= s
       ; vmr_handshake= handshake
       ; vmr_compressed
@@ -3084,7 +3097,14 @@ and perform_exn ?result (op : operation) (t : Xenops_task.task_handle) : unit =
                 )
               in
               perform_atomics
-                ([VM_create (id, Some memory_limit, Some final_id, no_sharept)]
+                ([
+                   VM_create
+                     ( id
+                     , Some (memory_limit, memory_total_source)
+                     , Some final_id
+                     , no_sharept
+                     )
+                 ]
                 (* Perform as many operations as possible on the destination
                    domain before pausing the original domain *)
                 @ atomics_of_operation (VM_restore_vifs id)
@@ -3902,6 +3922,9 @@ module VM = struct
     let module Response = Cohttp.Response.Make (Cohttp_posix_io.Unbuffered_IO) in
     let dbg = List.assoc "dbg" cookies in
     let memory_limit = List.assoc "memory_limit" cookies |> Int64.of_string in
+    let memory_total_source =
+      List.assoc_opt "memory_total_source" cookies |> Option.map Int64.of_string
+    in
     let handshake = List.assoc_opt cookie_mem_migration cookies in
     let compressed_memory = get_compression cookies in
     Debug.with_thread_associated dbg
@@ -3932,6 +3955,7 @@ module VM = struct
                 ; vmr_socket= transferred_fd
                 ; vmr_handshake= handshake
                 ; vmr_compressed= compressed_memory
+                ; vmr_memory_total_source= memory_total_source
                 }
             in
             let task =

ocaml/xenopsd/lib/xenops_server_plugin.ml

@@ -81,6 +81,7 @@ module type S = sig
     val create :
          Xenops_task.task_handle
       -> int64 option
+      -> int64 option
       -> Vm.t
       -> Vm.id option
       -> bool (* no_sharept*)

ocaml/xenopsd/lib/xenops_server_simulator.ml

@@ -566,7 +566,7 @@ module VM = struct
 
   let remove _vm = ()
 
-  let create _ memory_limit vm _ _ _ _ =
+  let create _ memory_limit _ vm _ _ _ _ =
     with_lock m (create_nolock memory_limit vm)
 
   let destroy _ vm = with_lock m (destroy_nolock vm)

ocaml/xenopsd/xc/domain.ml

@@ -152,6 +152,8 @@ type builder_spec_info =
 type build_info = {
     memory_max: int64  (** memory max in kilobytes *)
   ; memory_target: int64  (** memory target in kilobytes *)
+  ; memory_total_source: int64 option
+        (** amount of memory to claim (during migration) *)
   ; kernel: string  (** in hvm case, point to hvmloader *)
   ; vcpus: int  (** vcpus max *)
   ; priv: builder_spec_info
@@ -246,7 +248,10 @@ let wait_xen_free_mem ~xc ?(maximum_wait_time_seconds = 64) required_memory_kib
     in
     (* At exponentially increasing intervals, write  *)
     (* a debug message saying how long we've waited: *)
-    if is_power_of_2 accumulated_wait_time_seconds then
+    if
+      accumulated_wait_time_seconds = 0
+      || is_power_of_2 accumulated_wait_time_seconds
+    then
       debug
         "Waited %i second(s) for memory to become available: %Ld KiB free, %Ld \
          KiB scrub, %Ld KiB required"
@@ -1057,7 +1062,7 @@ let numa_placement domid ~vcpus ~cores ~memory affinity =
               __FUNCTION__ domid ;
             None
       in
-      let nr_pages = Int64.div memory 4096L |> Int64.to_int in
+      let nr_pages = Memory.pages_of_bytes_used memory |> Int64.to_int in
       try
         D.debug "NUMAClaim domid %d: local claim on node %d: %d pages" domid
           node nr_pages ;
@@ -1071,7 +1076,7 @@ let numa_placement domid ~vcpus ~cores ~memory affinity =
           D.debug "NUMAClaim domid %d: local claim not available" domid ;
           set_vcpu_affinity cpu_affinity ;
           None
-      | Xenctrlext.Unix_error (errno, _) ->
+      | Xenctrlext.Unix_error ((Unix.ENOMEM as errno), _) ->
           D.info
             "%s: unable to claim enough memory, domain %d won't be hosted in a \
              single NUMA node. (error %s)"
@@ -1083,6 +1088,13 @@ let numa_placement domid ~vcpus ~cores ~memory affinity =
 let build_pre ~xc ~xs ~vcpus ~memory ~hard_affinity domid =
   let open Memory in
   let uuid = get_uuid ~xc domid in
+  debug
+    "VM = %s, build_max_mib = %Ld, build_start_mib = %Ld, xen_max_mib =\n\
+    \    %Ld, shadow_mib = %Ld, required_host_free_mib = %Ld, overhead_mib = \
+     %Ld"
+    (Uuidx.to_string uuid) memory.build_max_mib memory.build_start_mib
+    memory.xen_max_mib memory.shadow_mib memory.required_host_free_mib
+    memory.overhead_mib ;
   debug "VM = %s; domid = %d; waiting for %Ld MiB of free host memory"
     (Uuidx.to_string uuid) domid memory.required_host_free_mib ;
   (* CA-39743: Wait, if necessary, for the Xen scrubber to catch up. *)
@@ -1170,10 +1182,38 @@ let build_pre ~xc ~xs ~vcpus ~memory ~hard_affinity domid =
               and cores =
                 Xenops_server.cores_of_numa_affinity_policy pin ~vcpus
               in
-              numa_placement domid ~vcpus ~cores
-                ~memory:(Int64.mul memory.xen_max_mib 1048576L)
-                affinity
-              |> Option.map fst
+
+              let build_claim_bytes =
+                Memory.bytes_of_pages memory.build_claim_pages
+              in
+              D.debug "VM = %s; domid = %d; will claim %Ld bytes = %Ld pages"
+                (Uuidx.to_string uuid) domid build_claim_bytes
+                memory.build_claim_pages ;
+              let memory = build_claim_bytes in
+              match numa_placement domid ~vcpus ~cores ~memory affinity with
+              | None ->
+                  (* Always perform a global claim when NUMA placement is
+                     enabled, and single node claims failed or were
+                     unavailable:
+                     This tries to ensures that memory allocated for this
+                     domain won't use up memory claimed by other domains.
+                     If claims are mixed with non-claims then Xen can't
+                     currently guarantee that it would honour the existing
+                     claims.
+                     A failure here is a hard failure: we'd fail allocating
+                     memory later anyway
+                  *)
+                  let nr_pages =
+                    Memory.pages_of_bytes_used memory |> Int64.to_int
+                  in
+                  let xcext = Xenctrlext.get_handle () in
+                  D.debug "NUMAClaim domid %d: global claim: %d pages" domid
+                    nr_pages ;
+                  Xenctrlext.domain_claim_pages xcext domid
+                    ~numa_node:Xenctrlext.NumaNode.none nr_pages ;
+                  None
+              | Some (plan, _) ->
+                  Some plan
         )
   in
   let store_chan, console_chan = create_channels ~xc uuid domid in
@@ -1865,6 +1905,17 @@ let restore (task : Xenops_task.task_handle) ~xc ~xs ~dm ~timeoffset ~extras
         maybe_ca_140252_workaround ~xc ~vcpus domid ;
         (memory, vm_stuff, `pvh)
   in
+  let memory =
+    match info.memory_total_source with
+    | None ->
+        memory
+    | Some kib ->
+        let build_claim_pages = Memory.pages_of_kib_used kib in
+        let bytes = Memory.bytes_of_kib kib in
+        debug "Domid %d: memory_total_source = %Ld bytes = %Ld KiB = %Ld pages"
+          domid bytes kib build_claim_pages ;
+        Memory.{memory with build_claim_pages}
+  in
   let store_port, console_port, numa_placements =
     build_pre ~xc ~xs ~memory ~vcpus ~hard_affinity:info.hard_affinity domid
   in

ocaml/xenopsd/xc/domain.mli

@@ -130,6 +130,8 @@ val builder_spec_info : builder_spec_info Rpc.Types.def
 type build_info = {
     memory_max: int64  (** memory max in kilobytes *)
   ; memory_target: int64  (** memory target in kilobytes *)
+  ; memory_total_source: int64 option
+        (** memory used on source during migration/resume in kilobytes *)
   ; kernel: string  (** image to load. In HVM case, point to hvmloader *)
   ; vcpus: int  (** vcpus max *)
   ; priv: builder_spec_info

ocaml/xenopsd/xc/xenops_server_xen.ml

@@ -1637,6 +1637,7 @@ module VM = struct
       {
         Domain.memory_max= vm.memory_static_max /// 1024L
       ; memory_target= vm.memory_dynamic_min /// 1024L
+      ; memory_total_source= None
       ; kernel= ""
       ; vcpus= vm.vcpu_max
       ; priv= builder_spec_info
@@ -1747,8 +1748,8 @@ module VM = struct
         in
         (device_id, revision)
 
-  let create_exn task memory_upper_bound vm final_id no_sharept num_of_vbds
-      num_of_vifs =
+  let create_exn task memory_upper_bound memory_total_source vm final_id
+      no_sharept num_of_vbds num_of_vifs =
     let k = vm.Vm.id in
     with_xc_and_xs (fun xc xs ->
         (* Ensure the DB contains something for this VM - this is to avoid a
@@ -1821,33 +1822,40 @@ module VM = struct
                  needed. If we are live migrating then we will only know an
                  upper bound. If we are starting from scratch then we have a
                  free choice. *)
-              let min_bytes, max_bytes =
+              let min_bytes, max_bytes, memory_total_source_bytes =
                 match memory_upper_bound with
                 | Some x ->
                     debug "VM = %s; using memory_upper_bound = %Ld" vm.Vm.id x ;
-                    (x, x)
+                    (x, x, memory_total_source)
                 | None ->
                     if resuming then (
                       debug "VM = %s; using stored suspend_memory_bytes = %Ld"
                         vm.Vm.id persistent.VmExtra.suspend_memory_bytes ;
                       ( persistent.VmExtra.suspend_memory_bytes
                       , persistent.VmExtra.suspend_memory_bytes
+                      , Some persistent.VmExtra.suspend_memory_bytes
                       )
                     ) else (
                       debug
                         "VM = %s; using memory_dynamic_min = %Ld and \
                          memory_dynamic_max = %Ld"
                         vm.Vm.id vm.memory_dynamic_min vm.memory_dynamic_max ;
-                      (vm.memory_dynamic_min, vm.memory_dynamic_max)
+                      (vm.memory_dynamic_min, vm.memory_dynamic_max, None)
                     )
               in
               let min_kib = kib_of_bytes_used (min_bytes +++ overhead_bytes)
+              and memory_total_source_kib =
+                Option.map kib_of_bytes_used memory_total_source_bytes
               and max_kib = kib_of_bytes_used (max_bytes +++ overhead_bytes) in
               (* XXX: we would like to be able to cancel an in-progress
                  with_reservation *)
               let dbg = Xenops_task.get_dbg task in
               Mem.with_reservation dbg min_kib max_kib
                 (fun target_plus_overhead_kib reservation_id ->
+                  debug
+                    "VM = %s, memory [%Ld KiB, %Ld KiB], \
+                     target_plus_overhead=%Ld KiB"
+                    vm.Vm.id min_kib max_kib target_plus_overhead_kib ;
                   let domain_config, persistent =
                     match persistent.VmExtra.domain_config with
                     | Some dc ->
@@ -1888,8 +1896,26 @@ module VM = struct
                     let target_bytes =
                       target_plus_overhead_bytes --- overhead_bytes
                     in
+                    debug
+                      "VM = %s, memory target_bytes = %Ld, dynamic max = %Ld"
+                      vm.Vm.id target_bytes vm.memory_dynamic_max ;
                     min vm.memory_dynamic_max target_bytes
                   in
+                  let persistent =
+                    match persistent with
+                    | {VmExtra.build_info= Some x; _} as t ->
+                        {
+                          t with
+                          build_info=
+                            Some
+                              {
+                                x with
+                                memory_total_source= memory_total_source_kib
+                              }
+                        }
+                    | _ ->
+                        persistent
+                  in
                   set_initial_target ~xs domid (Int64.div initial_target 1024L) ;
                   (* Log uses of obsolete option *)
                   if vm.suppress_spurious_page_faults then
@@ -2367,6 +2393,7 @@ module VM = struct
       {
         Domain.memory_max= static_max_kib
       ; memory_target= initial_target
+      ; memory_total_source= None
       ; kernel
       ; vcpus= vm.vcpu_max
       ; priv
@@ -3005,6 +3032,7 @@ module VM = struct
               | _ ->
                   ""
             in
+            debug "VM = %s, initial_target = %Ld" vm.Vm.id initial_target ;
             ({x with Domain.memory_target= initial_target}, timeoffset)
       in
       let vtpm = vtpm_of ~vm in
@@ -3144,7 +3172,10 @@ module VM = struct
             let memory_actual =
               let pages = Int64.of_nativeint di.Xenctrl.total_memory_pages in
               let kib = Xenctrl.pages_to_kib pages in
-              Memory.bytes_of_kib kib
+              let bytes = Memory.bytes_of_kib kib in
+              D.debug "VM %s memory actual: %Ld pages = %Ld KiB = %Ld bytes"
+                (Uuidm.to_string uuid) pages kib bytes ;
+              bytes
             in
             let memory_limit =
               (* The maximum amount of memory the domain can consume is the max
@@ -3167,7 +3198,10 @@ module VM = struct
               in
               (* CA-31764: may be larger than static_max if maxmem has been
                  increased to initial-reservation. *)
-              max memory_actual max_memory_bytes
+              let result = max memory_actual max_memory_bytes in
+              D.debug "VM %s memory limit = %Ld bytes" (Uuidm.to_string uuid)
+                result ;
+              result
             in
             let rtc =
               try