Manpage for uname and dmesg

[virt-mem.git] / lib / virt_mem_mmap.ml

diff --git a/lib/virt_mem_mmap.ml b/lib/virt_mem_mmap.ml
index 7401e17..98dc84a 100644 (file)
--- a/lib/virt_mem_mmap.ml
+++ b/lib/virt_mem_mmap.ml
@@ -78,6 +78,25 @@ let of_file fd addr =
   let t = create () in
   add_file t fd addr
 
+let add_string ({ mappings = mappings } as t) str addr =
+  if addr &^ 7L <> 0L then
+    invalid_arg "add_file: mapping address must be aligned to 8 bytes";
+  let size = String.length str in
+  (* Use Bigarray.Array1. XXX We should just use the string. *)
+  let arr = Array1.create char c_layout size in
+  for i = 0 to size-1 do
+    Array1.set arr i (String.unsafe_get str i)
+  done;
+  (* Create the mapping entry and keep the mappings sorted by start addr. *)
+  let mappings =
+    { start = addr; size = Int64.of_int size; arr = arr } :: mappings in
+  let mappings = sort_mappings mappings in
+  { t with mappings = mappings }
+
+let of_string str addr =
+  let t = create () in
+  add_string t str addr
+
 (* Find in mappings and return first predicate match. *)
 let _find_map { mappings = mappings } pred =
   let rec loop = function
@@ -205,7 +224,7 @@ let get_byte { mappings = mappings } addr =
   let rec loop = function
     | [] -> invalid_arg "get_byte"
     | { start = start; size = size; arr = arr } :: _
-       when start <= addr && addr < size ->
+       when start <= addr && addr < start +^ size ->
        let offset = Int64.to_int (addr -^ start) in
        Char.code (Array1.get arr offset)
     | _ :: ms -> loop ms
@@ -252,6 +271,30 @@ let get_bytes t addr len =
   with
     Invalid_argument _ -> invalid_arg "get_bytes"
 
+let get_int32 t addr =
+  let e = get_endian t in
+  let str = get_bytes t addr 4 in
+  let bs = Bitmatch.bitstring_of_string str in
+  bitmatch bs with
+  | { addr : 32 : endian (e) } -> addr
+  | { _ } -> invalid_arg "follow_pointer"
+
+let get_int64 t addr =
+  let e = get_endian t in
+  let str = get_bytes t addr 8 in
+  let bs = Bitmatch.bitstring_of_string str in
+  bitmatch bs with
+  | { addr : 64 : endian (e) } -> addr
+  | { _ } -> invalid_arg "follow_pointer"
+
+let get_C_int = get_int32
+
+let get_C_long t addr =
+  let ws = get_wordsize t in
+  match ws with
+  | W32 -> Int64.of_int32 (get_int32 t addr)
+  | W64 -> get_int64 t addr
+
 let get_string t addr =
   let chars = ref [] in
   try
@@ -303,6 +346,15 @@ let is_C_identifier t addr =
   with
     Invalid_argument _ -> false
 
+let is_mapped { mappings = mappings } addr =
+  let rec loop = function
+    | [] -> false
+    | { start = start; size = size; arr = arr } :: _
+       when start <= addr && addr < start +^ size -> true
+    | _ :: ms -> loop ms
+  in
+  loop mappings
+
 let follow_pointer t addr =
   let ws = get_wordsize t in
   let e = get_endian t in
@@ -320,3 +372,8 @@ let succ_long t addr =
 let pred_long t addr =
   let ws = get_wordsize t in
   addr -^ Int64.of_int (bytes_of_wordsize ws)
+
+let align t addr =
+  let ws = get_wordsize t in
+  let mask = Int64.of_int (bytes_of_wordsize ws - 1) in
+  (addr +^ mask) &^ (Int64.lognot mask)