From 77eac20189958446ce5510fa57dd72cedca6d70c Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Thu, 1 Jan 1970 00:00:00 +0000
Subject: [PATCH] Optimized the hot inner loop.

---
 lib/.depend      |  4 ++++
 lib/diskimage.ml | 21 +++++++++++++++++++++
 2 files changed, 25 insertions(+)

diff --git a/lib/.depend b/lib/.depend
index fa24106..8fc3cf7 100644
--- a/lib/.depend
+++ b/lib/.depend
@@ -43,5 +43,9 @@ diskimage_utils.cmo: int63.cmi diskimage_utils.cmi
 diskimage_utils.cmx: int63.cmx diskimage_utils.cmi 
 int63.cmo: int63.cmi 
 int63.cmx: int63.cmi 
+int63_on_32.cmo: int63_on_32.cmi 
+int63_on_32.cmx: int63_on_32.cmi 
+int63_on_64.cmo: int63_on_64.cmi 
+int63_on_64.cmx: int63_on_64.cmi 
 test_int63.cmo: int63.cmi 
 test_int63.cmx: int63.cmx 
diff --git a/lib/diskimage.ml b/lib/diskimage.ml
index 807094a..f2b5823 100644
--- 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) ->
-- 
1.8.3.1