|
1 (***********************************************************************) |
|
2 (* *) |
|
3 (* Objective Caml *) |
|
4 (* *) |
|
5 (* Xavier Leroy, projet Gallium, INRIA Rocquencourt *) |
|
6 (* *) |
|
7 (* Copyright 2009 Institut National de Recherche en Informatique et *) |
|
8 (* en Automatique. All rights reserved. This file is distributed *) |
|
9 (* under the terms of the GNU Library General Public License, with *) |
|
10 (* the special exception on linking described in file ../../LICENSE. *) |
|
11 (* *) |
|
12 (***********************************************************************) |
|
13 |
|
14 (* $Id: ocamlbyteinfo.ml,v 1.1 2010/01/11 18:45:03 rjones Exp $ *) |
|
15 |
|
16 (* Dumps a bytecode binary file *) |
|
17 |
|
18 open Sys |
|
19 open Dynlinkaux |
|
20 |
|
21 let input_stringlist ic len = |
|
22 let get_string_list sect len = |
|
23 let rec fold s e acc = |
|
24 if e != len then |
|
25 if sect.[e] = '\000' then |
|
26 fold (e+1) (e+1) (String.sub sect s (e-s) :: acc) |
|
27 else fold s (e+1) acc |
|
28 else acc |
|
29 in fold 0 0 [] |
|
30 in |
|
31 let sect = String.create len in |
|
32 let _ = really_input ic sect 0 len in |
|
33 get_string_list sect len |
|
34 |
|
35 let print = Printf.printf |
|
36 let perr s = |
|
37 Printf.eprintf "%s\n" s; |
|
38 exit(1) |
|
39 let p_title title = print "%s:\n" title |
|
40 |
|
41 let p_section title format pdata = function |
|
42 | [] -> () |
|
43 | l -> |
|
44 p_title title; |
|
45 List.iter |
|
46 (fun (name, data) -> print format (pdata data) name) |
|
47 l |
|
48 |
|
49 let p_list title format = function |
|
50 | [] -> () |
|
51 | l -> |
|
52 p_title title; |
|
53 List.iter |
|
54 (fun name -> print format name) |
|
55 l |
|
56 |
|
57 let _ = |
|
58 try |
|
59 let input_name = Sys.argv.(1) in |
|
60 let ic = open_in_bin input_name in |
|
61 Bytesections.read_toc ic; |
|
62 List.iter |
|
63 (fun section -> |
|
64 try |
|
65 let len = Bytesections.seek_section ic section in |
|
66 if len > 0 then match section with |
|
67 | "CRCS" -> |
|
68 p_section |
|
69 "Imported Units" |
|
70 "\t%s\t%s\n" |
|
71 Digest.to_hex |
|
72 (input_value ic : (string * Digest.t) list) |
|
73 | "DLLS" -> |
|
74 p_list |
|
75 "Used Dlls" "\t%s\n" |
|
76 (input_stringlist ic len) |
|
77 | "DLPT" -> |
|
78 p_list |
|
79 "Additional Dll paths" |
|
80 "\t%s\n" |
|
81 (input_stringlist ic len) |
|
82 | "PRIM" -> |
|
83 let prims = (input_stringlist ic len) in |
|
84 print "Uses unsafe features: "; |
|
85 begin match prims with |
|
86 [] -> print "no\n" |
|
87 | l -> print "YES\n"; |
|
88 p_list "Primitives declared in this module" |
|
89 "\t%s\n" |
|
90 l |
|
91 end |
|
92 | _ -> () |
|
93 with Not_found | Failure _ | Invalid_argument _ -> () |
|
94 ) |
|
95 ["CRCS"; "DLLS"; "DLPT"; "PRIM"]; |
|
96 close_in ic |
|
97 with |
|
98 | Sys_error msg -> |
|
99 perr msg |
|
100 | Invalid_argument("index out of bounds") -> |
|
101 perr (Printf.sprintf "Usage: %s filename" Sys.argv.(0)) |