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 @ALPHA = ();
my @I386 = (
  '\bpush\s+(\$0x|dword\s+)' . $HEXNUM,
  sub { store_push($_[0], hex($_[2])); }
);
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
);
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;

  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 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)
  {
    if ($line =~ m/$CALL/)
    {
      my $prefix = $base . '.call' . $self->{NR_CALL}++;
      Entity::set_num $prefix . '.addr', hex($2);
      $Entity::ENTITY{$prefix . '.name'} = $4 if (defined($4));
    }
    for(my $i = 0; $i <= $#$r_pattern; $i += 2)
    {
      my $func = $$r_pattern[$i + 1];
      &$func($self, $1, $2, $3)
      if ($line =~ m/$$r_pattern[$i]/);
    }
  }
  return undef;
}
