view release on metacpan or  search on metacpan

lib/Acme/6502.pm  view on Meta::CPAN

sub load_rom {
    my $self = shift;
    my ( $f, $a ) = @_;

    open my $fh, '<', $f or croak "Can't read $f ($!)\n";
    binmode $fh;
    my $sz = -s $fh;
    sysread $fh, my $buf, $sz or croak "Error reading $f ($!)\n";
    close $fh;

    $self->write_chunk( $a, $buf );
}

sub call_os {
  croak "call_os() not supported";
}

sub run {
    my $self = shift;
    my $ic = shift;
    my $cb = shift;

    while ( $ic-- > 0 ) {
        my( $a, $x, $y, $s, $p, $pc ) = $self->get_state;
        $cb->( $pc, $self->{ mem }->[ $pc ], $a, $x, $y, $s, $p ) if defined $cb;
        $self->set_pc( $pc + 1 );
        $self->{ ops }->[ $self->{ mem }->[ $pc ] ]->( $self );
    }
}

sub make_vector {
    my $self = shift;
    my ( $call, $vec, $func ) = @_;

    $self->{ mem }->[ $call ] = 0x6C;                   # JMP (indirect)
    $self->{ mem }->[ $call + 1 ] = $vec & 0xFF;
    $self->{ mem }->[ $call + 2 ] = ( $vec >> 8 ) & 0xFF;

    my $jumptab = $self->{ jumptab };
    my $addr    = $jumptab;
    $self->{ mem }->[ $jumptab++ ] = ESCAPE_OP;
    $self->{ mem }->[ $jumptab++ ] = ESCAPE_SIG;
    $self->{ mem }->[ $jumptab++ ] = $func;
    $self->{ mem }->[ $jumptab++ ] = 0x60;

    $self->set_jumptab( $jumptab );

    $self->{ mem }->[ $vec ] = $addr & 0xFF;
    $self->{ mem }->[ $vec + 1 ] = ( $addr >> 8 ) & 0xFF;
}

sub _inst {
    my $src = join( "\n", @_ );

    # registers
    $src    =~ s{\$(a|x|y|s|p|pc)\b}{\$self->{reg}->{$1}}g;

    # memory and zn access
    $src    =~ s{\$(mem|zn)\[}{\$self->{$1}->[}g;

    my $cr  = eval "sub { my \$self=shift; ${src} }";
    confess "$@" if $@;
    return $cr;
}

sub _bad_inst {
    my $self = shift;
    my $pc   = $self->get_pc;

    croak sprintf( "Bad instruction at &%04x (&%02x)\n",
      $pc - 1, $self->{ mem }->[ $pc - 1 ] );
}

# Functions that generate code fragments
sub _set_nz {
  return
     '$p &= ~(N|Z);' . 'if( '
   . $_[0]
   . ' & 0x80){ $p |= N }'
   . 'elsif( '
   . $_[0]
   . ' == 0 ){ $p |= Z }';
}

sub _push {
  my $r = '';
  for ( @_ ) {
    $r
     .= '$mem[STACK + $s] = (' 
     . $_
     . ') & 0xFF; $s = ($s - 1) & 0xFF;' . "\n";
  }
  return $r;
}

sub _pop {
  my $r = '';
  for ( @_ ) {
    $r .= '$s = ($s + 1) & 0xFF; ' . $_ . ' = $mem[STACK + $s];' . "\n";
  }
  return $r;
}

sub _pop_p {
  return '$s = ($s + 1) & 0xFF; $p = $mem[STACK + $s] | R; $p &= ~B;'
   . "\n";
}

# Addressing modes return a list containing setup code, lvalue
sub _zpix {
  return (
    'my $ea = $mem[$pc++] + $x; '
     . '$ea = $mem[$ea & 0xFF] | ($mem[($ea + 1) & 0xFF] << 8)' . ";\n",
    '$mem[$ea]'
  );
}

sub _zpi {
  return (
    'my $ea = $mem[$pc++]; '
     . '$ea = $mem[$ea & 0xFF] | ($mem[($ea + 1) & 0xFF] << 8)' . ";\n",