M6502/t/05-M6502.t

#!/usr/bin/perl

use warnings;
use strict;

use blib;
use lib './lib';

use Test::More tests => 236;
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' );
#       is( M6502::mem_peek( $a ), $byte, 'M6502::mem_peek' );
        cmp_ok( M6502::_read($a), '==', $byte, 'M6502::_read' );
}

M6502::mem_poke( 0x2000, 0x42 );
is( M6502::mem_peek( 0x2000 ), 0x42, 'mem_peek' );

ok( my $bytes = M6502::mem_peek_region( 0x2000, 0x200f ), 'mem_peek_region' );
is( length($bytes), 0x10, 'correct size' );
is( $bytes, pack("H*","42ffffffffffffffffffffffffffffff"), 'correct' );
is( $bytes, pack('C*', M6502->ram( 0x2000, 0x200f )), 'M6502->ram' );

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 },
        { fill => 0b11110011, expect => 0b11001111, callbacks => 0x00 },
);

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');

        diag 'flip bytes 6502 asm';
        my @flip_asm = (
                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,
        );

        my $a = 0x1000;

        $mem[$a++] = $_ foreach @flip_asm;

        is(
                M6502::mem_peek_region( 0x1000, $a - 1 ),
                pack('C*', @flip_asm),
                'mem_peek_region'
        );

        diag 'clean video ram';
        $mem[$_] = $test->{fill} foreach ( 0x6000 .. 0x7fff );

        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]) );
        }

        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]) );
        }

        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	208	use Test::More tests => 236;
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	dpavlin	203	# is( M6502::mem_peek( $a ), $byte, 'M6502::mem_peek' );
66	dpavlin	89	cmp_ok( M6502::_read($a), '==', $byte, 'M6502::_read' );
67			}
68	dpavlin	91
69	dpavlin	208	M6502::mem_poke( 0x2000, 0x42 );
70			is( M6502::mem_peek( 0x2000 ), 0x42, 'mem_peek' );
71
72			ok( my $bytes = M6502::mem_peek_region( 0x2000, 0x200f ), 'mem_peek_region' );
73			is( length($bytes), 0x10, 'correct size' );
74			is( $bytes, pack("H*","42ffffffffffffffffffffffffffffff"), 'correct' );
75			is( $bytes, pack('C*', M6502->ram( 0x2000, 0x200f )), 'M6502->ram' );
76
77	dpavlin	201	sub dump_callbacks {
78			my $out = 'callbacks:';
79			$out .= sprintf(" %02x", M6502::get_callback( $_ )) foreach ( 0x6000 .. 0x6020 );
80			diag join(' ',$out, @_);
81			}
82
83			is( M6502::get_callback( 0x6000 ), 0x22, 'default callback 0x22' );
84			is( M6502::set_all_callbacks( 0x42 ), 0x42, 'set_all_callbacks( 0x42 )' );
85			is( M6502::get_callback( $_ ), 0x42, sprintf('get_callback %04x', $_) ) foreach ( 0, 1, 2, 3, 0x4000, 0x8000, 0xfffe, 0xffff );
86			is( M6502::set_all_callbacks( 0 ), 0, 'set_all_callbacks( 0 )' );
87			M6502::set_write_callback( 0x6000 );
88			is( M6502::get_callback( 0x6000 ), 0x20, 'set_write_callback' );
89			M6502::set_read_callback( 0x6000 );
90			is( M6502::get_callback( 0x6000 ), 0x22, 'set_read_callback' );
91			is( M6502::set_all_callbacks( 0xff ), 0xff, 'set_all_callbacks( 0xff )' );
92			is( M6502::get_callback( 0 ), 0xff, 'get_callback' );
93			ok( M6502::reset(), 'reset' );
94			is( M6502::get_callback( 0 ), 0x22, 'reset restore default callback 0x22' );
95
96	dpavlin	195	my @flip_tests = (
97	dpavlin	201	{ fill => 0b11101101, expect => 0b10110111 },
98	dpavlin	198	{ fill => 0b11101101, expect => 0b10110111, callbacks => 0x22 },
99			{ fill => 0b11110000, expect => 0b00001111, callbacks => 0x11 },
100	dpavlin	202	{ fill => 0b11110011, expect => 0b11001111, callbacks => 0x01 },
101	dpavlin	204	{ fill => 0b11110011, expect => 0b11001111, callbacks => 0x00 },
102	dpavlin	195	);
103	dpavlin	91
104	dpavlin	201	my $i = 1;
105	dpavlin	200
106	dpavlin	195	foreach my $test ( @flip_tests ) {
107	dpavlin	91
108	dpavlin	201	diag 'flip round ',$i++,' ',dump( $test );
109	dpavlin	91
110	dpavlin	201	ok( M6502::reset(), 'reset again' );
111	dpavlin	200	dump_callbacks;
112
113	dpavlin	201	is( M6502::set_all_callbacks( $test->{callbacks} ), $test->{callbacks}, sprintf('set_all_callbacks(0x%02x)',$test->{callbacks}) )
114			if $test->{callbacks};
115	dpavlin	200	dump_callbacks;
116	dpavlin	195
117	dpavlin	200	# manually hook callbacks
118	dpavlin	201	M6502::set_write_callback( $_ ) foreach ( 0x6000 .. 0x6010 );
119			dump_callbacks('after set_write_callback');
120	dpavlin	200
121	dpavlin	203	diag 'flip bytes 6502 asm';
122	dpavlin	208	my @flip_asm = (
123	dpavlin	199	0xa9, 0x60, 0xa2, 0x7f, 0xa0, 0x00, 0x85, 0xe1,
124			0x84, 0xe0, 0xb1, 0xe0, 0x4a, 0x26, 0xe2, 0x4a,
125			0x26, 0xe2, 0x4a, 0x26, 0xe2, 0x4a, 0x26, 0xe2,
126			0x4a, 0x26, 0xe2, 0x4a, 0x26, 0xe2, 0x4a, 0x26,
127			0xe2, 0x4a, 0x26, 0xe2, 0xa5, 0xe2, 0x91, 0xe0,
128			0xc8, 0xd0, 0xdf, 0xe6, 0xe1, 0xe4, 0xe1, 0xb0,
129			0xd9, 0x60, 0x00,
130			);
131
132	dpavlin	208	my $a = 0x1000;
133
134			$mem[$a++] = $_ foreach @flip_asm;
135
136			is(
137			M6502::mem_peek_region( 0x1000, $a - 1 ),
138			pack('C*', @flip_asm),
139			'mem_peek_region'
140			);
141
142	dpavlin	203	diag 'clean video ram';
143			$mem[$_] = $test->{fill} foreach ( 0x6000 .. 0x7fff );
144	dpavlin	195
145			diag dump_R();
146			$PC = 0x1000;
147
148			ok( my $left = M6502::exec( 1 ), 'M6502::exec(1)' );
149			cmp_ok( $PC, '==', 0x1002, 'PC moved' );
150			cmp_ok( $left, '==', -1, 'no cycles left' );
151
152			ok( ! M6502::exec( 1000 ), 'M6502::exec' );
153			cmp_ok( $PC, '==', 0x1016, 'PC moved' );
154
155			foreach my $a ( 0x6000 .. 0x600c ) {
156	dpavlin	201	cmp_ok( $mem[$a], '==', $test->{expect}, sprintf('flipped 1st %04x %08b -> %08b',$a, $test->{fill}, $mem[$a]) );
157	dpavlin	195	}
158	dpavlin	200
159			dump_callbacks;
160
161			$PC = 0x1000;
162			ok( M6502::exec( 1001 ), 'M6502::exec again' );
163			cmp_ok( $PC, '==', 0x1016, 'PC moved' );
164
165			foreach my $a ( 0x6000 .. 0x600c ) {
166	dpavlin	201	is( $mem[$a], $test->{fill}, sprintf('flipped 2nd %04x %08b -> %08b',$a, $test->{fill}, $mem[$a]) );
167	dpavlin	200	}
168
169			dump_callbacks;
170	dpavlin	91	}