(*
 * Written by Alexey Tourbin, based on tools/objinfo.ml
 * and tools/dumpobj.ml from OCaml distribution.
 *)

let print_digest d =
  for i = 0 to String.length d - 1 do
    Printf.printf "%02x" (Char.code d.[i])
  done

let print_digest_table prefix table =
  List.iter
    (fun (name, digest) ->
      print_string prefix; print_string "\t";
      print_digest digest; print_string "\t";
      print_string name; print_newline())
    table

let print_cmi name imports =
  Printf.printf "cmi_name\t%s\n" name;
  print_digest_table "cmi_requires" imports

let print_cmo cu =
  Printf.printf "cmi_name\t%s\n" cu.Cmo_format.cu_name;
  print_digest_table "cmi_requires" cu.Cmo_format.cu_imports

let print_cma lib =
  List.iter print_cmo lib.Cmo_format.lib_units;
  List.iter (Printf.printf "ccobj\t%s\n") lib.Cmo_format.lib_ccobjs;
  List.iter (Printf.printf "ccopt\t%s\n") lib.Cmo_format.lib_ccopts;
  List.iter (Printf.printf "dllib\t%s\n") lib.Cmo_format.lib_dllibs

let print_cmx ui =
  Printf.printf "cmx_name\t%s\n" ui.Compilenv.ui_name;
  print_digest_table "cmi_requires" ui.Compilenv.ui_imports_cmi;
  print_digest_table "cmx_requires" ui.Compilenv.ui_imports_cmx

let print_cmx_crc ui ic =
  let name = ui.Compilenv.ui_name in
  Printf.printf "cmx_name\t%s\n" name;
  (* cf. asmcomp/compilenv.ml *)
  let digest = Digest.input ic in
  print_digest_table "cmx_provides" ((name,digest) :: [])

let print_cmxa lib =
  List.iter print_cmx (List.map fst lib.Compilenv.lib_units);
  print_digest_table "cmx_provides"
    (List.map
      (fun (ui,d) -> (ui.Compilenv.ui_name, d))
      lib.Compilenv.lib_units);
  List.iter (Printf.printf "ccobj\t%s\n") lib.Compilenv.lib_ccobjs;
  List.iter (Printf.printf "ccopt\t%s\n") lib.Compilenv.lib_ccopts

let read_primitive_table ic len =
  let p = String.create len in
  really_input ic p 0 len;
  let rec split beg cur =
    if cur >= len then []
    else if p.[cur] = '\000' then
      String.sub p beg (cur - beg) :: split (cur + 1) (cur + 1)
    else
      split beg (cur + 1) in
  split 0 0

let print_exe_section ic sect =
  let sect_size = Bytesections.seek_section ic sect in
  let sect_list = read_primitive_table ic sect_size in
  List.iter (Printf.printf "%s\t%s\n" sect) sect_list

let print_exe ic =
  Bytesections.read_toc ic;
  print_exe_section ic "DLPT";
  print_exe_section ic "DLLS"

exception Unknown_file_format

let print_ocaml filename =
  let ic = open_in_bin filename in
  let buffer = String.create (String.length Config.cmo_magic_number) in
  really_input ic buffer 0 (String.length Config.cmo_magic_number);
  if buffer = Config.cmo_magic_number then begin
    let pos = input_binary_int ic in
    seek_in ic pos;
    let cu = (input_value ic : Cmo_format.compilation_unit) in
    print_cmo cu
  end else
  if buffer = Config.cma_magic_number then begin
    let pos = input_binary_int ic in
    seek_in ic pos;
    let lib = (input_value ic : Cmo_format.library) in
    print_cma lib
  end else
  if buffer = Config.cmi_magic_number then begin
    let (name, sign, comps) = input_value ic in
    let imports = input_value ic in
    print_cmi name imports
  end else
  if buffer = Config.cmx_magic_number then begin
    let ui = (input_value ic : Compilenv.unit_infos) in
    print_cmx ui;
    print_cmx_crc ui ic
  end else
  if buffer = Config.cmxa_magic_number then begin
    let lib = (input_value ic : Compilenv.library_infos) in
    print_cmxa lib
  end else
  if buffer.[0] = '#' && buffer.[1] = '!' then begin
    seek_in ic 0;
    print_exe ic
  end else begin
    raise Unknown_file_format
  end

let main () =
  for i = 1 to Array.length Sys.argv - 1 do
    let filename = Sys.argv.(i) in
    try print_ocaml filename
    with x ->
      Printf.eprintf "%s: %s: " Sys.argv.(0) filename;
      raise x;
  done

let _ = main ()

(*
 * ex:ts=8 sts=2 sw=2 et:
 *)