File Coverage

blib/lib/Games/Rezrov/ZInterpreter.pm

Criterion	Covered	Total	%
statement	118	159	74.2
branch	48	76	63.1
condition	5	16	31.2
subroutine	16	17	94.1
pod	0	5	0.0
total	187	273	68.5

package Games::Rezrov::ZInterpreter;
# interpret z-code

use strict;
no strict "refs";
# maybe a little faster here than during opcode call?

use Games::Rezrov::Inliner;

use constant OP_UNKNOWN => -1;
use constant OP_0OP => 0;
use constant OP_1OP => 1;
use constant OP_2OP => 2;
use constant OP_VAR => 3;
use constant OP_EXT => 4;

use constant CALL_VN2 => 0x1a;
use constant CALL_VS2 => 0x0c;
# var opcodes

my $INTERPRETER_GENERATED = 0;

sub new {
  my ($type, $zio) = @_;
  my $self = {};
  bless $self, $type;

  generate_interpreter_code();
  # delay code generation until now so we can add optional code
  # (or not include it) based on runtime options

  $self->zio($zio);

  if (my $where = Games::Rezrov::ZOptions::WRITE_OPCODES()) {
    if ($where eq "STDERR") {
      *Games::Rezrov::ZInterpreter::LOG = \*main::STDERR;
    } else {
      die "Can't write to $where: $!\n"
	unless open(LOG, ">$where");
    }
    my $old = select();
    select LOG;
    $|=1;
    select $old;
  }

  $self->restart(1);
  $self->interpret();
  return $self;
}

sub generate_interpreter_code {
  unless ($INTERPRETER_GENERATED) {
    # Generate code for main interpreter routine.
    # add optional chunks of code only if they're being used, to
    # make the loops as tight as possible.  Good for a small
    # speed improvement.

    local $/ = undef;
    my $inline_code = ;

    my $CODE;

    if (Games::Rezrov::ZOptions::WRITE_OPCODES()) {
      $CODE = '
      printf LOG "count:%d style:%d pc:%d type:%s opcode:%d(0x%02x;raw=%d) (%s) operands:%s\n",
      $opcode_count,
      $op_style,
      $start_pc,
      $TYPE_LABELS[$op_style],
      $opcode,
      $opcode,
      $orig_opcode,
      ($generic_opcodes[$op_style]->[$opcode] ||
       $manual_descs[$op_style]->[$opcode] || "???"),
      join(",", @operands);
';

     $inline_code =~ s/#WRITE_OPCODES_STUB/$CODE/ || die;
    }

    if (Games::Rezrov::ZOptions::COUNT_OPCODES()) {
      $CODE='
$op_counts[$op_style]++;
';
     $inline_code =~ s/#COUNT_OPCODES_STUB/$CODE/ || die;
    }

    Games::Rezrov::Inliner::inline(\$inline_code);

#    print $inline_code;die;

    eval $inline_code;

    $INTERPRETER_GENERATED = 1;
  }
}

sub zio {
  return (defined $_[1] ? $_[0]->{"zio"} = $_[1] : $_[0]->{"zio"});
}

sub restart {
  my ($self, $first_time) = @_;
  Games::Rezrov::StoryFile::reset_storyfile() unless $first_time;
  Games::Rezrov::StoryFile::reset_game();
}

1;

#
#  code to be inlined starts here:
#
__DATA__