← Back to branch summary

~ubuntu-branches/debian/sid/ocaml/sid

« back to all changes in this revision

Viewing changes to debian/ocamlbyteinfo/ocamlplugininfo.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu
  • Date: 2011-04-21 21:35:08 UTC
  • mfrom: (1.1.11 upstream) (12.1.14 sid)
  • Revision ID: james.westby@ubuntu.com-20110421213508-kg34453aqmb0moha
* Fixes related to -output-obj with g++ (in debian/patches):
  - add Declare-primitive-name-table-as-const-char
  - add Avoid-multiple-declarations-in-generated-.c-files-in
  - fix Embed-bytecode-in-C-object-when-using-custom: the closing
    brace for extern "C" { ... } was missing in some cases

Show diffs side-by-side

added added

removed removed

Lines of Context:
debian/ocamlbyteinfo/ocamlplugininfo.ml
1
 
(***********************************************************************)
2
 
(*                                                                     *)
3
 
(*                           Objective Caml                            *)
4
 
(*                                                                     *)
5
 
(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)
6
 
(*                                                                     *)
7
 
(*  Copyright 2009 Institut National de Recherche en Informatique et   *)
8
 
(*  en Automatique.  All rights reserved.  This file is distributed    *)
9
 
(*  under the terms of the GNU Library General Public License, with    *)
10
 
(*  the special exception on linking described in file ../../LICENSE.  *)
11
 
(*                                                                     *)
12
 
(***********************************************************************)
13
 
 
14
 
(* $Id$ *)
15
 
 
16
 
(* Dumps a .cmxs file *)
17
 
 
18
 
open Natdynlink
19
 
open Format
20
 
 
21
 
let file =
22
 
  try
23
 
    Sys.argv.(1)
24
 
  with _ -> begin
25
 
    Printf.eprintf "Usage: %s file.cmxs\n" Sys.argv.(0);
26
 
    exit(1)
27
 
  end
28
 
 
29
 
exception Abnormal_exit
30
 
 
31
 
let error s e =
32
 
  let eprint = Printf.eprintf in
33
 
  let print_exc s = function
34
 
    | End_of_file ->
35
 
       eprint "%s: %s\n" s file
36
 
    | Abnormal_exit ->
37
 
        eprint "%s\n" s
38
 
    | e -> eprint "%s\n" (Printexc.to_string e)
39
 
  in
40
 
    print_exc s e;
41
 
    exit(1)
42
 
 
43
 
let read_in command =
44
 
  let cmd = Printf.sprintf command file in
45
 
  let ic = Unix.open_process_in cmd in
46
 
  try
47
 
    let line = input_line ic in
48
 
    begin match (Unix.close_process_in ic) with
49
 
      | Unix.WEXITED 0 -> Str.split (Str.regexp "[ ]+") line
50
 
      | Unix.WEXITED _  | Unix.WSIGNALED _ | Unix.WSTOPPED _ ->
51
 
          error
52
 
            (Printf.sprintf
53
 
               "Command \"%s\" exited abnormally"
54
 
               cmd
55
 
            )
56
 
            Abnormal_exit
57
 
    end
58
 
  with e -> error "File is empty" e
59
 
 
60
 
let get_offset adr_off adr_sec =
61
 
  try
62
 
    let adr = List.nth adr_off 4 in
63
 
    let off = List.nth adr_off 5 in
64
 
    let sec = List.hd adr_sec in
65
 
 
66
 
    let (!) x = Int64.of_string ("0x" ^ x) in
67
 
    let (+) = Int64.add in
68
 
    let (-) = Int64.sub in
69
 
 
70
 
      Int64.to_int (!off + !sec - !adr)
71
 
 
72
 
  with Failure _ | Invalid_argument _ ->
73
 
    error
74
 
      "Command output doesn't have the expected format"
75
 
      Abnormal_exit
76
 
 
77
 
let print_infos name crc defines cmi cmx =
78
 
  let print_name_crc (name, crc) =
79
 
    printf "@ %s (%s)" name (Digest.to_hex crc)
80
 
  in
81
 
  let pr_imports ppf imps = List.iter print_name_crc imps in
82
 
  printf "Name: %s@." name;
83
 
  printf "CRC of implementation: %s@." (Digest.to_hex crc);
84
 
  printf "@[<hov 2>Globals defined:";
85
 
  List.iter (fun s -> printf "@ %s" s) defines;
86
 
  printf "@]@.";
87
 
  printf "@[<v 2>Interfaces imported:%a@]@." pr_imports cmi;
88
 
  printf "@[<v 2>Implementations imported:%a@]@." pr_imports cmx
89
 
 
90
 
let _ =
91
 
  let adr_off = read_in "objdump -h %s | grep ' .data '" in
92
 
  let adr_sec = read_in "objdump -T %s | grep ' caml_plugin_header$'" in
93
 
 
94
 
  let ic = open_in file in
95
 
  let _ = seek_in ic (get_offset adr_off adr_sec) in
96
 
  let header  = (input_value ic : Natdynlink.dynheader) in
97
 
    if header.magic <> Natdynlink.dyn_magic_number then
98
 
      raise(Error(Natdynlink.Not_a_bytecode_file file))
99
 
    else begin
100
 
      List.iter
101
 
        (fun ui ->
102
 
           print_infos
103
 
             ui.name
104
 
             ui.crc
105
 
             ui.defines
106
 
             ui.imports_cmi
107
 
             ui.imports_cmx)
108
 
        header.units
109
 
    end