91c6a9
From 11b377aee2811891635982a5590fef62f12645b6 Mon Sep 17 00:00:00 2001
a07112
From: "Richard W.M. Jones" <rjones@redhat.com>
a07112
Date: Tue, 29 May 2012 20:40:36 +0100
5d60b0
Subject: [PATCH 04/12] ocamlbyteinfo, ocamlplugininfo: Useful utilities from
a07112
 Debian, sent upstream.
a07112
a07112
See:
a07112
http://git.debian.org/?p=pkg-ocaml-maint/packages/ocaml.git;a=tree;f=debian/ocamlbyteinfo;hb=HEAD
a07112
---
ed0c3a
 ocamlbyteinfo.ml   | 101 +++++++++++++++++++++++++++++++++++++++++++++++++
ed0c3a
 ocamlplugininfo.ml | 109 +++++++++++++++++++++++++++++++++++++++++++++++++++++
963a64
 2 files changed, 210 insertions(+)
a07112
 create mode 100644 ocamlbyteinfo.ml
a07112
 create mode 100644 ocamlplugininfo.ml
a07112
a07112
diff --git a/ocamlbyteinfo.ml b/ocamlbyteinfo.ml
a07112
new file mode 100644
a07112
index 0000000..eb9a293
a07112
--- /dev/null
a07112
+++ b/ocamlbyteinfo.ml
a07112
@@ -0,0 +1,101 @@
a07112
+(***********************************************************************)
a07112
+(*                                                                     *)
a07112
+(*                           Objective Caml                            *)
a07112
+(*                                                                     *)
a07112
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
a07112
+(*                                                                     *)
a07112
+(*  Copyright 2009 Institut National de Recherche en Informatique et   *)
a07112
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
a07112
+(*  under the terms of the GNU Library General Public License, with    *)
a07112
+(*  the special exception on linking described in file ../../LICENSE.  *)
a07112
+(*                                                                     *)
a07112
+(***********************************************************************)
a07112
+
a07112
+(* $Id$ *)
a07112
+
a07112
+(* Dumps a bytecode binary file *)
a07112
+
a07112
+open Sys
a07112
+open Dynlinkaux
a07112
+
a07112
+let input_stringlist ic len =
a07112
+  let get_string_list sect len =
a07112
+    let rec fold s e acc =
a07112
+      if e != len then
a07112
+        if sect.[e] = '\000' then
a07112
+          fold (e+1) (e+1) (String.sub sect s (e-s) :: acc)
a07112
+        else fold s (e+1) acc
a07112
+      else acc
a07112
+    in fold 0 0 []
a07112
+  in
a07112
+  let sect = String.create len in
a07112
+  let _ = really_input ic sect 0 len in
a07112
+  get_string_list sect len
a07112
+
a07112
+let print = Printf.printf
a07112
+let perr s =
a07112
+  Printf.eprintf "%s\n" s;
a07112
+  exit(1)
a07112
+let p_title title = print "%s:\n" title
a07112
+
a07112
+let p_section title format pdata = function
a07112
+  | [] -> ()
a07112
+  | l ->
a07112
+      p_title title;
a07112
+      List.iter
a07112
+        (fun (name, data) -> print format (pdata data) name)
a07112
+        l
a07112
+
a07112
+let p_list title format = function
a07112
+  | [] -> ()
a07112
+  | l ->
a07112
+      p_title title;
a07112
+      List.iter
a07112
+        (fun name -> print format name)
a07112
+        l
a07112
+
a07112
+let _ =
a07112
+  try
a07112
+    let input_name = Sys.argv.(1) in
a07112
+    let ic = open_in_bin input_name in
a07112
+    Bytesections.read_toc ic;
a07112
+    List.iter
a07112
+      (fun section ->
a07112
+         try
a07112
+           let len = Bytesections.seek_section ic section in
a07112
+           if len > 0 then match section with
a07112
+             | "CRCS" ->
a07112
+                 p_section
a07112
+                   "Imported Units"
a07112
+                   "\t%s\t%s\n"
a07112
+                   Digest.to_hex
a07112
+                   (input_value ic : (string * Digest.t) list)
a07112
+             | "DLLS" ->
a07112
+                 p_list
a07112
+                   "Used Dlls" "\t%s\n"
a07112
+                   (input_stringlist ic len)
a07112
+             | "DLPT" ->
a07112
+                 p_list
a07112
+                   "Additional Dll paths"
a07112
+                   "\t%s\n"
a07112
+                   (input_stringlist ic len)
a07112
+             | "PRIM" ->
a07112
+                 let prims = (input_stringlist ic len) in
a07112
+                 print "Uses unsafe features: ";
a07112
+                 begin match prims with
a07112
+                     [] -> print "no\n"
a07112
+                   | l  -> print "YES\n";
a07112
+                       p_list "Primitives declared in this module"
a07112
+                         "\t%s\n"
a07112
+                         l
a07112
+                 end
a07112
+             | _ -> ()
a07112
+         with Not_found | Failure _ | Invalid_argument _ -> ()
a07112
+      )
a07112
+      ["CRCS"; "DLLS"; "DLPT"; "PRIM"];
a07112
+    close_in ic
a07112
+  with
a07112
+    | Sys_error msg ->
a07112
+        perr msg
a07112
+    | Invalid_argument("index out of bounds") ->
a07112
+        perr (Printf.sprintf "Usage: %s filename" Sys.argv.(0))
a07112
diff --git a/ocamlplugininfo.ml b/ocamlplugininfo.ml
a07112
new file mode 100644
a07112
index 0000000..e28800f
a07112
--- /dev/null
a07112
+++ b/ocamlplugininfo.ml
a07112
@@ -0,0 +1,109 @@
a07112
+(***********************************************************************)
a07112
+(*                                                                     *)
a07112
+(*                           Objective Caml                            *)
a07112
+(*                                                                     *)
a07112
+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
a07112
+(*                                                                     *)
a07112
+(*  Copyright 2009 Institut National de Recherche en Informatique et   *)
a07112
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
a07112
+(*  under the terms of the GNU Library General Public License, with    *)
a07112
+(*  the special exception on linking described in file ../../LICENSE.  *)
a07112
+(*                                                                     *)
a07112
+(***********************************************************************)
a07112
+
a07112
+(* $Id$ *)
a07112
+
a07112
+(* Dumps a .cmxs file *)
a07112
+
a07112
+open Natdynlink
a07112
+open Format
a07112
+
a07112
+let file =
a07112
+  try
a07112
+    Sys.argv.(1)
a07112
+  with _ -> begin
a07112
+    Printf.eprintf "Usage: %s file.cmxs\n" Sys.argv.(0);
a07112
+    exit(1)
a07112
+  end
a07112
+
a07112
+exception Abnormal_exit
a07112
+
a07112
+let error s e =
a07112
+  let eprint = Printf.eprintf in
a07112
+  let print_exc s = function
a07112
+    | End_of_file ->
a07112
+       eprint "%s: %s\n" s file
a07112
+    | Abnormal_exit ->
a07112
+        eprint "%s\n" s
a07112
+    | e -> eprint "%s\n" (Printexc.to_string e)
a07112
+  in
a07112
+    print_exc s e;
a07112
+    exit(1)
a07112
+
a07112
+let read_in command =
a07112
+  let cmd = Printf.sprintf command file in
a07112
+  let ic = Unix.open_process_in cmd in
a07112
+  try
a07112
+    let line = input_line ic in
a07112
+    begin match (Unix.close_process_in ic) with
a07112
+      | Unix.WEXITED 0 -> Str.split (Str.regexp "[ ]+") line
a07112
+      | Unix.WEXITED _  | Unix.WSIGNALED _ | Unix.WSTOPPED _ ->
a07112
+          error
a07112
+            (Printf.sprintf
a07112
+               "Command \"%s\" exited abnormally"
a07112
+               cmd
a07112
+            )
a07112
+            Abnormal_exit
a07112
+    end
a07112
+  with e -> error "File is empty" e
a07112
+
a07112
+let get_offset adr_off adr_sec =
a07112
+  try
a07112
+    let adr = List.nth adr_off 4 in
a07112
+    let off = List.nth adr_off 5 in
a07112
+    let sec = List.hd adr_sec in
a07112
+
a07112
+    let (!) x = Int64.of_string ("0x" ^ x) in
a07112
+    let (+) = Int64.add in
a07112
+    let (-) = Int64.sub in
a07112
+
a07112
+      Int64.to_int (!off + !sec - !adr)
a07112
+
a07112
+  with Failure _ | Invalid_argument _ ->
a07112
+    error
a07112
+      "Command output doesn't have the expected format"
a07112
+      Abnormal_exit
a07112
+
a07112
+let print_infos name crc defines cmi cmx =
a07112
+  let print_name_crc (name, crc) =
a07112
+    printf "@ %s (%s)" name (Digest.to_hex crc)
a07112
+  in
a07112
+  let pr_imports ppf imps = List.iter print_name_crc imps in
a07112
+  printf "Name: %s@." name;
a07112
+  printf "CRC of implementation: %s@." (Digest.to_hex crc);
a07112
+  printf "@[<hov 2>Globals defined:";
a07112
+  List.iter (fun s -> printf "@ %s" s) defines;
a07112
+  printf "@]@.";
a07112
+  printf "@[<v 2>Interfaces imported:%a@]@." pr_imports cmi;
a07112
+  printf "@[<v 2>Implementations imported:%a@]@." pr_imports cmx
a07112
+
a07112
+let _ =
a07112
+  let adr_off = read_in "objdump -h %s | grep ' .data '" in
a07112
+  let adr_sec = read_in "objdump -T %s | grep ' caml_plugin_header$'" in
a07112
+
a07112
+  let ic = open_in file in
a07112
+  let _ = seek_in ic (get_offset adr_off adr_sec) in
a07112
+  let header  = (input_value ic : Natdynlink.dynheader) in
a07112
+    if header.magic <> Natdynlink.dyn_magic_number then
a07112
+      raise(Error(Natdynlink.Not_a_bytecode_file file))
a07112
+    else begin
a07112
+      List.iter
a07112
+        (fun ui ->
a07112
+           print_infos
a07112
+             ui.name
a07112
+             ui.crc
a07112
+             ui.defines
a07112
+             ui.imports_cmi
a07112
+             ui.imports_cmx)
a07112
+        header.units
a07112
+    end
a07112
-- 
1dbbca
2.0.4
a07112