Skip to content

Instantly share code, notes, and snippets.

@whitequark
Created December 12, 2013 06:54
Show Gist options
  • Star 2 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save whitequark/7924109 to your computer and use it in GitHub Desktop.
Save whitequark/7924109 to your computer and use it in GitHub Desktop.
A simple symbolizer for caml-inspect.

Caml-inspect symbolizer

Symbolizes closure blocks. Works only on native executables.

Build

ocamlfind ocamlopt -syntax camlp4o -package lwt -package lwt.syntax -package lwt.unix str.cmxa -linkpkg symbolizer.ml -o symbolizer
ocamlfind ocamlopt -package inspect -linkpkg foo.ml -o foo

Use

./foo
./symbolizer -prog foo -graph test.dot -open okular

Examples

Before: http://i.imgur.com/Sk1cDEU.jpg

After: http://i.imgur.com/zghC3JM.jpg

open Inspect
let () =
Dot.dump_to_file "test.dot" (Dot.test_data ());;
open Lwt
let () =
let executable = ref ""
and graph_name = ref ""
and dot_cmd = ref "dot"
and open_cmd = ref "" in
Arg.parse (Arg.align [
"-prog", Arg.Set_string executable, " Executable filename";
"-graph", Arg.Set_string graph_name, " Dot graph filename";
"-dot", Arg.Set_string dot_cmd, " Dot command";
"-open", Arg.Set_string open_cmd, " Open command";
])
(fun unknown ->
Printf.eprintf "Extraneous argument %s\n" unknown;
exit 1)
(Printf.sprintf "Usage: %s -e foo.native -g graph.dot" Sys.argv.(0));
Lwt_main.run (
(* Read symbols. *)
Lwt_process.pread_lines ("nm", [|"nm"; !executable|])
|> Lwt_stream.map_list (fun symbol ->
try
Scanf.sscanf symbol "%x %c %s%!" (fun addr kind symbol ->
match kind with
| 'd' | 'D' | 't' | 'T' -> [addr, symbol]
| _ -> [])
with Scanf.Scan_failure _ ->
[])
|> Lwt_stream.to_list
>>= fun symbols ->
let hash = Hashtbl.create (List.length symbols) in
List.iter (fun (addr, sym) -> Hashtbl.add hash addr sym) symbols;
(* Read graph. *)
lwt graph_file = Lwt_io.open_file ~mode:Lwt_io.input !graph_name in
lwt graph = Lwt_io.read graph_file in
Lwt_io.close graph_file >>= fun () ->
(* Replace symbols in graph. *)
graph
|> Str.global_substitute (Str.regexp "0x[0-9A-Z]+") (fun text ->
let addr_str = Str.matched_string text in
let addr = Scanf.sscanf addr_str "0x%x%!" (fun x -> x) in
try Hashtbl.find hash addr
with Not_found -> addr_str)
|> fun graph' ->
if !open_cmd = "" then begin
(* Modify graph. *)
lwt graph_file = Lwt_io.open_file ~mode:Lwt_io.output !graph_name in
Lwt_io.write graph_file graph' >>
Lwt_io.flush graph_file
end else begin
(* Render graph. *)
let r, w = Unix.pipe () in
let w' = Lwt_io.of_unix_fd ~mode:Lwt_io.output w in
Lwt_io.write w' graph' >> Lwt_io.flush w' >>= fun () ->
Unix.close w;
lwt png = Lwt_process.pread ~stdin:(`FD_copy r) (!dot_cmd, [|!dot_cmd; "-Tpng"|]) in
(* Display graph. *)
Lwt_process.pwrite (!open_cmd, [|!open_cmd; "-"|]) png
end)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment