From d8bb0c08fbd8b864586731e2f22ac690286548cd Mon Sep 17 00:00:00 2001
From: Mehdi Dogguy <dogguy@pps.jussieu.fr>
Date: Sat, 18 Jul 2009 02:27:47 +0200
Subject: [PATCH] Add ocamlbyteinfo

ocamlbyteinfo reads bytecode binaries and prints informations about
what's inside the bytecode binary such as used C stubs, present OCaml
modules with their md5sum.
---
 debian/ocamlbyteinfo/Makefile         | 19 +++++++
 debian/ocamlbyteinfo/ocamlbyteinfo.ml | 76 +++++++++++++++++++++++++++
 debian/rules                          |  1 +
 3 files changed, 96 insertions(+)
 create mode 100644 debian/ocamlbyteinfo/Makefile
 create mode 100644 debian/ocamlbyteinfo/ocamlbyteinfo.ml

diff --git a/debian/ocamlbyteinfo/Makefile b/debian/ocamlbyteinfo/Makefile
new file mode 100644
index 00000000..18e2f83e
--- /dev/null
+++ b/debian/ocamlbyteinfo/Makefile
@@ -0,0 +1,19 @@
+
+EXE=ocamlbyteinfo
+OCAMLC=./ocamlc
+
+DEPS=utils/misc.cmo utils/tbl.cmo \
+  utils/config.cmo utils/clflags.cmo \
+  typing/ident.cmo typing/path.cmo typing/types.cmo typing/btype.cmo \
+  typing/predef.cmo bytecomp/instruct.cmo bytecomp/runtimedef.cmo bytecomp/bytesections.cmo \
+  bytecomp/dll.cmo bytecomp/meta.cmo bytecomp/symtable.cmo
+
+INCLUDES= -I stdlib -I utils -I typing -I bytecomp
+
+all: $(EXE)
+
+$(EXE): $(DEPS)
+	$(OCAMLC) -o debian/$(EXE)/$(EXE) $(INCLUDES) $(DEPS) debian/$(EXE)/$(EXE).ml
+
+clean:
+	rm -f $(addprefix debian/$(EXE)/, $(EXE) $(EXE).cmo $(EXE).cmi)
diff --git a/debian/ocamlbyteinfo/ocamlbyteinfo.ml b/debian/ocamlbyteinfo/ocamlbyteinfo.ml
new file mode 100644
index 00000000..e789a733
--- /dev/null
+++ b/debian/ocamlbyteinfo/ocamlbyteinfo.ml
@@ -0,0 +1,76 @@
+
+(*
+ * Copyright (C) 2009 Mehdi Dogguy
+ * You have permission to copy, modify, and redistribute under the
+ * terms of the LGPL-2.1.
+ *)
+
+open Sys
+
+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 []
+
+let input_stringlist ic len =
+  let sect = String.create len in
+  let _ = really_input ic sect 0 len in
+    get_string_list sect len
+
+let print = Printf.printf
+
+type prefix = C | P | M | S | R | D
+let p_prefix = function
+  | C -> "DLLS"
+  | M -> "UNIT"
+  | P -> "DLPT"
+  | S -> "SYMB"
+  | R -> "PRIM"
+  | D -> "DBUG"
+
+let p_section prefix =
+  List.iter
+    (fun name -> print "%s %s\n" (p_prefix prefix) name)
+
+let _ =
+  let input_name = Sys.argv.(1) in
+  let ic = open_in_bin input_name in
+  let _ = Bytesections.read_toc ic in
+  let toc = Bytesections.toc () in
+    List.iter
+      (fun (sec, len) ->
+         if len > 0 then
+           let _ = Bytesections.seek_section ic sec in
+             match sec with
+               | "CRCS" ->
+                   let crcs = (input_value ic : (string * Digest.t) list)
+                   in List.iter
+                        (fun (name, dig) -> print "%s %s %s\n"
+                           (p_prefix M)
+                           (Digest.to_hex dig)
+                           name
+                        ) crcs
+               | "DLLS" -> p_section C (input_stringlist ic len)
+               | "DLPT" -> p_section P (input_stringlist ic len)
+               | "SYMB" ->
+                   let (_, sym_table) = (input_value ic
+                                           : int * (Ident.t, int) Tbl.t)
+                   in let list = ref []
+                   in let _ = Tbl.map
+                       (fun id pos -> list := (id,pos) :: !list) sym_table
+                   in List.iter (fun (id, pos) -> print "%s %.10d %s\n"
+                                   (p_prefix S)
+                                   pos
+                                   (Ident.name id))
+                        (List.sort
+                           (fun (_, pos) (_,pos') -> Pervasives.compare pos pos')
+                           !list)
+               | "PRIM" -> p_section R (input_stringlist ic len)
+               | _ -> ()
+      )
+      toc;
+    close_in ic
diff --git a/debian/rules b/debian/rules
index 60dd3233..2ddd0cf3 100755
--- a/debian/rules
+++ b/debian/rules
@@ -111,6 +111,7 @@ else
 	@echo "Building native compilers"
 	$(MAKE) opt opt.opt
 	$(MAKE) -C tools dumpapprox
+	$(MAKE) -f debian/ocamlbyteinfo/Makefile
 	touch opt-built-stamp
 endif
 else
-- 
2.30.2