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