241 lines
7.7 KiB
Diff
241 lines
7.7 KiB
Diff
From 80e2921e472f66f70575d6e4e6c8ff6f5714e4e4 Mon Sep 17 00:00:00 2001
|
|
From: "Richard W.M. Jones" <rjones@redhat.com>
|
|
Date: Tue, 29 May 2012 20:40:36 +0100
|
|
Subject: [PATCH 05/12] ocamlbyteinfo, ocamlplugininfo: Useful utilities from
|
|
Debian, sent upstream.
|
|
|
|
See:
|
|
http://git.debian.org/?p=pkg-ocaml-maint/packages/ocaml.git;a=tree;f=debian/ocamlbyteinfo;hb=HEAD
|
|
---
|
|
ocamlbyteinfo.ml | 101 +++++++++++++++++++++++++++++++++++++++++++++++++
|
|
ocamlplugininfo.ml | 109 +++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
2 files changed, 210 insertions(+)
|
|
create mode 100644 ocamlbyteinfo.ml
|
|
create mode 100644 ocamlplugininfo.ml
|
|
|
|
diff --git a/ocamlbyteinfo.ml b/ocamlbyteinfo.ml
|
|
new file mode 100644
|
|
index 000000000..eb9a293e3
|
|
--- /dev/null
|
|
+++ b/ocamlbyteinfo.ml
|
|
@@ -0,0 +1,101 @@
|
|
+(***********************************************************************)
|
|
+(* *)
|
|
+(* 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))
|
|
diff --git a/ocamlplugininfo.ml b/ocamlplugininfo.ml
|
|
new file mode 100644
|
|
index 000000000..e28800f31
|
|
--- /dev/null
|
|
+++ b/ocamlplugininfo.ml
|
|
@@ -0,0 +1,109 @@
|
|
+(***********************************************************************)
|
|
+(* *)
|
|
+(* 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 .cmxs file *)
|
|
+
|
|
+open Natdynlink
|
|
+open Format
|
|
+
|
|
+let file =
|
|
+ try
|
|
+ Sys.argv.(1)
|
|
+ with _ -> begin
|
|
+ Printf.eprintf "Usage: %s file.cmxs\n" Sys.argv.(0);
|
|
+ exit(1)
|
|
+ end
|
|
+
|
|
+exception Abnormal_exit
|
|
+
|
|
+let error s e =
|
|
+ let eprint = Printf.eprintf in
|
|
+ let print_exc s = function
|
|
+ | End_of_file ->
|
|
+ eprint "%s: %s\n" s file
|
|
+ | Abnormal_exit ->
|
|
+ eprint "%s\n" s
|
|
+ | e -> eprint "%s\n" (Printexc.to_string e)
|
|
+ in
|
|
+ print_exc s e;
|
|
+ exit(1)
|
|
+
|
|
+let read_in command =
|
|
+ let cmd = Printf.sprintf command file in
|
|
+ let ic = Unix.open_process_in cmd in
|
|
+ try
|
|
+ let line = input_line ic in
|
|
+ begin match (Unix.close_process_in ic) with
|
|
+ | Unix.WEXITED 0 -> Str.split (Str.regexp "[ ]+") line
|
|
+ | Unix.WEXITED _ | Unix.WSIGNALED _ | Unix.WSTOPPED _ ->
|
|
+ error
|
|
+ (Printf.sprintf
|
|
+ "Command \"%s\" exited abnormally"
|
|
+ cmd
|
|
+ )
|
|
+ Abnormal_exit
|
|
+ end
|
|
+ with e -> error "File is empty" e
|
|
+
|
|
+let get_offset adr_off adr_sec =
|
|
+ try
|
|
+ let adr = List.nth adr_off 4 in
|
|
+ let off = List.nth adr_off 5 in
|
|
+ let sec = List.hd adr_sec in
|
|
+
|
|
+ let (!) x = Int64.of_string ("0x" ^ x) in
|
|
+ let (+) = Int64.add in
|
|
+ let (-) = Int64.sub in
|
|
+
|
|
+ Int64.to_int (!off + !sec - !adr)
|
|
+
|
|
+ with Failure _ | Invalid_argument _ ->
|
|
+ error
|
|
+ "Command output doesn't have the expected format"
|
|
+ Abnormal_exit
|
|
+
|
|
+let print_infos name crc defines cmi cmx =
|
|
+ let print_name_crc (name, crc) =
|
|
+ printf "@ %s (%s)" name (Digest.to_hex crc)
|
|
+ in
|
|
+ let pr_imports ppf imps = List.iter print_name_crc imps in
|
|
+ printf "Name: %s@." name;
|
|
+ printf "CRC of implementation: %s@." (Digest.to_hex crc);
|
|
+ printf "@[<hov 2>Globals defined:";
|
|
+ List.iter (fun s -> printf "@ %s" s) defines;
|
|
+ printf "@]@.";
|
|
+ printf "@[<v 2>Interfaces imported:%a@]@." pr_imports cmi;
|
|
+ printf "@[<v 2>Implementations imported:%a@]@." pr_imports cmx
|
|
+
|
|
+let _ =
|
|
+ let adr_off = read_in "objdump -h %s | grep ' .data '" in
|
|
+ let adr_sec = read_in "objdump -T %s | grep ' caml_plugin_header$'" in
|
|
+
|
|
+ let ic = open_in file in
|
|
+ let _ = seek_in ic (get_offset adr_off adr_sec) in
|
|
+ let header = (input_value ic : Natdynlink.dynheader) in
|
|
+ if header.magic <> Natdynlink.dyn_magic_number then
|
|
+ raise(Error(Natdynlink.Not_a_bytecode_file file))
|
|
+ else begin
|
|
+ List.iter
|
|
+ (fun ui ->
|
|
+ print_infos
|
|
+ ui.name
|
|
+ ui.crc
|
|
+ ui.defines
|
|
+ ui.imports_cmi
|
|
+ ui.imports_cmx)
|
|
+ header.units
|
|
+ end
|
|
--
|
|
2.14.0
|
|
|