- Add ocamlbyteinfo and ocamlplugininfo programs from Debian.

ocaml.spec

@@ -2,7 +2,7 @@
 
 Name:           ocaml
 Version:        3.11.1
-Release:        2%{?dist}
+Release:        3%{?dist}
 
 Summary:        Objective Caml compiler and programming environment
 
@@ -18,6 +18,11 @@ Source3:        http://caml.inria.fr/distrib/ocaml-3.11/ocaml-3.11-refman.info.t
 Source4:        ocaml-find-requires.sh
 Source5:        ocaml-find-provides.sh
 
+# Useful utilities from Debian, and sent upstream.
+# http://git.debian.org/?p=pkg-ocaml-maint/packages/ocaml.git;a=tree;f=debian/ocamlbyteinfo;hb=HEAD
+Source6:        ocamlbyteinfo.ml
+Source7:        ocamlplugininfo.ml
+
 Patch0:         ocaml-3.11.0-rpath.patch
 Patch1:         ocaml-user-cflags.patch
 
@@ -212,6 +217,13 @@ make -C emacs ocamltags
 # make -C tools objinfo
 (cd tools; ../boot/ocamlrun ../ocamlopt -nostdlib -I ../stdlib -I ../utils -I ../parsing -I ../typing -I ../bytecomp -I ../asmcomp -I ../driver -o objinfo config.cmx objinfo.ml)
 
+# Currently these tools are supplied by Debian, but are expected
+# to go upstream at some point.
+cp %{SOURCE6} %{SOURCE7} .
+boot/ocamlrun ./ocamlc -I otherlibs/dynlink dynlinkaux.cmo ocamlbyteinfo.ml -o ocamlbyteinfo
+cp otherlibs/dynlink/natdynlink.ml .
+boot/ocamlrun ./ocamlopt unix.cmxa str.cmxa natdynlink.ml ocamlplugininfo.ml -o ocamlplugininfo
+
 
 %install
 rm -rf $RPM_BUILD_ROOT
@@ -248,6 +260,9 @@ echo %{version} > $RPM_BUILD_ROOT%{_libdir}/ocaml/fedora-ocaml-release
 # Remove rpaths from stublibs .so files.
 chrpath --delete $RPM_BUILD_ROOT%{_libdir}/ocaml/stublibs/*.so
 
+install -m 0755 ocamlbyteinfo $RPM_BUILD_ROOT%{_bindir}
+install -m 0755 ocamlplugininfo $RPM_BUILD_ROOT%{_bindir}
+
 
 %clean
 rm -rf $RPM_BUILD_ROOT
@@ -270,6 +285,7 @@ fi
 %files
 %defattr(-,root,root,-)
 %{_bindir}/ocaml
+%{_bindir}/ocamlbyteinfo
 %{_bindir}/ocamlbuild
 %{_bindir}/ocamlbuild.byte
 %{_bindir}/ocamlbuild.native
@@ -286,6 +302,7 @@ fi
 %{_bindir}/ocamlobjinfo
 %{_bindir}/ocamlopt
 %{_bindir}/ocamlopt.opt
+%{_bindir}/ocamlplugininfo
 %{_bindir}/ocamlprof
 %{_bindir}/ocamlyacc
 %{_libdir}/ocaml/addlabels
@@ -433,6 +450,9 @@ fi
 
 
 %changelog
+* Fri Oct 16 2009 Richard W.M. Jones <rjones@redhat.com> - 3.11.1-3
+- Add ocamlbyteinfo and ocamlplugininfo programs from Debian.
+
 * Sun Oct  4 2009 Richard W.M. Jones <rjones@redhat.com> - 3.11.1-2
 - ocaml-find-requires.sh: Calculate runtime version using ocamlrun
   -version instead of fedora-ocaml-release file.

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))

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