ocaml/0002-ocamlbyteinfo-ocamlplugininfo-Useful-utilities-from-.patch

From 118057a71576cb39d71633bf80a37815bf4ff932 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 2/8] 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..0a537e4d5
--- /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 = Bytes.create len in
+  let _ = really_input ic sect 0 len in
+  get_string_list (Bytes.to_string 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.17.1