1995-11-07 02:01:45 -08:00
|
|
|
(***********************************************************************)
|
|
|
|
(* *)
|
1996-04-30 07:53:58 -07:00
|
|
|
(* Objective Caml *)
|
1995-11-07 02:01:45 -08:00
|
|
|
(* *)
|
|
|
|
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
|
|
|
(* *)
|
1996-04-30 07:53:58 -07:00
|
|
|
(* Copyright 1996 Institut National de Recherche en Informatique et *)
|
1995-11-07 02:01:45 -08:00
|
|
|
(* Automatique. Distributed only by permission. *)
|
|
|
|
(* *)
|
|
|
|
(***********************************************************************)
|
|
|
|
|
|
|
|
(* $Id$ *)
|
|
|
|
|
|
|
|
(* Print the digests of unit interfaces *)
|
1995-09-29 09:20:15 -07:00
|
|
|
|
|
|
|
let load_path = ref ["."]
|
|
|
|
let first = ref true
|
|
|
|
|
|
|
|
let print_crc unit =
|
|
|
|
try
|
1995-11-07 02:01:45 -08:00
|
|
|
let crc = Dynlink.digest_interface unit !load_path in
|
1995-09-29 09:20:15 -07:00
|
|
|
if !first then first := false else print_string ";\n";
|
1995-10-09 06:37:11 -07:00
|
|
|
print_string " \""; print_string unit; print_string "\",\n \"";
|
|
|
|
for i = 0 to String.length crc - 1 do
|
|
|
|
Printf.printf "\\%03d" (Char.code crc.[i])
|
|
|
|
done;
|
|
|
|
print_string "\""
|
1995-09-29 09:20:15 -07:00
|
|
|
with exn ->
|
|
|
|
prerr_string "Error while reading the interface for ";
|
|
|
|
prerr_endline unit;
|
|
|
|
begin match exn with
|
|
|
|
Sys_error msg -> prerr_endline msg
|
|
|
|
| Dynlink.Error _ -> prerr_endline "Ill formed .cmi file"
|
|
|
|
| _ -> raise exn
|
|
|
|
end;
|
|
|
|
exit 2
|
|
|
|
|
1996-10-24 07:17:48 -07:00
|
|
|
let usage = "Usage: extract_crc [-I <dir>] <files>"
|
|
|
|
|
1995-09-29 09:20:15 -07:00
|
|
|
let main () =
|
|
|
|
print_string "let crc_unit_list = [\n";
|
|
|
|
Arg.parse
|
1996-10-24 07:17:48 -07:00
|
|
|
["-I", Arg.String(fun dir -> load_path := !load_path @ [dir]),
|
|
|
|
"<dir> Add <dir> to the list of include directories"]
|
|
|
|
print_crc usage;
|
1995-09-29 09:20:15 -07:00
|
|
|
print_string "\n]\n"
|
|
|
|
|
|
|
|
let _ = main(); exit 0
|
|
|
|
|
|
|
|
|