mbuf.ml

open Core
open Async
 
let caml_symbol = Re2.create_exn "caml[A-Z].*"
 
type t = { caml_symbols : float }
 
let run_lines ~args ~working_dir () =
  let prog = "/usr/bin/nm" in
  let env = `Extend [] in
  Process.run_lines ~env ~working_dir ~prog ~args ()
 
let is_interesting_symbol name =
  List.exists [ "caml_curry"; "caml_tuplify"; "caml_apply" ] ~f:(fun prefix ->
    String.is_prefix ~prefix name)
  || (Re2.matches caml_symbol name
     && not (String.is_prefix ~prefix:"camlCompiler_bench_runtime" name))
 
let run ~binary ~working_dir () =
  let open Deferred.Or_error.Let_syntax in
  let args =
    [ "--format=bsd"; "--debug-syms"; "--radix=d"; "--print-size" ] @ [ binary ]
  in
  let%bind lines = run_lines ~args ~working_dir () in
  let caml_symbols =
    List.fold lines ~init:0 ~f:(fun total line ->
      if not (String.is_prefix ~prefix:" " line)
      then (
        match String.split ~on:' ' line with
        | [ _sym_addr; sym_size; (("t" | "T") as _sym_type); sym_name ]
          when is_interesting_symbol sym_name ->
          (match total + int_of_string sym_size with
           | exception Failure _ -> total
           | v -> v)
        | _ -> total)
      else total)
    |> float_of_int
  in
  return { caml_symbols }

let main ~binary ~working_dir () =
  let open Deferred.Or_error.Let_syntax in
  let%bind {caml_symbols} = run ~binary ~working_dir () in
  Writer.write (force Writer.stdout) (Printf.sprintf "%.2f" caml_symbols);
  return ()

let () =
  let open Command.Let_syntax in
  Command.async_or_error
    ~summary:"Run"
    [%map_open
      let binary = flag "binary" (required string) ~doc:"BIN"
      and working_dir = flag "working-dir" (required string) ~doc:"DIR"
      in
      fun () ->
        main ~binary ~working_dir ()]
  |> Command.run