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 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* Mehdi Dogguy, PPS laboratory, University Paris Diderot *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* Copyright 2010 Mehdi Dogguy *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* Dump info on .cmi, .cmo, .cmx, .cma, .cmxa, .cmxs files
and on bytecode executables. *)
open Printf
open Misc
open Config
open Cmo_format
(* Command line option to prevent printing approximation and function code *)
let no_approx = ref false
let no_code = ref false
let input_stringlist ic len =
let get_string_list sect len =
let rec fold s e acc =
if e != len then
if sect.[e] = '\000' then
fold (e+1) (e+1) (String.sub sect s (e-s) :: acc)
else fold s (e+1) acc
else acc
in fold 0 0 []
in
let sect = really_input_string ic len in
get_string_list sect len
let dummy_crc = String.make 32 '-'
let print_name_crc (name, crco) =
let crc =
match crco with
None -> dummy_crc
| Some crc -> Digest.to_hex crc
in
printf "\t%s\t%s\n" crc name
let print_line name =
printf "\t%s\n" name
let print_required_global id =
printf "\t%s\n" (Ident.name id)
let print_cmo_infos cu =
printf "Unit name: %s\n" cu.cu_name;
print_string "Interfaces imported:\n";
List.iter print_name_crc cu.cu_imports;
print_string "Required globals:\n";
List.iter print_required_global cu.cu_required_globals;
printf "Uses unsafe features: ";
(match cu.cu_primitives with
| [] -> printf "no\n"
| l ->
printf "YES\n";
printf "Primitives declared in this module:\n";
List.iter print_line l);
printf "Force link: %s\n" (if cu.cu_force_link then "YES" else "no")
let print_spaced_string s =
printf " %s" s
let print_cma_infos (lib : Cmo_format.library) =
printf "Force custom: %s\n" (if lib.lib_custom then "YES" else "no");
printf "Extra C object files:";
(* PR#4949: print in linking order *)
List.iter print_spaced_string (List.rev lib.lib_ccobjs);
printf "\nExtra C options:";
List.iter print_spaced_string lib.lib_ccopts;
printf "\n";
print_string "Extra dynamically-loaded libraries:";
List.iter print_spaced_string lib.lib_dllibs;
printf "\n";
List.iter print_cmo_infos lib.lib_units
let print_cmi_infos name crcs =
printf "Unit name: %s\n" name;
printf "Interfaces imported:\n";
List.iter print_name_crc crcs
let print_cmt_infos cmt =
let open Cmt_format in
printf "Cmt unit name: %s\n" cmt.cmt_modname;
print_string "Cmt interfaces imported:\n";
List.iter print_name_crc cmt.cmt_imports;
printf "Source file: %s\n"
(match cmt.cmt_sourcefile with None -> "(none)" | Some f -> f);
printf "Compilation flags:";
Array.iter print_spaced_string cmt.cmt_args;
printf "\nLoad path:";
List.iter print_spaced_string cmt.cmt_loadpath;
printf "\n";
printf "cmt interface digest: %s\n"
(match cmt.cmt_interface_digest with
| None -> ""
| Some crc -> Digest.to_hex crc)
let print_general_infos name crc defines cmi cmx =
printf "Name: %s\n" name;
printf "CRC of implementation: %s\n" (Digest.to_hex crc);
printf "Globals defined:\n";
List.iter print_line defines;
printf "Interfaces imported:\n";
List.iter print_name_crc cmi;
printf "Implementations imported:\n";
List.iter print_name_crc cmx
let print_global_table table =
printf "Globals defined:\n";
Tbl.iter
(fun id _ -> print_line (Ident.name id))
table.num_tbl
open Cmx_format
let print_cmx_infos (ui, crc) =
print_general_infos
ui.ui_name crc ui.ui_defines ui.ui_imports_cmi ui.ui_imports_cmx;
begin match ui.ui_export_info with
| Clambda approx ->
if not !no_approx then begin
printf "Clambda approximation:\n";
Format.fprintf Format.std_formatter " %a@." Printclambda.approx approx
end else
Format.printf "Clambda unit@.";
| Flambda export ->
if not !no_approx || not !no_code then
printf "Flambda export information:\n"
else
printf "Flambda unit\n";
if not !no_approx then begin
let cu =
Compilation_unit.create (Ident.create_persistent ui.ui_name)
(Linkage_name.create "__dummy__")
in
Compilation_unit.set_current cu;
let root_symbols =
List.map (fun s ->
Symbol.unsafe_create cu (Linkage_name.create ("caml"^s)))
ui.ui_defines
in
Format.printf "approximations@ %a@.@."
Export_info.print_approx (export, root_symbols)
end;
if not !no_code then
Format.printf "functions@ %a@.@."
Export_info.print_functions export
end;
let pr_funs _ fns =
List.iter (fun arity -> printf " %d" arity) fns in
printf "Currying functions:%a\n" pr_funs ui.ui_curry_fun;
printf "Apply functions:%a\n" pr_funs ui.ui_apply_fun;
printf "Send functions:%a\n" pr_funs ui.ui_send_fun;
printf "Force link: %s\n" (if ui.ui_force_link then "YES" else "no")
let print_cmxa_infos (lib : Cmx_format.library_infos) =
printf "Extra C object files:";
List.iter print_spaced_string (List.rev lib.lib_ccobjs);
printf "\nExtra C options:";
List.iter print_spaced_string lib.lib_ccopts;
printf "\n";
List.iter print_cmx_infos lib.lib_units
let print_cmxs_infos header =
List.iter
(fun ui ->
print_general_infos
ui.dynu_name
ui.dynu_crc
ui.dynu_defines
ui.dynu_imports_cmi
ui.dynu_imports_cmx)
header.dynu_units
let p_title title = printf "%s:\n" title
let p_section title = function
| [] -> ()
| l ->
p_title title;
List.iter print_name_crc l
let p_list title print = function
| [] -> ()
| l ->
p_title title;
List.iter print l
let dump_byte ic =
Bytesections.read_toc ic;
let toc = Bytesections.toc () in
let toc = List.sort Pervasives.compare toc in
List.iter
(fun (section, _) ->
try
let len = Bytesections.seek_section ic section in
if len > 0 then match section with
| "CRCS" ->
p_section
"Imported units"
(input_value ic : (string * Digest.t option) list)
| "DLLS" ->
p_list
"Used DLLs"
print_line
(input_stringlist ic len)
| "DLPT" ->
p_list
"Additional DLL paths"
print_line
(input_stringlist ic len)
| "PRIM" ->
p_list
"Primitives used"
print_line
(input_stringlist ic len)
| "SYMB" ->
print_global_table (input_value ic)
| _ -> ()
with _ -> ()
)
toc
let read_dyn_header filename ic =
let tempfile = Filename.temp_file "objinfo" ".out" in
let helper = Filename.concat Config.standard_library "objinfo_helper" in
try
try_finally
(fun () ->
let rc = Sys.command (sprintf "%s %s > %s"
(Filename.quote helper)
(Filename.quote filename)
tempfile) in
if rc <> 0 then failwith "cannot read";
let tc = Scanf.Scanning.from_file tempfile in
try_finally
(fun () ->
let ofs = Scanf.bscanf tc "%Ld" (fun x -> x) in
LargeFile.seek_in ic ofs;
Some(input_value ic : dynheader))
(fun () -> Scanf.Scanning.close_in tc))
(fun () -> remove_file tempfile)
with Failure _ | Sys_error _ -> None
let dump_obj filename =
printf "File %s\n" filename;
let ic = open_in_bin filename in
let len_magic_number = String.length cmo_magic_number in
let magic_number = really_input_string ic len_magic_number in
if magic_number = 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_cmo_infos cu
end else if magic_number = 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_cma_infos toc
end else if magic_number = cmi_magic_number ||
magic_number = cmt_magic_number then begin
close_in ic;
let cmi, cmt = Cmt_format.read filename in
begin match cmi with
| None -> ()
| Some cmi ->
print_cmi_infos cmi.Cmi_format.cmi_name cmi.Cmi_format.cmi_crcs
end;
begin match cmt with
| None -> ()
| Some cmt -> print_cmt_infos cmt
end
end else if magic_number = cmx_magic_number then begin
let ui = (input_value ic : unit_infos) in
let crc = Digest.input ic in
close_in ic;
print_cmx_infos (ui, crc)
end else if magic_number = cmxa_magic_number then begin
let li = (input_value ic : library_infos) in
close_in ic;
print_cmxa_infos li
end else begin
let pos_trailer = in_channel_length ic - len_magic_number in
let _ = seek_in ic pos_trailer in
let magic_number = really_input_string ic len_magic_number in
if magic_number = Config.exec_magic_number then begin
dump_byte ic;
close_in ic
end else if Filename.check_suffix filename ".cmxs" then begin
flush stdout;
match read_dyn_header filename ic with
| None ->
printf "Unable to read info on file %s\n" filename;
exit 2
| Some header ->
if header.dynu_magic = Config.cmxs_magic_number then
print_cmxs_infos header
else begin
printf "Wrong magic number\n"; exit 2
end;
close_in ic
end else begin
printf "Not an OCaml object file\n"; exit 2
end
end
let arg_list = [
"-no-approx", Arg.Set no_approx, " Do not print module approximation information";
"-no-code", Arg.Set no_code, " Do not print code from exported flambda functions";
"-args", Arg.Expand Arg.read_arg,
"<file> Read additional newline separated command line arguments \n\
\ from <file>";
"-args0", Arg.Expand Arg.read_arg0,
"<file> Read additional NUL separated command line arguments from \n\
\ <file>";
]
let arg_usage =
Printf.sprintf "%s [OPTIONS] FILES : give information on files" Sys.argv.(0)
let main() =
Arg.parse_expand arg_list dump_obj arg_usage;
exit 0
let _ = main ()
|