ocaml/ocamlbyteinfo.ml

102 lines
3.2 KiB
OCaml

(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2009 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../../LICENSE. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* Dumps a bytecode binary file *)
open Sys
open Dynlinkaux
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 = String.create len in
let _ = really_input ic sect 0 len in
get_string_list sect len
let print = Printf.printf
let perr s =
Printf.eprintf "%s\n" s;
exit(1)
let p_title title = print "%s:\n" title
let p_section title format pdata = function
| [] -> ()
| l ->
p_title title;
List.iter
(fun (name, data) -> print format (pdata data) name)
l
let p_list title format = function
| [] -> ()
| l ->
p_title title;
List.iter
(fun name -> print format name)
l
let _ =
try
let input_name = Sys.argv.(1) in
let ic = open_in_bin input_name in
Bytesections.read_toc ic;
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"
"\t%s\t%s\n"
Digest.to_hex
(input_value ic : (string * Digest.t) list)
| "DLLS" ->
p_list
"Used Dlls" "\t%s\n"
(input_stringlist ic len)
| "DLPT" ->
p_list
"Additional Dll paths"
"\t%s\n"
(input_stringlist ic len)
| "PRIM" ->
let prims = (input_stringlist ic len) in
print "Uses unsafe features: ";
begin match prims with
[] -> print "no\n"
| l -> print "YES\n";
p_list "Primitives declared in this module"
"\t%s\n"
l
end
| _ -> ()
with Not_found | Failure _ | Invalid_argument _ -> ()
)
["CRCS"; "DLLS"; "DLPT"; "PRIM"];
close_in ic
with
| Sys_error msg ->
perr msg
| Invalid_argument("index out of bounds") ->
perr (Printf.sprintf "Usage: %s filename" Sys.argv.(0))