#!/usr/bin/perl

#**************************************************************************
#*                                                                        *
#*                                 OCaml                                  *
#*                                                                        *
#*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *
#*                                                                        *
#*   Copyright 2002 Institut National de Recherche en Informatique et     *
#*     en Automatique.                                                    *
#*                                                                        *
#*   All rights reserved.  This file is distributed under the terms of    *
#*   the GNU Lesser General Public License version 2.1, with the          *
#*   special exception on linking described in the file LICENSE.          *
#*                                                                        *
#**************************************************************************

foreach $f (@ARGV) {
    open(FILE, $f) || die("Cannot open $f");
    read(FILE, $header, 2);
    if ($header eq '#!') {
      $path = <FILE>;
      if ($path = '/bin/sh') {
        # exec form of the shebang header
        $path = <FILE>;
        if ($path =~ s/^exec '(.*)' "\$0" "\$@\"$/$1/ > 0) {
          $path =~ s/'\\''/'/g;
        } else {
          undef $path;
        }
      }
    };
    seek(FILE, -16, 2);
    $num_sections = &read_int();
    read(FILE, $magic, 12);
    seek(FILE, -16 - 8 * $num_sections, 2);
    @secname = ();
    @seclength = ();
    %length = ();
    for ($i = 0; $i < $num_sections; $i++) {
        read(FILE, $sec, 4);
        $secname[$i] = $sec;
        $seclength[$i] = &read_int();
        $length{$sec} = $seclength[$i];
    }
    print $f, ":\n" if ($#ARGV > 0);
    if (not defined $path) {
      $path =
          $length{'RNTM'} > 0 ?
              substr(&read_section('RNTM'), 0, -1) :
              "(custom runtime)";
    };
    printf ("\tcode: %-7d data: %-7d symbols: %-7d debug: %-7d\n",
            $length{'CODE'}, $length{'DATA'},
            $length{'SYMB'}, $length{'DBUG'});
    printf ("\tmagic number: %s  runtime system: %s\n",
            $magic, $path);
    close(FILE);
}

sub read_int {
    read(FILE, $buff, 4) == 4 || die("Truncated bytecode file $f");
    @int = unpack("C4", $buff);
    return ($int[0] << 24) + ($int[1] << 16) + ($int[2] << 8) + $int[3];
}

sub read_section {
    local ($sec) = @_;
    local ($i, $ofs, $data);
    for ($i = $num_sections - 1; $i >= 0; $i--) {
        $ofs += $seclength[$i];
        if ($secname[$i] eq $sec) {
            seek(FILE, -16 - 8 * $num_sections - $ofs, 2);
            read(FILE, $data, $seclength[$i]);
            return $data;
        }
    }
    return '';
}