X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=lib%2Fvirt_mem_mmap.ml;h=c323c1a0096c3e7e97252c8a704a1248f77a2066;hb=795abd3201eb6eae29ba8abd60db928f5889fdbe;hp=bf048f793565131f397843d6478096570552ca63;hpb=f515867f07955345c801e13e6667485667cfc199;p=virt-mem.git

diff --git a/lib/virt_mem_mmap.ml b/lib/virt_mem_mmap.ml
index bf048f7..c323c1a 100644
--- a/lib/virt_mem_mmap.ml
+++ b/lib/virt_mem_mmap.ml
@@ -309,9 +309,13 @@ let rec get_mapping addr = function
 (* Use the tree to quickly check if an address is mapped (returns false
  * if it's a hole).
  *)
-let is_mapped { tree = tree } addr =
-  let _, mapping = get_mapping addr tree in
-  mapping <> None
+let is_mapped { mappings = mappings; tree = tree } addr =
+  (* NB: No [`HasMapping] in the type so we have to check mappings <> []. *)
+  match mappings with
+  | [] -> false
+  | _ ->
+      let _, mapping = get_mapping addr tree in
+      mapping <> None
 
 (* Get a single byte. *)
 let get_byte { tree = tree } addr =
@@ -410,6 +414,19 @@ let dowhile { tree = tree } addr cond =
   in
   loop addr
 
+let is_mapped_range ({ mappings = mappings } as t) addr size =
+  match mappings with
+  (* NB: No [`HasMapping] in the type so we have to check mappings <> []. *)
+  | [] -> false
+  | _ ->
+      (* Quick and dirty.  It's possible to make a much faster
+       * implementation of this which doesn't call the closure for every
+       * byte.
+       *)
+      let size = ref size in
+      try dowhile t addr (fun _ _ -> decr size; !size > 0); true
+      with Invalid_argument "dowhile" -> false
+
 (* Get a string, ending at ASCII NUL character. *)
 let get_string t addr =
   let chars = ref [] in