M6502/t/05-M6502.t

#!/usr/bin/perl

use warnings;
use strict;

use blib;
use lib './lib';

use Test::More tests => 192;
use Test::Exception;
use Data::Dump qw/dump/;

BEGIN {
use_ok( 'M6502' );
}

cmp_ok( $debug, '==', 0, '$debug' );
cmp_ok( M6502::get_debug(), '==', 0, 'M6502::get_debug' );
cmp_ok( M6502->debug, '==', 0, 'M6502->debug' );

cmp_ok( M6502::set_debug( 1 ), '==', 1, 'M6502::set_debug');
cmp_ok( M6502::get_debug(), '==', 1, 'M6502::get_debug');
cmp_ok( $debug, '==', 0, '$debug still wrong');

cmp_ok( M6502->debug(1), '==', 1, 'M6502->debug(1)' );
cmp_ok( $debug, '==', 1, '$debug on' );
cmp_ok( M6502::get_debug(), '==', 1, 'get_debug on' );
cmp_ok( M6502->debug, '==', 1, 'M6502->debug on' );

cmp_ok( M6502->debug(0), '==', 0, 'M6502->debug(0)' );
cmp_ok( $debug, '==', 0, '$debug off' );
cmp_ok( M6502::get_debug(), '==', 0, 'get_debug off' );
cmp_ok( M6502->debug, '==', 0, 'M6502->debug off' );

M6502->debug( 1 ) if @ARGV;

diag "debug: $debug";

cmp_ok( $PC, '==', 0xbeef, 'PC' );

ok( M6502::reset(), 'reset' );

cmp_ok( $PC, '==', 0xffff, 'PC' );

diag dump_R();

$PC = 0xdead;

M6502::update_C_R();

$PC = 0xffff;

M6502::update_perl_R();

cmp_ok( $PC, '==', 0xdead, 'PC' );

ok( M6502::reset(), 'reset again' );

cmp_ok( $PC, '==', 0xffff, 'PC' );

foreach my $byte ( 0x00, 0x01, 0xff, 0xaa, 0x00 ) {
        my $a = 0x1000 + $byte * 100;
        cmp_ok( M6502::_write($a,$byte), '==', $byte, 'M6502::_write' );
        cmp_ok( $mem[$a], '==', $byte, '$mem' );
        cmp_ok( M6502::_read($a), '==', $byte, 'M6502::_read' );
}

sub dump_callbacks {
        my $out = 'callbacks:';
        $out .= sprintf(" %02x", M6502::get_callback( $_ )) foreach ( 0x6000 .. 0x6020 );
        diag join(' ',$out, @_);
}

is( M6502::get_callback( 0x6000 ), 0x22, 'default callback 0x22' );
is( M6502::set_all_callbacks( 0x42 ), 0x42, 'set_all_callbacks( 0x42 )' );
is( M6502::get_callback( $_ ), 0x42, sprintf('get_callback %04x', $_) ) foreach ( 0, 1, 2, 3, 0x4000, 0x8000, 0xfffe, 0xffff );
is( M6502::set_all_callbacks( 0 ), 0, 'set_all_callbacks( 0 )' );
M6502::set_write_callback( 0x6000 );
is( M6502::get_callback( 0x6000 ), 0x20, 'set_write_callback' );
M6502::set_read_callback( 0x6000 );
is( M6502::get_callback( 0x6000 ), 0x22, 'set_read_callback' );
is( M6502::set_all_callbacks( 0xff ), 0xff, 'set_all_callbacks( 0xff )' );
is( M6502::get_callback( 0 ), 0xff, 'get_callback' );
ok( M6502::reset(), 'reset' );
is( M6502::get_callback( 0 ), 0x22, 'reset restore default callback 0x22' );

my @flip_tests = (
        { fill => 0b11101101, expect => 0b10110111 },
        { fill => 0b11101101, expect => 0b10110111, callbacks => 0x22 },
        { fill => 0b11110000, expect => 0b00001111, callbacks => 0x11 },
        { fill => 0b11110011, expect => 0b11001111, callbacks => 0x01 },
);

my $i = 1;

foreach my $test ( @flip_tests ) {

        diag 'flip round ',$i++,' ',dump( $test );

        ok( M6502::reset(), 'reset again' );
        dump_callbacks;

        is( M6502::set_all_callbacks( $test->{callbacks} ), $test->{callbacks}, sprintf('set_all_callbacks(0x%02x)',$test->{callbacks}) )
                if $test->{callbacks};
        dump_callbacks;

        # manually hook callbacks
        M6502::set_write_callback( $_ ) foreach ( 0x6000 .. 0x6010 );
        dump_callbacks('after set_write_callback');

        # flip bytes 6502 asm
        my $a = 0x1000;

        $mem[$a++] = $_ foreach (
                0xa9, 0x60, 0xa2, 0x7f, 0xa0, 0x00, 0x85, 0xe1,
                0x84, 0xe0, 0xb1, 0xe0, 0x4a, 0x26, 0xe2, 0x4a,
                0x26, 0xe2, 0x4a, 0x26, 0xe2, 0x4a, 0x26, 0xe2,
                0x4a, 0x26, 0xe2, 0x4a, 0x26, 0xe2, 0x4a, 0x26,
                0xe2, 0x4a, 0x26, 0xe2, 0xa5, 0xe2, 0x91, 0xe0,
                0xc8, 0xd0, 0xdf, 0xe6, 0xe1, 0xe4, 0xe1, 0xb0,
                0xd9, 0x60, 0x00,
        );

        $mem[$_] = $test->{fill} foreach ( 0x6000 .. 0x7ffff );

        diag dump_R();
        $PC = 0x1000;

        ok( my $left = M6502::exec( 1 ), 'M6502::exec(1)' );
        cmp_ok( $PC, '==', 0x1002, 'PC moved' );
        cmp_ok( $left, '==', -1, 'no cycles left' );

        ok( ! M6502::exec( 1000 ), 'M6502::exec' );
        cmp_ok( $PC, '==', 0x1016, 'PC moved' );

        foreach my $a ( 0x6000 .. 0x600c ) {
                cmp_ok( $mem[$a], '==', $test->{expect}, sprintf('flipped 1st %04x %08b -> %08b',$a, $test->{fill}, $mem[$a]) );
#               cmp_ok( M6502::get_callback( $a ), '==', $test->{callbacks}, 'callback' );
        }

        dump_callbacks;

        $PC = 0x1000;
        ok( M6502::exec( 1001 ), 'M6502::exec again' );
        cmp_ok( $PC, '==', 0x1016, 'PC moved' );

        foreach my $a ( 0x6000 .. 0x600c ) {
                is( $mem[$a], $test->{fill}, sprintf('flipped 2nd %04x %08b -> %08b',$a, $test->{fill}, $mem[$a]) );
#               is( M6502::get_callback( $a ), $test->{callbacks}, 'callback' );
        }

        dump_callbacks;
}
1	dpavlin	83	#!/usr/bin/perl
2
3			use warnings;
4			use strict;
5
6			use blib;
7			use lib './lib';
8
9	dpavlin	202	use Test::More tests => 192;
10	dpavlin	83	use Test::Exception;
11			use Data::Dump qw/dump/;
12
13			BEGIN {
14			use_ok( 'M6502' );
15			}
16
17	dpavlin	87	cmp_ok( $debug, '==', 0, '$debug' );
18			cmp_ok( M6502::get_debug(), '==', 0, 'M6502::get_debug' );
19			cmp_ok( M6502->debug, '==', 0, 'M6502->debug' );
20
21			cmp_ok( M6502::set_debug( 1 ), '==', 1, 'M6502::set_debug');
22			cmp_ok( M6502::get_debug(), '==', 1, 'M6502::get_debug');
23			cmp_ok( $debug, '==', 0, '$debug still wrong');
24
25			cmp_ok( M6502->debug(1), '==', 1, 'M6502->debug(1)' );
26			cmp_ok( $debug, '==', 1, '$debug on' );
27			cmp_ok( M6502::get_debug(), '==', 1, 'get_debug on' );
28			cmp_ok( M6502->debug, '==', 1, 'M6502->debug on' );
29
30			cmp_ok( M6502->debug(0), '==', 0, 'M6502->debug(0)' );
31			cmp_ok( $debug, '==', 0, '$debug off' );
32			cmp_ok( M6502::get_debug(), '==', 0, 'get_debug off' );
33			cmp_ok( M6502->debug, '==', 0, 'M6502->debug off' );
34
35			M6502->debug( 1 ) if @ARGV;
36
37			diag "debug: $debug";
38
39	dpavlin	86	cmp_ok( $PC, '==', 0xbeef, 'PC' );
40
41	dpavlin	83	ok( M6502::reset(), 'reset' );
42
43	dpavlin	89	cmp_ok( $PC, '==', 0xffff, 'PC' );
44	dpavlin	87
45	dpavlin	86	diag dump_R();
46
47	dpavlin	87	$PC = 0xdead;
48	dpavlin	86
49	dpavlin	87	M6502::update_C_R();
50	dpavlin	86
51	dpavlin	87	$PC = 0xffff;
52
53			M6502::update_perl_R();
54
55			cmp_ok( $PC, '==', 0xdead, 'PC' );
56
57	dpavlin	83	ok( M6502::reset(), 'reset again' );
58	dpavlin	87
59	dpavlin	89	cmp_ok( $PC, '==', 0xffff, 'PC' );
60
61			foreach my $byte ( 0x00, 0x01, 0xff, 0xaa, 0x00 ) {
62			my $a = 0x1000 + $byte * 100;
63			cmp_ok( M6502::_write($a,$byte), '==', $byte, 'M6502::_write' );
64			cmp_ok( $mem[$a], '==', $byte, '$mem' );
65			cmp_ok( M6502::_read($a), '==', $byte, 'M6502::_read' );
66			}
67	dpavlin	91
68	dpavlin	201	sub dump_callbacks {
69			my $out = 'callbacks:';
70			$out .= sprintf(" %02x", M6502::get_callback( $_ )) foreach ( 0x6000 .. 0x6020 );
71			diag join(' ',$out, @_);
72			}
73
74			is( M6502::get_callback( 0x6000 ), 0x22, 'default callback 0x22' );
75			is( M6502::set_all_callbacks( 0x42 ), 0x42, 'set_all_callbacks( 0x42 )' );
76			is( M6502::get_callback( $_ ), 0x42, sprintf('get_callback %04x', $_) ) foreach ( 0, 1, 2, 3, 0x4000, 0x8000, 0xfffe, 0xffff );
77			is( M6502::set_all_callbacks( 0 ), 0, 'set_all_callbacks( 0 )' );
78			M6502::set_write_callback( 0x6000 );
79			is( M6502::get_callback( 0x6000 ), 0x20, 'set_write_callback' );
80			M6502::set_read_callback( 0x6000 );
81			is( M6502::get_callback( 0x6000 ), 0x22, 'set_read_callback' );
82			is( M6502::set_all_callbacks( 0xff ), 0xff, 'set_all_callbacks( 0xff )' );
83			is( M6502::get_callback( 0 ), 0xff, 'get_callback' );
84			ok( M6502::reset(), 'reset' );
85			is( M6502::get_callback( 0 ), 0x22, 'reset restore default callback 0x22' );
86
87	dpavlin	195	my @flip_tests = (
88	dpavlin	201	{ fill => 0b11101101, expect => 0b10110111 },
89	dpavlin	198	{ fill => 0b11101101, expect => 0b10110111, callbacks => 0x22 },
90			{ fill => 0b11110000, expect => 0b00001111, callbacks => 0x11 },
91	dpavlin	202	{ fill => 0b11110011, expect => 0b11001111, callbacks => 0x01 },
92	dpavlin	195	);
93	dpavlin	91
94	dpavlin	201	my $i = 1;
95	dpavlin	200
96	dpavlin	195	foreach my $test ( @flip_tests ) {
97	dpavlin	91
98	dpavlin	201	diag 'flip round ',$i++,' ',dump( $test );
99	dpavlin	91
100	dpavlin	201	ok( M6502::reset(), 'reset again' );
101	dpavlin	200	dump_callbacks;
102
103	dpavlin	201	is( M6502::set_all_callbacks( $test->{callbacks} ), $test->{callbacks}, sprintf('set_all_callbacks(0x%02x)',$test->{callbacks}) )
104			if $test->{callbacks};
105	dpavlin	200	dump_callbacks;
106	dpavlin	195
107	dpavlin	200	# manually hook callbacks
108	dpavlin	201	M6502::set_write_callback( $_ ) foreach ( 0x6000 .. 0x6010 );
109			dump_callbacks('after set_write_callback');
110	dpavlin	200
111	dpavlin	199	# flip bytes 6502 asm
112			my $a = 0x1000;
113
114			$mem[$a++] = $_ foreach (
115			0xa9, 0x60, 0xa2, 0x7f, 0xa0, 0x00, 0x85, 0xe1,
116			0x84, 0xe0, 0xb1, 0xe0, 0x4a, 0x26, 0xe2, 0x4a,
117			0x26, 0xe2, 0x4a, 0x26, 0xe2, 0x4a, 0x26, 0xe2,
118			0x4a, 0x26, 0xe2, 0x4a, 0x26, 0xe2, 0x4a, 0x26,
119			0xe2, 0x4a, 0x26, 0xe2, 0xa5, 0xe2, 0x91, 0xe0,
120			0xc8, 0xd0, 0xdf, 0xe6, 0xe1, 0xe4, 0xe1, 0xb0,
121			0xd9, 0x60, 0x00,
122			);
123
124	dpavlin	195	$mem[$_] = $test->{fill} foreach ( 0x6000 .. 0x7ffff );
125
126			diag dump_R();
127			$PC = 0x1000;
128
129			ok( my $left = M6502::exec( 1 ), 'M6502::exec(1)' );
130			cmp_ok( $PC, '==', 0x1002, 'PC moved' );
131			cmp_ok( $left, '==', -1, 'no cycles left' );
132
133			ok( ! M6502::exec( 1000 ), 'M6502::exec' );
134			cmp_ok( $PC, '==', 0x1016, 'PC moved' );
135
136			foreach my $a ( 0x6000 .. 0x600c ) {
137	dpavlin	201	cmp_ok( $mem[$a], '==', $test->{expect}, sprintf('flipped 1st %04x %08b -> %08b',$a, $test->{fill}, $mem[$a]) );
138			# cmp_ok( M6502::get_callback( $a ), '==', $test->{callbacks}, 'callback' );
139	dpavlin	195	}
140	dpavlin	200
141			dump_callbacks;
142
143			$PC = 0x1000;
144			ok( M6502::exec( 1001 ), 'M6502::exec again' );
145			cmp_ok( $PC, '==', 0x1016, 'PC moved' );
146
147			foreach my $a ( 0x6000 .. 0x600c ) {
148	dpavlin	201	is( $mem[$a], $test->{fill}, sprintf('flipped 2nd %04x %08b -> %08b',$a, $test->{fill}, $mem[$a]) );
149			# is( M6502::get_callback( $a ), $test->{callbacks}, 'callback' );
150	dpavlin	200	}
151
152			dump_callbacks;
153	dpavlin	91	}