type ('a,'b) t = {
mappings : mapping list;
wordsize : wordsize option;
- endian : Bitmatch.endian option;
+ endian : Bitstring.endian option;
}
and mapping = {
start : 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
+ (* Copy the string data to a Bigarray. *)
+ 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
in
loop mappings
+(* The following functions are actually written in C
+ * because memmem(3) is likely to be much faster than anything
+ * we could write in OCaml.
+ *
+ * Also OCaml bigarrays are specifically designed to be accessed
+ * easily from C:
+ * http://caml.inria.fr/pub/docs/manual-ocaml/manual043.html
+ *)
+(*
(* Array+offset = string? *)
let string_at arr offset str strlen =
let j = ref offset in
loop ()
)
else Some start
+*)
+external _find_in :
+ int -> int -> string -> (char,int8_unsigned_elt,c_layout) Array1.t ->
+ int option = "virt_mem_mmap_find_in"
(* Generic find function. *)
let _find t start align str =
let bits = bits_of_wordsize (get_wordsize t) in
let e = get_endian t in
let bs = BITSTRING { addr : bits : endian (e) } in
- Bitmatch.string_of_bitstring bs
+ Bitstring.string_of_bitstring bs
*)
-(* XXX bitmatch is missing 'construct_int64_le_unsigned' so we
+(* XXX bitstring is missing 'construct_int64_le_unsigned' so we
* have to force this to 32 bits for the moment.
*)
and string_of_addr t addr =
assert (bits = 32);
let e = get_endian t in
let bs = BITSTRING { Int64.to_int32 addr : 32 : endian (e) } in
- Bitmatch.string_of_bitstring bs
+ Bitstring.string_of_bitstring bs
and addr_of_string t str =
let bits = bits_of_wordsize (get_wordsize t) in
let e = get_endian t in
- let bs = Bitmatch.bitstring_of_string str in
+ let bs = Bitstring.bitstring_of_string str in
bitmatch bs with
| { addr : bits : endian (e) } -> addr
| { _ } -> invalid_arg "addr_of_string"
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
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 = Bitstring.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 = Bitstring.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
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
let bits = bits_of_wordsize ws in
let str = get_bytes t addr (bytes_of_wordsize ws) in
- let bs = Bitmatch.bitstring_of_string str in
+ let bs = Bitstring.bitstring_of_string str in
bitmatch bs with
| { addr : bits : endian (e) } -> addr
| { _ } -> invalid_arg "follow_pointer"
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)