-and addr_of_string t str =
- let bits = bits_of_wordsize (get_wordsize t) in
- let e = get_endian t in
- let bs = Bitstring.bitstring_of_string str in
- bitmatch bs with
- | { addr : bits : endian (e) } -> addr
- | { _ } -> invalid_arg "addr_of_string"
-
-(* Take bytes until a condition is not met. This is efficient in that
- * we stay within the same mapping as long as we can.
- *)
-let dowhile { mappings = mappings } addr cond =
- let rec get_next_mapping addr = function
- | [] -> invalid_arg "dowhile"
- | { start = start; size = size; arr = arr } :: _
- when start <= addr && addr < start +^ size ->
- let offset = Int64.to_int (addr -^ start) in
- let len = Int64.to_int size - offset in
- arr, offset, len
- | _ :: ms -> get_next_mapping addr ms
- in
- let rec loop addr =
- let arr, offset, len = get_next_mapping addr mappings in
- let rec loop2 i =
- if i < len then (
- let c = Array1.get arr (offset+i) in
- if cond c then loop2 (i+1)
- ) else
- loop (addr +^ Int64.of_int len)
- in
- loop2 0
- in
- loop addr
-
-let get_bytes t addr len =
- let str = String.create len in
- let i = ref 0 in
- try
- dowhile t addr (
- fun c ->
- str.[!i] <- c;
- incr i;
- !i < len
- );
- str
- 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
- dowhile t addr (
- fun c ->
- if c <> '\000' then (
- chars := c :: !chars;
- true
- ) else false
- );
- let chars = List.rev !chars in
- let len = List.length chars in
- let str = String.create len in
- let i = ref 0 in
- List.iter (fun c -> str.[!i] <- c; incr i) chars;
- str
- with
- Invalid_argument _ -> invalid_arg "get_string"
-
-let is_string t addr =
- try dowhile t addr (fun c -> c <> '\000'); true
- with Invalid_argument _ -> false
-
-let is_C_identifier t addr =
- let i = ref 0 in
- let r = ref true in
- try
- dowhile t addr (
- fun c ->
- let b =
- if !i = 0 then (
- c = '_' || c >= 'A' && c <= 'Z' || c >= 'a' && c <= 'z'
- ) else (
- if c = '\000' then false
- else (
- if c = '_' || c >= 'A' && c <= 'Z' || c >= 'a' && c <= 'z' ||
- c >= '0' && c <= '9' then
- true
- else (
- r := false;
- false
- )
- )
- ) in
- incr i;
- b
- );
- !r
- 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
-