CPU::Emulator::6502 - Class representing a 6502 CPU

package CPU::Emulator::6502;

use strict;
use warnings;

use base qw( Class::Accessor::Fast );

use Text::SimpleTable;
use CPU::Emulator::6502::Addressing;
use Module::Pluggable::Object;

# status constants
use constant SET_CARRY     => 0x01;
use constant SET_ZERO      => 0x02;
use constant SET_INTERRUPT => 0x04;
use constant SET_DECIMAL   => 0x08;
use constant SET_BRK       => 0x10;
use constant SET_UNUSED    => 0x20;
use constant SET_OVERFLOW  => 0x40;
use constant SET_SIGN      => 0x80;

use constant CLEAR_CARRY     => 0xFE;
use constant CLEAR_ZERO      => 0xFD;
use constant CLEAR_INTERRUPT => 0xFB;
use constant CLEAR_DECIMAL   => 0xF7;
use constant CLEAR_BRK       => 0xEF;
use constant CLEAR_UNUSED    => 0xDF;
use constant CLEAR_OVERFLOW  => 0xBF;
use constant CLEAR_SIGN      => 0x7F;

use constant CLEAR_SZC  => CLEAR_SIGN & CLEAR_ZERO & CLEAR_CARRY;
use constant CLEAR_SOZ  => CLEAR_SIGN & CLEAR_OVERFLOW & CLEAR_ZERO;
use constant CLEAR_ZS   => CLEAR_ZERO & CLEAR_SIGN;
use constant CLEAR_ZOCS => CLEAR_ZERO & CLEAR_OVERFLOW & CLEAR_CARRY & CLEAR_SIGN;

# interrupt constants
use constant BRK    => 0x01;
use constant IRQ    => 0x02;
use constant NMI    => 0x04;
use constant RESET  => 0x08;
use constant APUIRQ => 0x10;

__PACKAGE__->mk_accessors(
    qw( registers memory interrupt_line toggle
    frame_counter cycle_counter instruction_table
    current_op current_op_address
    )
);

my @registers = qw( acc x y pc sp status );

sub new {
    my $class = shift;
    my $self = $class->SUPER::new( @_ );

    $self->registers( {
        map { $_ => undef } @registers
    } );
    $self->interrupt_line( 0 );
    $self->cycle_counter( 0 );

    return $self;
}

sub init {
    my $self = shift;
    my $reg = $self->registers;

    $self->memory( [ ( undef ) x 0xFF ] );
    for( @registers ) {
        $reg->{ $_ } =  0;
    }

    $reg->{ status } = SET_UNUSED;
    $self->create_instruction_table;
}

sub create_instruction_table {
    my $self  = shift;
    my %table;

    my $class = __PACKAGE__ . '::Op';
    my $locator = Module::Pluggable::Object->new(
        search_path => $class,
        require     => 1
    );
    
    for my $instruction ( $locator->plugins ) {
        my $ops = $instruction->INSTRUCTIONS;
        ( my $name = $instruction ) =~ s{$class\::}{};
        @table{ keys %$ops } = map { $_->{ name } = $name; $_ } values %$ops;
    }

    $self->instruction_table( \%table );
}

sub reset {
    my $self = shift;
    
}

sub RAM_read {
    my $self = shift;
    return $self->memory->[ shift ];
}

sub RAM_write {
    my $self = shift;
    $self->memory->[ shift ] = shift;
}

sub interrupt_request {
    my $self = shift;
    my $mem  = $self->memory;
    my $reg  = $self->registers;
    my $pc   = $reg->{ pc };
    my $int  = $self->interrupt_line;

    $self->push_stack( $self->hi_byte( $pc + 2 ) );
    $self->push_stack( $self->lo_byte( $pc + 2 ) );
    $self->push_stack( $reg->{ status } );

    if( $int == IRQ ) {
        $reg->{ pc } = $self->make_word( $mem->[ 0xFFFE ], $mem->[ 0xFFFF ] );
    }
    elsif( $int == NMI ) {
        $reg->{ pc } = $self->make_word( $mem->[ 0xFFFA ], $mem->[ 0xFFFB ] );
    }

    $self->interrupt_line( 0 );
    $self->cycle_counter( $self->cycle_counter + 7 );
}

sub execute_instruction {
    my $self = shift;
    my $reg = $self->registers;

    if ( $self->interrupt_line ) {
        if( $reg->{ status } & SET_INTERRUPT ) {
            if( $self->interrupt_line & NMI ) {
                $self->interrupt_line( NMI );
                $self->interrupt_request;
            }
        }
        else {
            $self->interrupt_request;
        }
    }

    my $op = $self->get_instruction;
    my $table = $self->instruction_table;
    my $mode;

    $mode = $table->{ $op }->{ addressing } if $table->{ $op };

    my @args;
    if( $mode and my $sub = CPU::Emulator::6502::Addressing->can( $mode ) ) {
        @args = $sub->( $self );
    }

    if( !$table->{ $op } ) {
        $self->cycle_counter( $self->cycle_counter + 2 );
    }
    else {
        no strict 'refs';
        $table->{ $op }->{ code }->( $self, @args );
        $self->cycle_counter( $self->cycle_counter + $table->{ $op }->{ cycles } );
    }

}

sub get_instruction {
    my $self = shift;
    my $reg  = $self->registers;
    
    $self->current_op_address( $reg->{ pc } );
    my $op = $self->RAM_read( $reg->{ pc }++ );
    return $self->current_op( $op );
}

sub debug { 
    my $self = shift;
    my $reg = $self->registers;

    my $t = Text::SimpleTable->new(
        [ 4, 'PC' ], [ 4, 'OP' ], [ 4, 'SP' ], [ 2, 'A' ], [ 2, 'X' ], [ 2, 'Y' ], [ 8, 'Status' ],
    );

    my $status = $reg->{ status };
    my $a_status = '';
    $a_status .= $status & SET_SIGN ? 'N' : '.';
    $a_status .= $status & SET_OVERFLOW ? 'V' : '.';
    $a_status .= $status & SET_UNUSED ? '-' : '.';
    $a_status .= $status & SET_BRK ? 'B' : '.';
    $a_status .= $status & SET_DECIMAL ? 'D' : '.';
    $a_status .= $status & SET_INTERRUPT ? 'I' : '.';
    $a_status .= $status & SET_ZERO ? 'Z' : '.';
    $a_status .= $status & SET_CARRY ? 'C' : '.';

    my $addr = $self->current_op_address;
    $t->row(
        $addr ? sprintf( '%x', $addr ) : '-',
        defined $self->current_op ? sprintf( '%s', $self->instruction_table->{ $self->current_op }->{ name } ) : '-',
        ( map { sprintf( '%x', $reg->{ $_ } ) } qw( sp acc x y ) ),
        $a_status,
    );

    my $t_stack = Text::SimpleTable->new(
        [ 5,  'Stack' ]
    );

    my $t_code = Text::SimpleTable->new(
        [ 4, 'Addr' ], [ 27,  'Code' ]
    );

    for( 0..9 ) {
        $t_stack->row( sprintf( '%x', $self->memory->[ 0x1FF - $_ ] ) );
        if( $addr ) {
            my $line = $addr + $_;
            $t_code->row( sprintf( '%x', $line ), sprintf( '%x', $self->memory->[ $line ] ) );
        }
        else {
            $t_code->row( '-', '-' );
        }
    }

    my @s_rows = split( "\n", $t_stack->draw );
    my @c_rows = split( "\n", $t_code->draw );
    my $output = '';

    while( @s_rows ) {
        $output .= join( ' ', shift( @s_rows ), shift( @c_rows ) );
        $output .= "\n";
    }
    

    return $t->draw . $output;
}

sub set_nz {
    my $self = shift;
    my $value = shift;
    my $reg = $self->registers;

    $reg->{ status } &= CLEAR_ZS;

    if( $value & 0x80 ) {
        $reg->{ status } |= SET_SIGN;
    }
    elsif( $value == 0 ) {
        $reg->{ status } |= SET_ZERO;
    }
}

sub push_stack {
    my $self = shift;
    my $value = shift;
    my $reg  = $self->registers;

    $self->memory->[ $reg->{ sp } + 0x100 ] = $value;
    $reg->{ sp }--;
}

sub pop_stack {
    my $self = shift;
    my $reg  = $self->registers;

    $reg->{ sp }++;
    my $value = $self->memory->[ $reg->{ sp } + 0x100 ];
    return $value;
}

sub branch_if {
    my $self = shift;
    my $reg  = $self->registers;

    $reg->{ pc }++;

    # branch or not
    return if !shift;

    my $old_pc = $reg->{ pc } - 2;
    # address to branch to
    my $data = $self->memory->[ $reg->{ pc } - 1 ];

    if( $data & 0x80 ) {
        $reg->{ pc } -= ( 128 - ( $data & 0x7f ) );
    }
    else {
        $reg->{ pc } += $data;
    }

    # same mem page, add 1 cycles
    if( ( $reg->{ pc } & 0xff00 ) == ( $old_pc & 0xff00 ) ) {
        $self->cycle_counter( $self->cycle_counter + 1 );
    }
    # cross-page, add 2 cycles
    else {
        $self->cycle_counter( $self->cycle_counter + 2 );
    }
}

sub make_word {
    my ( $self, $lo, $hi ) = @_;
    return $lo | ( $hi << 8 );
}

sub lo_byte {
    my( $self, $word ) = @_;
    return $word & 0xff;
}

sub hi_byte {
    my( $self, $word ) = @_;
    return ($word & 0xff00) >> 8;
}

1;