view release on metacpan or  search on metacpan

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

    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 {