1995-08-09 08:06:35 -07:00
|
|
|
(***********************************************************************)
|
|
|
|
(* *)
|
1996-04-30 07:53:58 -07:00
|
|
|
(* Objective Caml *)
|
1995-08-09 08:06:35 -07:00
|
|
|
(* *)
|
|
|
|
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
|
|
|
(* *)
|
1996-04-30 07:53:58 -07:00
|
|
|
(* Copyright 1996 Institut National de Recherche en Informatique et *)
|
1999-11-17 10:59:06 -08:00
|
|
|
(* en Automatique. All rights reserved. This file is distributed *)
|
|
|
|
(* under the terms of the Q Public License version 1.0. *)
|
1995-08-09 08:06:35 -07:00
|
|
|
(* *)
|
|
|
|
(***********************************************************************)
|
|
|
|
|
|
|
|
(* $Id$ *)
|
|
|
|
|
1995-07-02 09:47:48 -07:00
|
|
|
(* Dump a .cmx file *)
|
|
|
|
|
|
|
|
open Config
|
|
|
|
open Format
|
|
|
|
open Clambda
|
|
|
|
open Compilenv
|
|
|
|
|
2000-02-08 12:00:06 -08:00
|
|
|
let print_digest ppf d =
|
1995-11-06 03:09:33 -08:00
|
|
|
for i = 0 to String.length d - 1 do
|
|
|
|
print_string(Printf.sprintf "%02x" (Char.code d.[i]))
|
|
|
|
done
|
|
|
|
|
2000-02-08 12:00:06 -08:00
|
|
|
let rec print_approx ppf = function
|
1995-07-02 09:47:48 -07:00
|
|
|
Value_closure(fundesc, approx) ->
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "@[<2>function %s@ arity %i" fundesc.fun_label fundesc.fun_arity;
|
1995-07-02 09:47:48 -07:00
|
|
|
if fundesc.fun_closed then begin
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "@ (closed)"
|
1995-07-02 09:47:48 -07:00
|
|
|
end;
|
1997-02-16 09:20:11 -08:00
|
|
|
if fundesc.fun_inline <> None then begin
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "@ (inline)"
|
1997-02-16 09:20:11 -08:00
|
|
|
end;
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "@ -> @ %a@]" print_approx approx
|
1995-07-02 09:47:48 -07:00
|
|
|
| Value_tuple approx ->
|
2000-02-08 12:00:06 -08:00
|
|
|
let tuple ppf approx =
|
|
|
|
for i = 0 to Array.length approx - 1 do
|
|
|
|
if i > 0 then printf ";@ ";
|
|
|
|
printf "%i: %a" i print_approx approx.(i)
|
|
|
|
done in
|
2000-02-28 07:47:05 -08:00
|
|
|
printf "@[<hov 1>%a@]" tuple approx
|
1995-07-02 09:47:48 -07:00
|
|
|
| Value_unknown ->
|
|
|
|
print_string "_"
|
1998-04-30 05:13:01 -07:00
|
|
|
| Value_integer n ->
|
|
|
|
print_int n
|
2000-04-14 03:05:48 -07:00
|
|
|
| Value_constptr n ->
|
|
|
|
print_int n; print_string "p"
|
1995-07-02 09:47:48 -07:00
|
|
|
|
1995-07-13 02:02:55 -07:00
|
|
|
let print_name_crc (name, crc) =
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "@ %s (%a)" name print_digest crc
|
1995-07-13 02:02:55 -07:00
|
|
|
|
|
|
|
let print_infos (ui, crc) =
|
2000-02-08 12:00:06 -08:00
|
|
|
printf "Name: %s@." ui.ui_name;
|
|
|
|
printf "CRC of implementation: %a@." print_digest crc;
|
|
|
|
let pr_imports ppf imps = List.iter print_name_crc imps in
|
|
|
|
printf "@[<v 2>Interfaces imported:%a2]@." pr_imports ui.ui_imports_cmi;
|
|
|
|
printf "@[<v 2>Implementations imported:%a@]@." pr_imports ui.ui_imports_cmx;
|
|
|
|
printf "@[<v 2>Approximation:@ %a@]@." print_approx ui.ui_approx;
|
|
|
|
let pr_funs ppf fns =
|
|
|
|
List.iter (fun arity -> printf "@ %i" arity) fns in
|
|
|
|
printf "@[<2>Currying functions:%a@]@." pr_funs ui.ui_curry_fun;
|
|
|
|
printf "@[<2>Apply functions:%a@]@." pr_funs ui.ui_apply_fun
|
1995-07-02 09:47:48 -07:00
|
|
|
|
1995-11-06 03:09:33 -08:00
|
|
|
let print_unit_info filename =
|
1995-07-02 09:47:48 -07:00
|
|
|
let ic = open_in_bin filename in
|
|
|
|
try
|
|
|
|
let buffer = String.create (String.length cmx_magic_number) in
|
|
|
|
really_input ic buffer 0 (String.length cmx_magic_number);
|
1995-11-06 03:09:33 -08:00
|
|
|
if buffer = cmx_magic_number then begin
|
|
|
|
let ui = (input_value ic : unit_infos) in
|
|
|
|
let crc = Digest.input ic in
|
|
|
|
close_in ic;
|
|
|
|
print_infos (ui, crc)
|
|
|
|
end else if buffer = cmxa_magic_number then begin
|
2000-04-14 03:05:48 -07:00
|
|
|
let li = (input_value ic : library_infos) in
|
1995-11-06 03:09:33 -08:00
|
|
|
close_in ic;
|
2000-04-14 03:05:48 -07:00
|
|
|
List.iter print_infos li.lib_units
|
1995-11-06 03:09:33 -08:00
|
|
|
end else begin
|
1995-07-02 09:47:48 -07:00
|
|
|
close_in ic;
|
|
|
|
prerr_endline "Wrong magic number";
|
|
|
|
exit 2
|
1995-11-06 03:09:33 -08:00
|
|
|
end
|
1995-07-02 09:47:48 -07:00
|
|
|
with End_of_file | Failure _ ->
|
|
|
|
close_in ic;
|
|
|
|
prerr_endline "Error reading file";
|
|
|
|
exit 2
|
|
|
|
|
|
|
|
let main () =
|
1995-11-06 03:09:33 -08:00
|
|
|
print_unit_info Sys.argv.(1);
|
1995-07-02 09:47:48 -07:00
|
|
|
exit 0
|
|
|
|
|
|
|
|
let _ = main ()
|
|
|
|
|
|
|
|
|
|
|
|
|