blob: 23f5eab3ae6c316ad0537859ae8501cdefc22e8d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* Dump a compilation unit description *)
open Config
open Emitcode
let print_digest d =
for i = 0 to String.length d - 1 do
Printf.printf "%02x" (Char.code d.[i])
done
let print_info cu =
print_string " Unit name: "; print_string cu.cu_name; print_newline();
print_string " Interfaces imported:"; print_newline();
List.iter
(fun (name, digest) ->
print_string "\t"; print_digest digest; print_string "\t";
print_string name; print_newline())
cu.cu_imports;
print_string " Uses unsafe features: ";
begin match cu.cu_primitives with
[] -> print_string "no"; print_newline()
| l -> print_string "YES"; print_newline();
print_string " Primitives declared in this module:";
print_newline();
List.iter
(fun name -> print_string "\t"; print_string name; print_newline())
l
end
let print_spaced_string s = print_char ' '; print_string s
let print_library_info lib =
print_string " Force custom: ";
print_string (if lib.lib_custom then "YES" else "no");
print_newline();
print_string " Extra C object files:";
List.iter print_spaced_string lib.lib_ccobjs; print_newline();
print_string " Extra C options:";
List.iter print_spaced_string lib.lib_ccopts; print_newline();
List.iter print_info lib.lib_units
let print_intf_info name sign comps crcs =
print_string " Module name: "; print_string name; print_newline();
print_string " Interfaces imported:"; print_newline();
List.iter
(fun (name, digest) ->
print_string "\t"; print_digest digest; print_string "\t";
print_string name; print_newline())
crcs
let dump_obj filename =
print_string "File "; print_string filename; print_newline();
let ic = open_in_bin filename in
let buffer = String.create (String.length cmo_magic_number) in
really_input ic buffer 0 (String.length cmo_magic_number);
if buffer = cmo_magic_number then begin
let cu_pos = input_binary_int ic in
seek_in ic cu_pos;
let cu = (input_value ic : compilation_unit) in
close_in ic;
print_info cu
end else
if buffer = cma_magic_number then begin
let toc_pos = input_binary_int ic in
seek_in ic toc_pos;
let toc = (input_value ic : library) in
close_in ic;
print_library_info toc
end else
if buffer = cmi_magic_number then begin
let (name, sign, comps) = input_value ic in
let crcs = input_value ic in
close_in ic;
print_intf_info name sign comps crcs
end else begin
prerr_endline "Not an object file"; exit 2
end
let main() =
for i = 1 to Array.length Sys.argv - 1 do
dump_obj Sys.argv.(i)
done;
exit 0
let _ = main ()
|
