1 #!/usr/bin/perl
2
3 #**************************************************************************
4 #* *
5 #* OCaml *
6 #* *
7 #* Xavier Leroy, projet Cristal, INRIA Rocquencourt *
8 #* *
9 #* Copyright 2002 Institut National de Recherche en Informatique et *
10 #* en Automatique. *
11 #* *
12 #* All rights reserved. This file is distributed under the terms of *
13 #* the GNU Lesser General Public License version 2.1, with the *
14 #* special exception on linking described in the file LICENSE. *
15 #* *
16 #**************************************************************************
17
18 foreach $f (@ARGV) {
19 open(FILE, $f) || die("Cannot open $f");
20 seek(FILE, -16, 2);
21 $num_sections = &read_int();
22 read(FILE, $magic, 12);
23 seek(FILE, -16 - 8 * $num_sections, 2);
24 @secname = ();
25 @seclength = ();
26 %length = ();
27 for ($i = 0; $i < $num_sections; $i++) {
28 read(FILE, $sec, 4);
29 $secname[$i] = $sec;
30 $seclength[$i] = &read_int();
31 $length{$sec} = $seclength[$i];
32 }
33 print $f, ":\n" if ($#ARGV > 0);
34 $path =
35 $length{'RNTM'} > 0 ?
36 &read_section('RNTM') :
37 "(default runtime)\n";
38 printf ("\tcode: %-7d data: %-7d symbols: %-7d debug: %-7d\n",
39 $length{'CODE'}, $length{'DATA'},
40 $length{'SYMB'}, $length{'DBUG'});
41 printf ("\tmagic number: %s runtime system: %s",
42 $magic, $path);
43 close(FILE);
44 }
45
46 sub read_int {
47 read(FILE, $buff, 4) == 4 || die("Truncated bytecode file $f");
48 @int = unpack("C4", $buff);
49 return ($int[0] << 24) + ($int[1] << 16) + ($int[2] << 8) + $int[3];
50 }
51
52 sub read_section {
53 local ($sec) = @_;
54 local ($i, $ofs, $data);
55 for ($i = $num_sections - 1; $i >= 0; $i--) {
56 $ofs += $seclength[$i];
57 if ($secname[$i] eq $sec) {
58 seek(FILE, -16 - 8 * $num_sections - $ofs, 2);
59 read(FILE, $data, $seclength[$i]);
60 return $data;
61 }
62 }
63 return '';
64 }
65