102 lines
3.2 KiB
OCaml
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))
|