package Disasm;

@ISA = qw(Exporter);
@EXPORT_OK = qw( new );

use strict;
use Entity();

my $COMMA = '\s*,\s*';
my $HEXNUM = '([0-9a-fA-F]+)';
my $CALL = '\bcall\s+(0x)?' . $HEXNUM . '(\s+<(.+)>)?';
my $NOTHING = '^$';

my $SPARC_REG = '%([iglo][0-7])';
my $SPARC_HI = '%hi\(0x' . $HEXNUM . '\)';

my $IN_BRACKETS = '\(\s*(\w+)\s*\)';

my @ALPHA = (
  '\bjsr\s+(\w+)' . $COMMA . $IN_BRACKETS . $COMMA . '0x' . $HEXNUM,
  \&alpha_jsr,

  '^0x' . $HEXNUM . '\s.*\s+br\s+gp' . $COMMA . '0x' . $HEXNUM,
  sub { alpha_add_gp($_[0], 4 + hex($_[1])); },

  '\bldah\s+gp' . $COMMA . '(\d+)\s*\(gp\)',
  sub { alpha_add_gp($_[0], $_[1] << 16); },

  '\blda\s+gp' . $COMMA . '(\d+)\s*\(gp\)',
  \&alpha_add_gp
);
my @I386 = (
  '\bpush\s+(\$0x|dword\s+)' . $HEXNUM,
  sub { store_push($_[0], hex($_[2])); },

  $CALL,
  \&call
);
my @SPARC = (
  '\bsethi\s+' . $SPARC_HI . $COMMA . $SPARC_REG,
  sub { $_[0]->{SETHI}{$_[2]} = hex($_[1]); },

  '\bor\s+' . $SPARC_REG . $COMMA . '0x' . $HEXNUM . $COMMA . $SPARC_REG,
  \&sparc_push_2,

  $CALL,
  \&call
);
my %PUSH = ( 'alpha' => \@ALPHA, 'i386' => \@I386, 'sparc' => \@SPARC );

sub new($$$)
{
  my $proto = shift;
  my $arch = shift;
  my $base = shift;

  my $class = ref($proto) || $proto;
  my $self  = {};

  $self->{ARCH} = $arch;
  $self->{BASE} = $base;
  $self->{NR_PUSH} = 0;
  $self->{NR_CALL} = 0;
  $self->{NR_GP} = 0;
  $self->{GP} = 0;

  bless ($self, $class);
  return $self;
}

sub store_push($$)
{
  my $self = shift;
  my $value = shift;
  Entity::set_num $self->{BASE} . '.push' . $self->{NR_PUSH}++, $value;
}

sub sparc_push_2(@)
{
  my $self = shift;
  return if ($_[0] ne $_[2]);
  my $hi = $self->{SETHI}{$_[0]};
  return if (!defined($hi));
  $self->store_push($hi | hex($_[1]));
  delete $self->{SETHI}{$_[0]};
}

sub call(@)
{
  my $self = shift;
  my $prefix = $self->{BASE} . '.call' . $self->{NR_CALL}++;
  Entity::set_num $prefix . '.addr', hex($_[1]);
  $Entity::ENTITY{$prefix . '.name'} = $_[3] if (defined($_[3]));
}

sub alpha_jsr(@)
{
  my $self = shift;
  my $d_reg = shift;
  my $s_reg = shift;
  my $jhint = shift;

  printf "jsr [%x] [%s] [%s]\n", $self->{GP}, $d_reg, $s_reg, $jhint;
}

sub alpha_add_gp(@)
{
  my $self = shift;
  my $increment = shift;

  my $nr = $self->{NR_GP}++;
  Entity::set_num $self->{BASE} . '.inc' . $nr, $increment;
  Entity::set_num $self->{BASE} . '.gp' . $nr, $self->{GP} += $increment;
}

sub disasm($$)
{
  my $self = shift;
  my $ref_line = shift;

  my $arch = $self->{ARCH};
  my $base = $self->{BASE};
  my $r_pattern = $PUSH{$arch} || die;

  for my $line(@$ref_line)
  {
    for(my $i = 0; $i <= $#$r_pattern; $i += 2)
    {
      my $func = $$r_pattern[$i + 1];
      if ($line =~ m/$$r_pattern[$i]/)
      {
        # printf "[%s]\n", $$r_pattern[$i];
	&$func($self, $1, $2, $3, $4);
      }
    }
  }
  return undef;
}
