diff --git a/core/perf_map.ml b/core/perf_map.ml index 52f9c971e0..f0a5bf93c9 100644 --- a/core/perf_map.ml +++ b/core/perf_map.ml @@ -12,9 +12,6 @@ let perf_map_re = Re.Posix.re {|^([0-9a-fA-F]+) ([0-9a-fA-F]+) (.*)$|} |> Re.compile ;; -let hex_to_int s = Int.Hex.of_string ("0x" ^ s) -let hex_to_int64 s = Int64.Hex.of_string ("0x" ^ s) - let parse_line line = (* empty string for the last line in a file *) if String.is_empty line @@ -23,8 +20,10 @@ let parse_line line = try match Re.Group.all (Re.exec perf_map_re line) with | [| _; start_addr; size; function_ |] -> - let start_addr = hex_to_int64 start_addr in - (start_addr, { Perf_map_location.start_addr; size = hex_to_int size; function_ }) + let start_addr = Util.int64_of_hex_string start_addr in + ( start_addr + , { Perf_map_location.start_addr; size = Util.int_of_hex_string size; function_ } + ) |> Some | _ -> failwith "doesn't match regex" with diff --git a/core/util.ml b/core/util.ml new file mode 100644 index 0000000000..82ca5d8625 --- /dev/null +++ b/core/util.ml @@ -0,0 +1,62 @@ +open! Core + +let intable_of_hex_string + (type a) + (module M : Int_intf.S with type t = a) + ?(remove_hex_prefix = false) + str + = + (* Bit hacks for fast parsing of hex strings. + * + * Note that in ASCII, ('1' | 'a' | 'A') & 0xF = 1. + * + * So for each character, take the bottom 4 bits, and add 9 if it's + * not a digit. *) + let res = ref (M.of_int_exn 0) in + let fifteen = M.of_int_exn 0xF in + let eight = M.of_int_exn 0x8 in + for i = if remove_hex_prefix then 2 else 0 to String.length str - 1 do + let open M in + let c = of_int_exn (Char.to_int (String.unsafe_get str i)) in + res := (!res lsl 4) lor ((c land fifteen) + ((c lsr 6) lor ((c lsr 3) land eight))) + done; + !res +;; + +let int64_of_hex_string = intable_of_hex_string (module Int64) +let int_of_hex_string = intable_of_hex_string (module Int) + +let%test_module _ = + (module struct + open Core + + let check ?remove_hex_prefix str = + print_s + [%message + "" + ~int64:(int64_of_hex_string ?remove_hex_prefix str : Int64.Hex.t) + ~int:(int_of_hex_string ?remove_hex_prefix str : Int.Hex.t)] + ;; + + let%expect_test "int64 hex parsing" = + check ~remove_hex_prefix:true "0x7f9db48c1d80"; + [%expect {| + ((int64 0x7f9db48c1d80) (int 0x7f9db48c1d80)) |}]; + check "7f9db48c1d80"; + [%expect {| + ((int64 0x7f9db48c1d80) (int 0x7f9db48c1d80)) |}]; + check "fF"; + [%expect {| + ((int64 0xff) (int 0xff)) |}]; + check "f0f"; + [%expect {| + ((int64 0xf0f) (int 0xf0f)) |}]; + check "fA0f"; + [%expect {| + ((int64 0xfa0f) (int 0xfa0f)) |}]; + check "0"; + [%expect {| + ((int64 0x0) (int 0x0)) |}] + ;; + end) +;; diff --git a/core/util.mli b/core/util.mli new file mode 100644 index 0000000000..3173cd8e66 --- /dev/null +++ b/core/util.mli @@ -0,0 +1,4 @@ +open! Core + +val int64_of_hex_string : ?remove_hex_prefix:bool -> string -> int64 +val int_of_hex_string : ?remove_hex_prefix:bool -> string -> int diff --git a/src/import.ml b/src/import.ml index 5ab542724a..cbfe03e4c4 100644 --- a/src/import.ml +++ b/src/import.ml @@ -1,6 +1,7 @@ include struct open Magic_trace_core module Backend_intf = Backend_intf + module Collection_mode = Collection_mode module Decode_result = Decode_result module Elf = Elf module Errno = Errno @@ -12,7 +13,7 @@ include struct module Symbol = Symbol module Timer_resolution = Timer_resolution module Trace_scope = Trace_scope - module Collection_mode = Collection_mode module Trace_state_change = Trace_state_change + module Util = Util module When_to_snapshot = When_to_snapshot end diff --git a/src/perf_decode.ml b/src/perf_decode.ml index 14488d5220..e584da5918 100644 --- a/src/perf_decode.ml +++ b/src/perf_decode.ml @@ -8,41 +8,6 @@ let saturating_sub_i64 a b = | Some offset -> offset ;; -let int64_of_hex_string str = - (* Bit hacks for fast parsing of hex strings. - * - * Note that in ASCII, ('1' | 'a' | 'A') & 0xF = 1. - * - * So for each character, take the bottom 4 bits, and add 9 if it's - * not a digit. *) - let res = ref 0L in - for i = 0 to String.length str - 1 do - let open Int64 in - let c = of_int (Char.to_int (String.unsafe_get str i)) in - res := (!res lsl 4) lor ((c land 0xFL) + ((c lsr 6) lor ((c lsr 3) land 0x8L))) - done; - !res -;; - -let%test_module _ = - (module struct - open Core - - let check str = Core.print_s ([%sexp_of: Int64.Hex.t] (int64_of_hex_string str)) - - let%expect_test "int64 hex parsing" = - check "fF"; - [%expect {| 0xff |}]; - check "f0f"; - [%expect {| 0xf0f |}]; - check "fA0f"; - [%expect {| 0xfa0f |}]; - check "0"; - [%expect {| 0x0 |}] - ;; - end) -;; - let ok_perf_sample_line_re = Re.Perl.re {|^ *([0-9]+)/([0-9]+) +([0-9]+).([0-9]+): *$|} |> Re.compile ;; @@ -106,7 +71,8 @@ let parse_time ~time_hi ~time_lo = let parse_symbol_and_offset ?perf_maps pid str ~addr = match Re.Group.all (Re.exec symbol_and_offset_re str) with - | [| _; symbol; offset |] -> Symbol.From_perf symbol, Int.Hex.of_string offset + | [| _; symbol; offset |] -> + Symbol.From_perf symbol, Util.int_of_hex_string ~remove_hex_prefix:true offset | _ | (exception _) -> let failed = Symbol.Unknown, 0 in (match perf_maps, pid with @@ -138,7 +104,9 @@ let trace_error_to_event matches : Event.Decode_error.t = let pid = maybe_pid_of_string pid in let tid = maybe_pid_of_string tid in let instruction_pointer = - if String.( = ) ip "0" then None else Some (Int64.Hex.of_string ip) + if String.( = ) ip "0" + then None + else Some (Util.int64_of_hex_string ~remove_hex_prefix:true ip) in let time = if String.is_empty time_hi && String.is_empty time_lo @@ -182,7 +150,7 @@ let ok_perf_sample_line_to_event ?perf_maps matches lines : Event.Ok.t = List.map lines ~f:(fun line -> match Re.Group.all (Re.exec ok_perf_sample_callstack_entry_re line) with | [| _; instruction_pointer; symbol_and_offset |] -> - let instruction_pointer = int64_of_hex_string instruction_pointer in + let instruction_pointer = Util.int64_of_hex_string instruction_pointer in let symbol, symbol_offset = parse_symbol_and_offset ?perf_maps @@ -220,8 +188,8 @@ let ok_perf_line_to_event ?perf_maps matches line : Event.Ok.t = let pid = maybe_pid_of_string pid in let tid = maybe_pid_of_string tid in let time = parse_time ~time_hi ~time_lo in - let src_instruction_pointer = int64_of_hex_string src_instruction_pointer in - let dst_instruction_pointer = int64_of_hex_string dst_instruction_pointer in + let src_instruction_pointer = Util.int64_of_hex_string src_instruction_pointer in + let dst_instruction_pointer = Util.int64_of_hex_string dst_instruction_pointer in let src_symbol, src_symbol_offset = parse_symbol_and_offset ?perf_maps