1 (**************************************************************************)
2 (* *)
3 (* OCaml *)
4 (* *)
5 (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
6 (* *)
7 (* Copyright 1999 Institut National de Recherche en Informatique et *)
8 (* en Automatique. *)
9 (* *)
10 (* All rights reserved. This file is distributed under the terms of *)
11 (* the GNU Lesser General Public License version 2.1, with the *)
12 (* special exception on linking described in the file LICENSE. *)
13 (* *)
14 (**************************************************************************)
15
16 (* Determine the set of C primitives required by the given .cmo and .cma
17 files *)
18
19 open Config
20 open Cmo_format
21 module String = Misc.Stdlib.String
22
23 let defined = ref true
24 let used = ref false
25 let exclude_file = ref ""
26
27 let primitives = ref String.Set.empty
28
29 let scan_reloc = function
30 (Reloc_primitive s, _) -> primitives := String.Set.add s !primitives
31 | _ -> ()
32
33 let scan_prim s =
34 primitives := String.Set.add s !primitives
35
36 let scan_info cu =
37 if !used then List.iter scan_reloc cu.cu_reloc;
38 if !defined then List.iter scan_prim cu.cu_primitives
39
40 let scan_obj filename =
41 let ic = open_in_bin filename in
42 let buffer = really_input_string ic (String.length cmo_magic_number) in
43 if buffer = cmo_magic_number then begin
44 let cu_pos = input_binary_int ic in
45 seek_in ic cu_pos;
46 let cu = (input_value ic : compilation_unit) in
47 close_in ic;
48 scan_info cu
49 end else
50 if buffer = cma_magic_number then begin
51 let toc_pos = input_binary_int ic in
52 seek_in ic toc_pos;
53 let toc = (input_value ic : library) in
54 close_in ic;
55 List.iter scan_info toc.lib_units
56 end else begin
57 prerr_endline "Not an object file"; exit 2
58 end
59
60 let exclude filename =
61 let ic = open_in filename in
62 try
63 while true do
64 let s = input_line ic in
65 primitives := String.Set.remove s !primitives
66 done
67 with End_of_file -> close_in ic
68 | x -> close_in ic; raise x
69
70 let main() =
71 Arg.parse_expand
72 ["-used", Arg.Unit(fun () -> used := true; defined := false),
73 "show primitives referenced in the object files";
74 "-defined", Arg.Unit(fun () -> defined := true; used := false),
75 "show primitives defined in the object files (default)";
76 "-all", Arg.Unit(fun () -> defined := true; used := true),
77 "show primitives defined or referenced in the object files";
78 "-exclude", Arg.String(fun s -> exclude_file := s),
79 "<file> don't print the primitives mentioned in <file>";
80 "-args", Arg.Expand Arg.read_arg,
81 "<file> Read additional newline separated command line arguments \n\
82 \ from <file>";
83 "-args0", Arg.Expand Arg.read_arg0,
84 "<file> Read additional NUL separated command line arguments from \n\
85 \ <file>";]
86 scan_obj
87 "Usage: primreq [options] <.cmo and .cma files>\nOptions are:";
88 if String.length !exclude_file > 0 then exclude !exclude_file;
89 String.Set.iter
90 (fun s ->
91 if s.[0] <> '%' then begin print_string s; print_newline() end)
92 !primitives;
93 exit 0
94
95 let _ = main ()
96