sub\s results from the CPAN

sub\s

Acme-6502

view release on metacpan or search on metacpan

package Acme::6502;

use warnings FATAL => 'all';
use strict;
use Carp;

our $VERSION = '0.77';

# CPU flags
use constant {
  N => 0x80,
  V => 0x40,
  R => 0x20,
  B => 0x10,
  D => 0x08,
  I => 0x04,
  Z => 0x02,
  C => 0x01
};

use constant FLAGS => 'NVRBDIZC';

# Other CPU constants
use constant {
  STACK => 0x0100,
  BREAK => 0xFFFE
};

# Opcode to thunk into perlspace
use constant {
  ESCAPE_OP  => 0x0B,
  ESCAPE_SIG => 0xAD
};

BEGIN {
    for my $reg ( qw(a x y s p pc) ) {
        no strict 'refs';
        *{ __PACKAGE__ . "\::get_${reg}" } = sub {
            my $self = shift;
            return $self->{ reg }->{ $reg };
        };
        *{ __PACKAGE__ . "\::set_${reg}" } = sub {
            my ( $self, $v ) = @_;
            $self->{ reg }->{ $reg } = $v;
        };
    }
}

sub new {
    my $class = shift;
    my $self  = bless { }, $class;

    $self->_BUILD( @_ );

    return $self;
}

my @OP_CACHE;

sub _BUILD {
    my( $self, $args ) = @_;

    $args ||= {};

    $self->{ mem } = [ ( 0 ) x 65536 ];
    $self->{ reg } = {
        map { $_ => 0 } qw( a x y s p pc )
    };
    $self->{ os } = [ ];
    $self->{ jumptab } = $args->{ jumptab } || 0xFA00;
    $self->{ zn } = [ $self->Z, ( 0 ) x 127, ( $self->N ) x 128 ];

    my $bad_inst = $self->can( '_bad_inst' );

    @OP_CACHE = (
        _inst(    # 00 BRK
          _push( '($pc + 1) >> 8', '($pc + 1)' ),
          _push( '$p | B' ),
          '$p = $p | I | B & ~D;',
          _jmp_i( BREAK )
        ),
        _inst( _ora( _zpix() ) ),      # 01 ORA (zp, x)
        $bad_inst,                     # 02
        $bad_inst,                     # 03
        _inst( _tsb( _zp() ) ),        # 04 TSB zp
        _inst( _ora( _zp() ) ),        # 05 ORA zp
        _inst( _asl( _zp() ) ),        # 06 ASL zp
        $bad_inst,                     # 07
        _inst( _push( '$p | R' ) ),    # 08 PHP
        _inst( _ora( _imm() ) ),       # 09 ORA #imm
        _inst( _asl( _acc() ) ),       # 0A ASL A
        $bad_inst,                     # 0B
        _inst( _tsb( _abs() ) ),       # 0C TSB zp
        _inst( _ora( _abs() ) ),       # 0D ORA abs
        _inst( _asl( _abs() ) ),       # 0E ASL abs
        $bad_inst,                     # 0F BBR0 rel
        _inst( _bfz( _rel(), N ) ),    # 10 BPL rel
        _inst( _ora( _zpiy() ) ),      # 11 ORA (zp), y
        _inst( _ora( _zpi() ) ),       # 12 ORA (zp)
        $bad_inst,                     # 13
        _inst( _trb( _zpi() ) ),       # 14 TRB (zp)
        _inst( _ora( _zpx() ) ),       # 15 ORA zp, x
        _inst( _asl( _zpx() ) ),       # 16 ASL zp, x
        $bad_inst,                     # 17
        _inst( '$p &= ~C;' ),          # 18 CLC
        _inst( _ora( _absy() ) ),      # 19 ORA abs, y
        _inst( _inc( _acc() ) ),       # 1A INC A
        $bad_inst,                     # 1B
        _inst( _trb( _abs() ) ),       # 1C TRB abs
        _inst( _ora( _absx() ) ),      # 1D ORA abs, x
        _inst( _asl( _absx() ) ),      # 1E ASL abs, x
        $bad_inst,                     # 1F BBR1 rel
        _inst(                         # 20 JSR
          _push( '($pc + 1) >> 8', '($pc + 1)' ),
          _jmp()
        ),
        _inst( _and( _zpix() ) ),      # 21 AND (zp, x)
        $bad_inst,                     # 22
        $bad_inst,                     # 23
        _inst( _bit( _zp() ) ),        # 24 BIT zp

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

        $bad_inst,                                 # CB
        _inst( _cmp( _abs(), '$y' ) ),             # CC CPY abs
        _inst( _cmp( _abs(), '$a' ) ),             # CD CMP abs
        _inst( _dec( _abs() ) ),                   # CE DEC abs
        $bad_inst,                                 # CF BBS4 rel
        _inst( _bfz( _rel(), Z ) ),                # D0 BNE rel
        _inst( _cmp( _zpiy(), '$a' ) ),            # D1 CMP (zp), y
        _inst( _cmp( _zpi(),  '$a' ) ),            # D2 CMP (zp)
        $bad_inst,                                 # D3
        $bad_inst,                                 # D4
        _inst( _cmp( _zpx(), '$a' ) ),             # D5 CMP zp, x
        _inst( _dec( _zpx() ) ),                   # D6 DEC zp, x
        $bad_inst,                                 # D7
        _inst( '$p &= ~D;' ),                      # D8 CLD
        _inst( _cmp( _absy(), '$a' ) ),            # D9 CMP abs, y
        _inst( _push( '$x' ) ),                    # DA PHX
        $bad_inst,                                 # DB
        $bad_inst,                                 # DC
        _inst( _cmp( _absx(), '$a' ) ),            # DD CMP abs, x
        _inst( _dec( _absx() ) ),                  # DE DEC abs, x
        $bad_inst,                                 # DF BBS5 rel
        _inst( _cmp( _imm(), '$x' ) ),             # E0 CPX  #imm
        _inst( _sbc( _zpix(), '$a' ) ),            # E1 SBC (zp, x)
        $bad_inst,                                 # E2
        $bad_inst,                                 # E3
        _inst( _cmp( _zp(), '$x' ) ),              # E4 CPX zp
        _inst( _sbc( _zp() ) ),                    # E5 SBC zp
        _inst( _inc( _zp() ) ),                    # E6 INC zp
        $bad_inst,                                 # E7
        _inst( _inc( ( '', '$x' ) ) ),             # E8 INX
        _inst( _sbc( _imm() ) ),                   # E9 SBC  #imm
        _inst(),                                   # EA NOP
        $bad_inst,                                 # EB
        _inst( _cmp( _abs(), '$x' ) ),             # EC CPX abs
        _inst( _sbc( _abs() ) ),                   # ED SBC abs
        _inst( _inc( _abs() ) ),                   # EE INC abs
        $bad_inst,                                 # EF BBS6 rel
        _inst( _bfnz( _rel(), Z ) ),               # F0 BEQ rel
        _inst( _sbc( _zpiy() ) ),                  # F1 SBC (zp), y
        _inst( _sbc( _zpi() ) ),                   # F2 SBC (zp)
        $bad_inst,                                 # F3
        $bad_inst,                                 # F4
        _inst( _sbc( _zpx() ) ),                   # F5 SBC zp, x
        _inst( _inc( _zpx() ) ),                   # F6 INC zp, x
        $bad_inst,                                 # F7
        _inst( '$p |= D;' ),                       # F8 SED
        _inst( _sbc( _absy() ) ),                  # F9 SBC abs, y
        _inst( _pop( '$x' ), _status( '$x' ) ),    # FA PLX
        $bad_inst,                                 # FB
        $bad_inst,                                 # FC
        _inst( _sbc( _absx() ) ),                  # FD SBC abs, x
        _inst( _inc( _absx() ) ),                  # FE INC abs, x
        $bad_inst,                                 # FF BBS7 rel
    ) if !@OP_CACHE;
    $self->{ ops } = [ @OP_CACHE ];

    confess "Escape handler opcode not available"
       unless $self->{ ops }->[ ESCAPE_OP ] == $bad_inst;

    # Patch in the OS escape op handler
    $self->{ ops }->[ ESCAPE_OP ] = sub {
        my $self = shift;
        if ( $self->{ mem }->[ $self->{ reg }->{ pc } ] != ESCAPE_SIG ) {
            $bad_inst->( $self );
        }
        else {
            $self->{ reg }->{ pc } += 2;
            $self->call_os( $self->{ mem }->[ $self->{ reg }->{ pc } - 1 ] );
        }
    };
}

sub set_jumptab {
    my $self = shift;
    $self->{ jumptab } = shift;
}

sub get_state {
    my $self = shift;
    return @{ $self->{ reg } }{ qw( a x y s p pc ) };
}

sub get_xy {
    my $self = shift;
    return $self->get_x || ( $self->get_y << 8 );
}

sub set_xy {
    my $self = shift;
    my $v = shift;
    $self->set_x( $v & 0xFF );
    $self->set_y( ( $v >> 8 ) & 0xFF );
}

sub read_str {
    my $self = shift;
    my $addr = shift;
    my $str  = '';

    while ( $self->{ mem }->[ $addr ] != 0x0D ) {
        $str .= chr( $self->{ mem }->[ $addr++ ] );
    }

    return $str;
}

sub read_chunk {
    my $self = shift;
    my ( $from, $to ) = @_;

    return pack( 'C*', @{ $self->{ mem } }[ $from .. $to - 1 ] );
}

sub write_chunk {
    my $self = shift;
    my ( $addr, $chunk ) = @_;

    my $len = length( $chunk );
    splice @{ $self->{ mem } }, $addr, $len, unpack( 'C*', $chunk );
}

sub read_8 {
    my $self = shift;
    my $addr = shift;

    return $self->{ mem }->[ $addr ];
}

sub write_8 {
    my $self = shift;
    my( $addr, $val ) = @_;

    $self->{ mem }->[ $addr ] = $val;
}

sub read_16 {
    my $self = shift;
    my $addr = shift;

    return $self->{ mem }->[ $addr ] | ( $self->{ mem }->[ $addr + 1 ] << 8 );
}

sub write_16 {
    my $self = shift;
    my( $addr, $val ) = @_;

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

sub read_32 {
    my $self = shift;
    my $addr = shift;

    return $self->{ mem }->[ $addr ]
        | ( $self->{ mem }->[ $addr + 1 ] << 8 )
        | ( $self->{ mem }->[ $addr + 2 ] << 16 )
        | ( $self->{ mem }->[ $addr + 3 ] << 32 );
}

sub write_32 {
    my $self = shift;
    my( $addr, $val ) = @_;

    $self->{ mem }->[ $addr ] = $val & 0xFF;
    $self->{ mem }->[ $addr + 1 ] = ( $val >> 8 ) & 0xFF;
    $self->{ mem }->[ $addr + 2 ] = ( $val >> 16 ) & 0xFF;
    $self->{ mem }->[ $addr + 3 ] = ( $val >> 24 ) & 0xFF;
}

sub poke_code {
    my $self = shift;
    my $addr = shift;

    $self->{ mem }->[ $addr++ ] = $_ for @_;
}

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",
    '$mem[$ea]'
  );
}

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

sub _zp {
  return ( 'my $ea = $mem[$pc++];' . "\n", '$mem[$ea]' );
}

sub _zpx {
  return ( 'my $ea = ($mem[$pc++] + $x) & 0xFF;' . "\n", '$mem[$ea]' );
}

sub _zpy {
  return ( 'my $ea = ($mem[$pc++] + $y) & 0xFF;' . "\n", '$mem[$ea]' );
}

sub _abs {
  return ( 'my $ea = $mem[$pc] | ($mem[$pc+1] << 8); $pc += 2;' . "\n",
    '$mem[$ea]' );
}

sub _absx {
  return (
    'my $ea = ($mem[$pc] | ($mem[$pc+1] << 8)) + $x; $pc += 2;' . "\n",
    '$mem[$ea]'
  );
}

sub _absy {
  return (
    'my $ea = ($mem[$pc] | ($mem[$pc+1] << 8)) + $y; $pc += 2;' . "\n",
    '$mem[$ea]'
  );
}

sub _imm {
  return ( 'my $v = $mem[$pc++];' . "\n", '$v' );
}

sub _acc {
  return ( '', '$a' );
}

sub _rel {
  # Doesn't return an lvalue
  return ( 'my $t = $mem[$pc++];' . "\n",
    '($pc + $t - (($t & 0x80) ? 0x100 : 0))' );
}

sub _status {
  my $reg = shift || '$a';
  return '$p = ($p & ~(N | Z) | $zn[' . $reg . ']);' . "\n";
}

sub _ora {
  return $_[0] . '$a |= ' . $_[1] . ";\n" . _status();
}

sub _and {
  return $_[0] . '$a &= ' . $_[1] . ";\n" . _status();
}

sub _eor {
  return $_[0] . '$a ^= ' . $_[1] . ";\n" . _status();
}

sub _bit {
  return
     $_[0]
   . '$p = ($p & ~(N|V)) | ('
   . $_[1]
   . ' & (N|V));' . "\n"
   . 'if (($a & '
   . $_[1]
   . ') == 0) { $p |= Z; } else { $p &= ~Z; }' . "\n";
}

sub _asl {
  return
     $_[0]
   . 'my $w = ('
   . $_[1]
   . ') << 1; ' . "\n"
   . 'if ($w & 0x100) { $p |= C; $w &= ~0x100; } else { $p &= ~C; }'
   . "\n"
   . _status( '$w' )
   . $_[1]
   . ' = $w;' . "\n";
}

sub _lsr {
  return
     $_[0]
   . 'my $w = '
   . $_[1] . ";\n"
   . 'if (($w & 1) != 0) { $p |= C; } else { $p &= ~C; }' . "\n"
   . '$w >>= 1;' . "\n"
   . _status( '$w' )
   . $_[1]
   . ' = $w;' . "\n";
}

sub _rol {
  return
     $_[0]
   . 'my $w = ('
   . $_[1]
   . ' << 1) | ($p & C);' . "\n"
   . 'if ($w >= 0x100) { $p |= C; $w -= 0x100; } else { $p &= ~C; };'
   . "\n"
   . _status( '$w' )
   . $_[1]
   . ' = $w;' . "\n";
}

sub _ror {
  return
     $_[0]
   . 'my $w = '
   . $_[1]
   . ' | (($p & C) << 8);' . "\n"
   . 'if (($w & 1) != 0) { $p |= C; } else { $p &= ~C; }' . "\n"
   . '$w >>= 1;' . "\n"
   . _status( '$w' )
   . $_[1]
   . ' = $w;' . "\n";
}

sub _sto {
  return $_[0] . "$_[1] = $_[2];\n";
}

sub _lod {
  return $_[0] . "$_[2] = $_[1];\n" . _status( $_[2] );
}

sub _cmp {
  return
     $_[0]
   . 'my $w = '
   . $_[2] . ' - '
   . $_[1] . ";\n"
   . 'if ($w < 0) { $w += 0x100; $p &= ~C; } else { $p |= C; }' . "\n"
   . _status( '$w' );
}

sub _tsb {
  return 'croak "TSB not supported\n";' . "\n";
}

sub _trb {
  return 'croak "TRB not supported\n";' . "\n";
}

sub _inc {
  return
     $_[0]
   . $_[1] . ' = ('
   . $_[1]
   . ' + 1) & 0xFF;' . "\n"
   . _status( $_[1] );
}

sub _dec {
  return
     $_[0]
   . $_[1] . ' = ('
   . $_[1]
   . ' + 0xFF) & 0xFF;' . "\n"
   . _status( $_[1] );
}

sub _adc {
  return
     $_[0]
   . 'my $w = '
   . $_[1] . ";\n"
   . 'if ($p & D) {' . "\n"
   . 'my $lo = ($a & 0x0F) + ($w & 0x0F) + ($p & C);' . "\n"
   . 'if ($lo > 9) { $lo += 6; }' . "\n"
   . 'my $hi = ($a >> 4) + ( $w >> 4) + ($lo > 15 ? 1 : 0);' . "\n"
   . '$a = ($lo & 0x0F) | ($hi << 4);' . "\n"
   . '$p = ($p & ~C) | ($hi > 15 ? C : 0);' . "\n"
   . '} else {' . "\n"
   . 'my $lo = $a + $w + ($p & C);' . "\n"
   . '$p &= ~(N | V | Z | C);' . "\n"
   . '$p |= (~($a ^ $w) & ($a ^ $lo) & 0x80 ? V : 0) | ($lo & 0x100 ? C : 0);'
   . "\n"
   . '$a = $lo & 0xFF;' . "\n"
   . _status() . '}' . "\n";
}

sub _sbc {
  return
     $_[0]
   . 'my $w = '
   . $_[1] . ";\n"
   . 'if ($p & D) {' . "\n"
   . 'my $lo = ($a & 0x0F) - ($w & 0x0F) - (~$p & C);' . "\n"
   . 'if ($lo & 0x10) { $lo -= 6; }' . "\n"
   . 'my $hi = ($a >> 4) - ($w >> 4) - (($lo & 0x10) >> 4);' . "\n"
   . 'if ($hi & 0x10) { $hi -= 6; }' . "\n"
   . '$a = ($lo & 0x0F) | ($hi << 4);' . "\n"
   . '$p = ($p & ~C) | ($hi > 15 ? 0 : C);' . "\n"
   . '} else {' . "\n"
   . 'my $lo = $a - $w - (~$p & C);' . "\n"
   . '$p &= ~(N | V | Z | C);' . "\n"
   . '$p |= (($a ^ $w) & ($a ^ $lo) & 0x80 ? V : 0) | ($lo & 0x100 ? 0 : C);'
   . "\n"
   . '$a = $lo & 0xFF;' . "\n"
   . _status() . '}' . "\n";
}

sub _bra {
  return $_[0] . '$pc = ' . $_[1] . ";\n";
}

sub _bfz {
  return
     $_[0]
   . 'if (($p & '
   . $_[2]
   . ') == 0) { $pc = '
   . $_[1] . '; }' . "\n";
}

sub _bfnz {
  return
     $_[0]
   . 'if (($p & '
   . $_[2]
   . ') != 0) { $pc = '
   . $_[1] . '; }' . "\n";
}

sub _jmp_i {
  my $a = shift;
  return '$pc = $mem[' . $a . '] | ($mem[' . $a . ' + 1] << 8);' . "\n";
}

sub _jmp_i_bug {
  my $a = shift;

  # this should emulate a page boundary bug:
  # JMP 0x80FF fetches from 0x80FF and 0x8000
  # instead of 0x80FF and 0x8100
  my $b = "($a & 0xFF00) | (($a + 1) & 0xFF)";
  return '$pc = $mem[' . $a . '] | ($mem[' . $b . '] << 8);' . "\n";
}

sub _jmp {
  return _jmp_i( '$pc' );
}

sub _jmpi {
  return 'my $w = $mem[$pc] | ($mem[$pc + 1] << 8); '
   . _jmp_i_bug( '$w' );
}

sub _jmpix {
  return 'my $w = ($mem[$pc] | ($mem[$pc + 1] << 8)) + $x; '
   . _jmp_i( '$w' );
}

sub _rti {
  return
     _pop( '$p' )
   . '$p |= R;'
   . 'my ($lo, $hi); '
   . _pop( '$lo' )
   . _pop( '$hi' )
   . '$pc = $lo | ($hi << 8);' . "\n";
}

sub _rts {
  return
     'my ($lo, $hi); '
   . _pop( '$lo' )
   . _pop( '$hi' )
   . '$pc = ($lo | ($hi << 8)) + 1;' . "\n";
}

1;
__END__

=head1 NAME

Acme::6502 - Pure Perl 65C02 simulator.

=head1 VERSION

This document describes Acme::6502 version 0.76

=head1 SYNOPSIS

    use Acme::6502;
    
    my $cpu = Acme::6502->new();
    
    # Set start address
    $cpu->set_pc(0x8000);
    
    # Load ROM image
    $cpu->load_rom('myrom.rom', 0x8000);
    
    # Run for 1,000,000 instructions then return
    $cpu->run(1_000_000);
  
=head1 DESCRIPTION

Imagine the nightmare scenario: your boss tells you about a legacy
system you have to support. How bad could it be? COBOL? Fortran? Worse:
it's an embedded 6502 system run by a family of squirrels (see Dilberts
passim). Fortunately there's a pure Perl 6502 emulator that works so
well the squirrels will never know the difference.

=head1 INTERFACE 

=over

=item C<new>

Create a new 6502 CPU.

=item C<call_os( $vec_number )>

Subclass to provide OS entry points. OS vectors are installed by calling
C<make_vector>. When the vector is called C<call_os()> will be called
with the vector number.

=item C<get_a()>

Read the current value of the processor A register (accumulator).

=item C<get_p()>

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


Set the value of the X index register.

=item C<set_y( $value )>

Set the value of the Y index register.

=item C<set_xy( $value )>

Set the value of the X and Y registers to the specified sixteen bit
number. X gets the lower 8 bits, Y gets the upper 8 bits.

=item C<set_jumptab( $addr )>

Set the address of the block of memory that will be used to hold the
thunk blocks that correspond with vectored OS entry points. Each thunk
takes four bytes.

=item C<load_rom( $filename, $addr )>

Load a ROM image at the specified address.

=item C<make_vector( $jmp_addr, $vec_addr, $vec_number )>

Make a vectored entry point for an emulated OS. C<$jmp_addr> is the
address where an indirect JMP instruction (6C) will be placed,
C<$vec_addr> is the address of the vector and C<$vec_number> will be
passed to C<call_os> when the OS call is made.

=item C<poke_code( $addr, @bytes )>

Poke code directly at the specified address.

=item C<read_8( $addr )>

Read a byte at the specified address.

=item C<read_16( $addr )>

Read a sixteen bit (low, high) word at the specified address.

=item C<read_32( $addr )>

Read a 32 bit word at the specified address.

=item C<read_chunk( $start, $end )>

Read a chunk of data from C<$start> to C<$end> - 1 into a string.

=item C<read_str( $addr )>

Read a carriage return terminated (0x0D) string from the
specified address.

=item C<run( $count [, $callback ] )>

Execute the specified number of instructions and return. Optionally a
callback may be provided in which case it will be called before each
instruction is executed:

    my $cb = sub {
        my ($pc, $inst, $a, $x, $y, $s, $p) = @_;
        # Maybe output trace info
    }
    
    $cpu->run(100, $cb);

=item C<write_8( $addr, $value )>

Write the byte at the specified address.

=item C<write_16( $addr, $value )>

Write a sixteen bit (low, high) value at the specified address.

=item C<write_32( $addr, $value )>

Write a 32 bit value at the specified address.

=item C<write_chunk( $addr, $string )>

Write a chunk of data to memory.

=back

=head1 DIAGNOSTICS

=over

=item C<< Bad instruction at %s (%s) >>

The emulator hit an illegal 6502 instruction.

=back

=head1 CONFIGURATION AND ENVIRONMENT

Acme::6502 requires no configuration files or environment variables.

=head1 DEPENDENCIES

None.

=head1 INCOMPATIBILITIES

None reported.

=head1 BUGS AND LIMITATIONS

Doesn't have support for hardware emulation hooks - so memory mapped I/O
is out of the question until someone fixes it.

Please report any bugs or feature requests to
C<bug-acme-6502@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org>.

=head1 AUTHOR

Andy Armstrong  C<< <andy@hexten.net> >>

Brian Cassidy C<< <bricas@cpan.org> >>

( run in 0.880 second using v1.01-cache-2.11-cpan-8f98c5d2c55 )