5
5
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
6
(* Mehdi Dogguy, PPS laboratory, University Paris Diderot *)
7
8
(* Copyright 1996 Institut National de Recherche en Informatique et *)
8
(* en Automatique. All rights reserved. This file is distributed *)
9
(* under the terms of the Q Public License version 1.0. *)
9
(* en Automatique. Modifications Copyright 2010 Mehdi Dogguy, *)
10
(* used and distributed as part of Objective Caml by permission from *)
11
(* the author. This file is distributed under the terms of the *)
12
(* Q Public License version 1.0. *)
11
14
(***********************************************************************)
13
(* $Id: objinfo.ml 7469 2006-07-05 12:09:18Z pouillar $ *)
15
(* Dump a compilation unit description *)
16
(* $Id: objinfo.ml 10459 2010-05-24 14:27:50Z xleroy $ *)
18
(* Dump info on .cmi, .cmo, .cmx, .cma, .cmxa, .cmxs files
19
and on bytecode executables. *)
21
for i = 0 to String.length d - 1 do
22
Printf.printf "%02x" (Char.code d.[i])
26
print_string " Unit name: "; print_string cu.cu_name; print_newline();
27
print_string " Interfaces imported:"; print_newline();
29
(fun (name, digest) ->
30
print_string "\t"; print_digest digest; print_string "\t";
31
print_string name; print_newline())
33
print_string " Uses unsafe features: ";
34
begin match cu.cu_primitives with
35
[] -> print_string "no"; print_newline()
36
| l -> print_string "YES"; print_newline();
37
print_string " Primitives declared in this module:";
40
(fun name -> print_string "\t"; print_string name; print_newline())
44
let print_spaced_string s = print_char ' '; print_string s
46
let print_library_info lib =
47
print_string " Force custom: ";
48
print_string (if lib.lib_custom then "YES" else "no");
50
print_string " Extra C object files:";
51
List.iter print_spaced_string lib.lib_ccobjs; print_newline();
52
print_string " Extra C options:";
53
List.iter print_spaced_string lib.lib_ccopts; print_newline();
54
List.iter print_info lib.lib_units
56
let print_intf_info name sign comps crcs =
57
print_string " Module name: "; print_string name; print_newline();
58
print_string " Interfaces imported:"; print_newline();
60
(fun (name, digest) ->
61
print_string "\t"; print_digest digest; print_string "\t";
62
print_string name; print_newline())
27
let input_stringlist ic len =
28
let get_string_list sect len =
29
let rec fold s e acc =
31
if sect.[e] = '\000' then
32
fold (e+1) (e+1) (String.sub sect s (e-s) :: acc)
37
let sect = String.create len in
38
let _ = really_input ic sect 0 len in
39
get_string_list sect len
41
let print_name_crc (name, crc) =
42
printf "\t%s\t%s\n" (Digest.to_hex crc) name
47
let print_cmo_infos cu =
48
printf "Unit name: %s\n" cu.cu_name;
49
print_string "Interfaces imported:\n";
50
List.iter print_name_crc cu.cu_imports;
51
printf "Uses unsafe features: ";
52
match cu.cu_primitives with
56
printf "Primitives declared in this module:\n";
57
List.iter print_line l
59
let rec print_approx_infos ppf = function
60
Value_closure(fundesc, approx) ->
61
Format.fprintf ppf "@[<2>function %s@ arity %i"
62
fundesc.fun_label fundesc.fun_arity;
63
if fundesc.fun_closed then begin
64
Format.fprintf ppf "@ (closed)"
66
if fundesc.fun_inline <> None then begin
67
Format.fprintf ppf "@ (inline)"
69
Format.fprintf ppf "@ -> @ %a@]" print_approx_infos approx
70
| Value_tuple approx ->
71
let tuple ppf approx =
72
for i = 0 to Array.length approx - 1 do
73
if i > 0 then Format.fprintf ppf ";@ ";
74
Format.fprintf ppf "%i: %a" i print_approx_infos approx.(i)
76
Format.fprintf ppf "@[<hov 1>(%a)@]" tuple approx
78
Format.fprintf ppf "_"
80
Format.fprintf ppf "%d" n
82
Format.fprintf ppf "%dp" n
84
let print_spaced_string s =
87
let print_cma_infos (lib : Cmo_format.library) =
88
printf "Force custom: %s\n" (if lib.lib_custom then "YES" else "no");
89
printf "Extra C object files:";
90
(* PR#4949: print in linking order *)
91
List.iter print_spaced_string (List.rev lib.lib_ccobjs);
92
printf "\nExtra C options:";
93
List.iter print_spaced_string lib.lib_ccopts;
95
print_string "Extra dynamically-loaded libraries:";
96
List.iter print_spaced_string lib.lib_dllibs;
98
List.iter print_cmo_infos lib.lib_units
100
let print_cmi_infos name sign comps crcs =
101
printf "Unit name: %s\n" name;
102
printf "Interfaces imported:\n";
103
List.iter print_name_crc crcs
105
let print_general_infos name crc defines cmi cmx =
106
printf "Name: %s\n" name;
107
printf "CRC of implementation: %s\n" (Digest.to_hex crc);
108
printf "Globals defined:\n";
109
List.iter print_line defines;
110
printf "Interfaces imported:\n";
111
List.iter print_name_crc cmi;
112
printf "Implementations imported:\n";
113
List.iter print_name_crc cmx
117
let print_cmx_infos (ui, crc) =
119
ui.ui_name crc ui.ui_defines ui.ui_imports_cmi ui.ui_imports_cmx;
120
printf "Approximation:\n";
121
Format.fprintf Format.std_formatter " %a@." print_approx_infos ui.ui_approx;
123
List.iter (fun arity -> printf " %d" arity) fns in
124
printf "Currying functions:%a\n" pr_funs ui.ui_curry_fun;
125
printf "Apply functions:%a\n" pr_funs ui.ui_apply_fun
127
let print_cmxs_infos header =
138
let p_title title = printf "%s:\n" title
140
let p_section title = function
144
List.iter print_name_crc l
146
let p_list title print = function
153
Bytesections.read_toc ic;
154
let toc = Bytesections.toc () in
155
let toc = List.sort Pervasives.compare toc in
159
let len = Bytesections.seek_section ic section in
160
if len > 0 then match section with
164
(input_value ic : (string * Digest.t) list)
169
(input_stringlist ic len)
172
"Additional DLL paths"
174
(input_stringlist ic len)
179
(input_stringlist ic len)
185
let read_dyn_header filename ic =
186
let tempfile = Filename.temp_file "objinfo" ".out" in
187
let helper = Filename.concat Config.standard_library "objinfo_helper" in
191
let rc = Sys.command (sprintf "%s %s > %s"
192
(Filename.quote helper)
193
(Filename.quote filename)
195
if rc <> 0 then failwith "cannot read";
196
let tc = open_in tempfile in
199
let ofs = Scanf.fscanf tc "%Ld" (fun x -> x) in
200
LargeFile.seek_in ic ofs;
201
Some(input_value ic : dynheader))
202
(fun () -> close_in tc))
203
(fun () -> remove_file tempfile)
204
with Failure _ | Sys_error _ -> None
65
206
let dump_obj filename =
66
print_string "File "; print_string filename; print_newline();
207
printf "File %s\n" filename;
67
208
let ic = open_in_bin filename in
68
let buffer = String.create (String.length cmo_magic_number) in
69
really_input ic buffer 0 (String.length cmo_magic_number);
70
if buffer = cmo_magic_number then begin
209
let len_magic_number = String.length cmo_magic_number in
210
let magic_number = String.create len_magic_number in
211
really_input ic magic_number 0 len_magic_number;
212
if magic_number = cmo_magic_number then begin
71
213
let cu_pos = input_binary_int ic in
72
214
seek_in ic cu_pos;
73
215
let cu = (input_value ic : compilation_unit) in
77
if buffer = cma_magic_number then begin
218
end else if magic_number = cma_magic_number then begin
78
219
let toc_pos = input_binary_int ic in
79
220
seek_in ic toc_pos;
80
221
let toc = (input_value ic : library) in
82
print_library_info toc
84
if buffer = cmi_magic_number then begin
224
end else if magic_number = cmi_magic_number then begin
85
225
let (name, sign, comps) = input_value ic in
86
226
let crcs = input_value ic in
88
print_intf_info name sign comps crcs
228
print_cmi_infos name sign comps crcs
229
end else if magic_number = cmx_magic_number then begin
230
let ui = (input_value ic : unit_infos) in
231
let crc = Digest.input ic in
233
print_cmx_infos (ui, crc)
234
end else if magic_number = cmxa_magic_number then begin
235
let li = (input_value ic : library_infos) in
237
List.iter print_cmx_infos li.lib_units
90
prerr_endline "Not an object file"; exit 2
239
let pos_trailer = in_channel_length ic - len_magic_number in
240
let _ = seek_in ic pos_trailer in
241
let _ = really_input ic magic_number 0 len_magic_number in
242
if magic_number = Config.exec_magic_number then begin
245
end else if Filename.check_suffix filename ".cmxs" then begin
247
match read_dyn_header filename ic with
249
printf "Unable to read info on file %s\n" filename;
252
if header.dynu_magic = Config.cmxs_magic_number then
253
print_cmxs_infos header
255
printf "Wrong magic number\n"; exit 2
259
printf "Not an OCaml object file\n"; exit 2
added
removed
tools/objinfo.ml
