(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
(*                                                                     *)
(*  Copyright 2009 Institut National de Recherche en Informatique et   *)
(*  en Automatique.  All rights reserved.  This file is distributed    *)
(*  under the terms of the GNU Library General Public License, with    *)
(*  the special exception on linking described in file ../../LICENSE.  *)
(*                                                                     *)
(***********************************************************************)

(* $Id$ *)

(* Dumps a .cmxs file *)

open Natdynlink
open Format

let file =
  try
    Sys.argv.(1)
  with _ -> begin
    Printf.eprintf "Usage: %s file.cmxs\n" Sys.argv.(0);
    exit(1)
  end

exception Abnormal_exit

let error s e =
  let eprint = Printf.eprintf in
  let print_exc s = function
    | End_of_file ->
       eprint "%s: %s\n" s file
    | Abnormal_exit ->
        eprint "%s\n" s
    | e -> eprint "%s\n" (Printexc.to_string e)
  in
    print_exc s e;
    exit(1)

let read_in command =
  let cmd = Printf.sprintf command file in
  let ic = Unix.open_process_in cmd in
  try
    let line = input_line ic in
    begin match (Unix.close_process_in ic) with
      | Unix.WEXITED 0 -> Str.split (Str.regexp "[ ]+") line
      | Unix.WEXITED _  | Unix.WSIGNALED _ | Unix.WSTOPPED _ ->
          error
            (Printf.sprintf
               "Command \"%s\" exited abnormally"
               cmd
            )
            Abnormal_exit
    end
  with e -> error "File is empty" e

let get_offset adr_off adr_sec =
  try
    let adr = List.nth adr_off 4 in
    let off = List.nth adr_off 5 in
    let sec = List.hd adr_sec in

    let (!) x = Int64.of_string ("0x" ^ x) in
    let (+) = Int64.add in
    let (-) = Int64.sub in

      Int64.to_int (!off + !sec - !adr)

  with Failure _ | Invalid_argument _ ->
    error
      "Command output doesn't have the expected format"
      Abnormal_exit

let print_infos name crc defines cmi cmx =
  let print_name_crc (name, crc) =
    printf "@ %s (%s)" name (Digest.to_hex crc)
  in
  let pr_imports ppf imps = List.iter print_name_crc imps in
  printf "Name: %s@." name;
  printf "CRC of implementation: %s@." (Digest.to_hex crc);
  printf "@[<hov 2>Globals defined:";
  List.iter (fun s -> printf "@ %s" s) defines;
  printf "@]@.";
  printf "@[<v 2>Interfaces imported:%a@]@." pr_imports cmi;
  printf "@[<v 2>Implementations imported:%a@]@." pr_imports cmx

let _ =
  let adr_off = read_in "objdump -h %s | grep ' .data '" in
  let adr_sec = read_in "objdump -T %s | grep ' caml_plugin_header$'" in

  let ic = open_in file in
  let _ = seek_in ic (get_offset adr_off adr_sec) in
  let header  = (input_value ic : Natdynlink.dynheader) in
    if header.magic <> Natdynlink.dyn_magic_number then
      raise(Error(Natdynlink.Not_a_bytecode_file file))
    else begin
      List.iter
        (fun ui ->
           print_infos
             ui.name
             ui.crc
             ui.defines
             ui.imports_cmi
             ui.imports_cmx)
        header.units
    end