PR#5059: split objinfo into a pure Caml part and a pure C part.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@10459 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

5 files changed, 134 insertions, 113 deletions

diff --git a/tools/Makefile.shared b/tools/Makefile.shared
index b128ffbf3..fa32e4613 100644
--- a/tools/Makefile.shared
+++ b/tools/Makefile.shared
@@ -228,27 +228,22 @@ beforedepend:: opnames.ml
 
 # Display info on compiled files
 
-objinfo_lib.cma: ocamlmklib objinfo_lib.cmo objinfo_stubs$(EXT_OBJ)
-	../boot/ocamlrun ./ocamlmklib -ocamlc '$(CAMLC)' \
-          -o objinfo_lib objinfo_lib.cmo objinfo_stubs$(EXT_OBJ) $(LIBBFD_LINK)
+objinfo_helper$(EXE): objinfo_helper.c ../config/s.h
+	$(BYTECC) -o objinfo_helper$(EXE) $(BYTECCCOMPOPTS) \
+          objinfo_helper.c $(LIBBFD_LINK)
 
-objinfo_stubs$(EXT_OBJ): objinfo_stubs.c
-	$(BYTECC) $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) -c objinfo_stubs.c
+OBJINFO=../utils/misc.cmo ../utils/config.cmo ../bytecomp/bytesections.cmo \
+        objinfo.cmo
 
-OBJINFO=../utils/config.cmo ../bytecomp/bytesections.cmo \
-        objinfo_lib.cma objinfo.cmo
-
-objinfo: $(OBJINFO)
+objinfo: objinfo_helper$(EXE) $(OBJINFO)
 	$(CAMLC) -o objinfo $(OBJINFO)
 
 install::
 	cp objinfo $(BINDIR)/ocamlobjinfo$(EXE)
-	if test -f dllobjinfo_lib$(EXT_DLL); then \
-          cp dllobjinfo_lib$(EXT_DLL) $(STUBLIBDIR)/; fi
+	cp objinfo_helper$(EXE) $(LIBDIR)/objinfo_helper$(EXE)
 
 clean::
-	rm -f objinfo
-	rm -f objinfo_stubs$(EXT_OBJ) libobjinfo_lib$(EXT_LIB) dllobjinfo_lib$(EXT_DLL)
+	rm -f objinfo objinfo_helper$(EXE)
 
 # Scan object files for required primitives
 
diff --git a/tools/objinfo.ml b/tools/objinfo.ml
index 88d218068..e9eb40313 100644
--- a/tools/objinfo.ml
+++ b/tools/objinfo.ml
@@ -19,6 +19,7 @@
    and on bytecode executables. *)
 
 open Printf
+open Misc
 open Config
 open Cmo_format
 open Clambda
@@ -181,6 +182,27 @@ let dump_byte ic =
     )
     toc
 
+let read_dyn_header filename ic =
+  let tempfile = Filename.temp_file "objinfo" ".out" in
+  let helper = Filename.concat Config.standard_library "objinfo_helper" in
+  try
+    try_finally
+      (fun () ->
+        let rc = Sys.command (sprintf "%s %s > %s"
+                                (Filename.quote helper)
+                                (Filename.quote filename)
+                                tempfile) in
+        if rc <> 0 then failwith "cannot read";
+        let tc = open_in tempfile in
+        try_finally
+          (fun () ->
+            let ofs = Scanf.fscanf tc "%Ld" (fun x -> x) in
+            LargeFile.seek_in ic ofs;
+            Some(input_value ic : dynheader))
+          (fun () -> close_in tc))
+      (fun () -> remove_file tempfile)
+  with Failure _ | Sys_error _ -> None
+
 let dump_obj filename =
   printf "File %s\n" filename;
   let ic = open_in_bin filename in
@@ -221,20 +243,18 @@ let dump_obj filename =
       dump_byte ic;
       close_in ic
     end else if Filename.check_suffix filename ".cmxs" then begin
-      let offset = Objinfo_lib.get_cmxs_info filename in
-      begin match offset with
-        | -2L -> printf "Cannot display info on .cmxs files\n"
-        | -1L -> printf "Failed to read table of contents\n"; exit 2
-        | _ ->
-            let _ = LargeFile.seek_in ic offset in
-            let header = (input_value ic : dynheader) in
-            if header.dynu_magic = Config.cmxs_magic_number then
-              print_cmxs_infos header
-            else begin
-              printf "Wrong magic number\n"; exit 2
-            end
-      end;
-      close_in ic
+      flush stdout;
+      match read_dyn_header filename ic with
+      | None ->
+          printf "Unable to read info on file %s\n" filename;
+          exit 2
+      | Some header ->
+          if header.dynu_magic = Config.cmxs_magic_number then
+            print_cmxs_infos header
+          else begin
+            printf "Wrong magic number\n"; exit 2
+          end;
+          close_in ic
     end else begin
       printf "Not an OCaml object file\n"; exit 2
     end
diff --git a/tools/objinfo_helper.c b/tools/objinfo_helper.c
new file mode 100644
index 000000000..464720c29
--- /dev/null
+++ b/tools/objinfo_helper.c
@@ -0,0 +1,92 @@
+/***********************************************************************/
+/*                                                                     */
+/*                           Objective Caml                            */
+/*                                                                     */
+/*        Mehdi Dogguy, PPS laboratory, University Paris Diderot       */
+/*                                                                     */
+/*  Copyright 2010 Mehdi Dogguy.  Used and distributed as part of      */
+/*  Objective Caml by permission from the author.   This file is       */
+/*  distributed under the terms of the Q Public License version 1.0.   */
+/***********************************************************************/
+
+#include "../config/s.h"
+#include "../byterun/mlvalues.h"
+#include "../byterun/alloc.h"
+#include <stdio.h>
+
+#ifdef HAS_LIBBFD
+#include <stdlib.h>
+#include <string.h>
+#include <bfd.h>
+
+int main(int argc, char ** argv)
+{
+  bfd *fd;
+  asection *sec;
+  file_ptr offset;
+  long st_size;
+  asymbol ** symbol_table;
+  long sym_count, i;
+
+  if (argc != 2) {
+    fprintf(stderr, "Usage: objinfo_helper <dynamic library>\n");
+    return 2;
+  }
+
+  fd = bfd_openr(argv[1], "default");
+  if (!fd) {
+    fprintf(stderr, "Error opening file %s\n", argv[1]);
+    return 2;
+  }
+  if (! bfd_check_format (fd, bfd_object)) {
+    fprintf(stderr, "Error: wrong format\n");
+    bfd_close(fd);
+    return 2;
+  }
+
+  sec = bfd_get_section_by_name(fd, ".data");
+  if (! sec) {
+    fprintf(stderr, "Error: section .data not found\n");
+    bfd_close(fd);
+    return 2;
+  }
+
+  offset = sec->filepos;
+  st_size = bfd_get_dynamic_symtab_upper_bound (fd);
+  if (st_size <= 0) {
+    fprintf(stderr, "Error: size of section .data unknown\n");
+    bfd_close(fd);
+    return 2;
+  }
+
+  symbol_table = malloc(st_size);
+  if (! symbol_table) {
+    fprintf(stderr, "Error: out of memory\n");
+    bfd_close(fd);
+    return 2;
+  }
+
+  sym_count = bfd_canonicalize_dynamic_symtab (fd, symbol_table);
+
+  for (i = 0; i < sym_count; i++) {
+    if (strcmp(symbol_table[i]->name, "caml_plugin_header") == 0) {
+      printf("%ld\n", (long) (offset + symbol_table[i]->value));
+      bfd_close(fd);
+      return 0;
+    }
+  }
+
+  fprintf(stderr, "Error: missing symbol caml_plugin_header\n");
+  bfd_close(fd);
+  return 2;
+}
+
+#else
+
+int main(int argc, char ** argv)
+{
+  fprintf(stderr, "BFD library unavailable, cannot print info on .cmxs files\n");
+  return 2;
+}
+
+#endif
diff --git a/tools/objinfo_lib.ml b/tools/objinfo_lib.ml
deleted file mode 100644
index c24845d16..000000000
--- a/tools/objinfo_lib.ml
+++ /dev/null
@@ -1,16 +0,0 @@
-(***********************************************************************)
-(*                                                                     *)
-(*                           Objective Caml                            *)
-(*                                                                     *)
-(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
-(*                                                                     *)
-(*  Copyright 2010 Institut National de Recherche en Informatique et   *)
-(*  en Automatique.  All rights reserved.  This file is distributed    *)
-(*  under the terms of the Q Public License version 1.0.               *)
-(*                                                                     *)
-(***********************************************************************)
-
-(* $Id: objinfo.ml 9510 2010-01-07 15:07:30Z doligez $ *)
-
-external get_cmxs_info : string -> int64 = "caml_get_cmxs_offset"
-
diff --git a/tools/objinfo_stubs.c b/tools/objinfo_stubs.c
deleted file mode 100644
index e96466e2e..000000000
--- a/tools/objinfo_stubs.c
+++ /dev/null
@@ -1,70 +0,0 @@
-/***********************************************************************/
-/*                                                                     */
-/*                           Objective Caml                            */
-/*                                                                     */
-/*        Mehdi Dogguy, PPS laboratory, University Paris Diderot       */
-/*                                                                     */
-/*  Copyright 2010 Mehdi Dogguy.  Used and distributed as part of      */
-/*  Objective Caml by permission from the author.   This file is       */
-/*  distributed under the terms of the Q Public License version 1.0.   */
-/***********************************************************************/
-
-#include "../config/s.h"
-#include "../byterun/mlvalues.h"
-#include "../byterun/alloc.h"
-
-#ifdef HAS_LIBBFD
-#include <stdlib.h>
-#include <string.h>
-#include <bfd.h>
-
-static file_ptr get_cmxs_offset (char *file)
-{
-  file_ptr result = -1;
-  bfd *fd;
-  asection *sec;
-  file_ptr offset;
-  long st_size;
-  asymbol ** symbol_table;
-  long sym_count, i;
-
-  fd = bfd_openr(file, "default");
-  if (!fd) return -1;
-
-  do {
-    if (! bfd_check_format (fd, bfd_object)) break;
-
-    sec = bfd_get_section_by_name(fd, ".data");
-    if (! sec) break;
-
-    offset = sec->filepos;
-    st_size = bfd_get_dynamic_symtab_upper_bound (fd);
-    if (st_size <= 0) break;
-
-    symbol_table = malloc(st_size);
-    if (! symbol_table) break;
-
-    sym_count = bfd_canonicalize_dynamic_symtab (fd, symbol_table);
-    for (i = 0; i < sym_count; i++) {
-      if (strcmp(symbol_table[i]->name, "caml_plugin_header") == 0) {
-        result = offset + symbol_table[i]->value;
-        break;
-      }
-    }
-    free(symbol_table);
-  }
-  while (0);
-  bfd_close(fd);
-  return result;
-}
-
-#endif
-
-CAMLprim value caml_get_cmxs_offset(value file)
-{
-#ifdef HAS_LIBBFD
-  return caml_copy_int64(get_cmxs_offset(String_val(file)));
-#else
-  return caml_copy_int64(-2);
-#endif
-}