Optimized the hot inner loop.

[virt-df.git] / lib / diskimage.ml

diff --git a/lib/diskimage.ml b/lib/diskimage.ml
index 807094a..f2b5823 100644 (file)
--- a/lib/diskimage.ml
+++ b/lib/diskimage.ml
@@ -665,8 +665,29 @@ let get_owners_lookup machine ownership (disk : block_device) =
   let tree = List.assoc (disk :> device) ownership in
 
   fun offset ->
+    (* Warning: This 'hot' code was carefully optimized based on
+     * feedback from 'gprof'.  Avoid fiddling with it.
+     *)
     let rec query = function
       | Leaf (_, segments) -> segments
+
+      (* Try to avoid expensive '@' operator if node segments is empty: *)
+      | Node ((Leaf ((_, leftend), _) | Node (_, ((_, leftend), _), _) as left),
+             (_, []),
+             right) ->
+         let subsegments =
+           if offset < leftend then query left else query right in
+         subsegments
+
+      (* ... or a singleton: *)
+      | Node ((Leaf ((_, leftend), _) | Node (_, ((_, leftend), _), _) as left),
+             (_, [segment]),
+             right) ->
+         let subsegments =
+           if offset < leftend then query left else query right in
+         segment :: subsegments
+
+      (* Normal recursive case: *)
       | Node ((Leaf ((_, leftend), _) | Node (_, ((_, leftend), _), _) as left),
              (_, segments),
              right) ->