/[VRac]/Z80/Z80.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /Z80/Z80.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 113 - (show annotations)
Fri Aug 3 16:28:06 2007 UTC (11 years, 8 months ago) by dpavlin
File size: 5240 byte(s)
and perl part which is at least syntax correct :-)
1 package Z80;
2
3 use strict;
4 use warnings;
5
6 use Data::Dump qw/dump/;
7 use Carp qw/confess/;
8 use Exporter 'import';
9 our @EXPORT = qw'dump_R @mem
10 $AF $BC $DE $HL $IX $IY $PC $SP
11 $AF1 $BC1 $DE1 $HL1;
12 $IFF $I
13 $R
14 $IPeriod $ICount $IRequest $IAutoReset $TrapBadOps $Trap $Trace
15 $debug';
16 our $VERSION = '0.0.1';
17 require XSLoader;
18 XSLoader::load('Z80', $VERSION);
19
20 =head1 NAME
21
22 Z80 - perl bindings for Z80 CPU emulator
23
24 =head1 FUNCTIONS
25
26 =cut
27
28 our $debug = 0;
29
30 our @mem = (0xff) x 0x10000; # 64M
31
32 # CPU registars
33 our (
34 $AF, $BC, $DE, $HL, $IX, $IY, $PC, $SP,
35 $AF1, $BC1, $DE1, $HL1,
36 $IFF, $I,
37 $R
38 ) = (0) x 15;
39
40 our $IPeriod=1; # Set IPeriod to number of CPU cycles between calls to Loop6502
41 our $ICount;
42 our $IRequest; # Set to the INT_IRQ when pending IRQ
43 our $IAutoReset; # Set to 1 to autom. reset IRequest
44 our $TrapBadOps=1; # Set to 1 to warn of illegal opcodes
45 our $Trap; # Set Trap to address to trace from
46 our $Trace; # Set Trace=1 to start tracing
47
48 =head2 init
49
50 Setup read and write memory hooks (to implement memory mapped devices)
51
52 $init->(
53 read => sub {
54 return $mem[$_[0]];
55 },
56 write => sub {
57 $mem[$_[0]] = $_[1];
58 },
59 );
60
61 =cut
62
63 our $_rw_hooks = {
64 read => sub {
65 warn sprintf("# callback read(%04x) not implemented\n", @_) if $debug;
66 return $mem[$_[0]];
67 },
68 write => sub {
69 warn sprintf("# callback write(%04x,%02x) not implemented", @_) if $debug;
70 $mem[$_[0]] = $_[1];
71 },
72 };
73
74 sub init {
75 my $self = shift;
76 my $args = {@_};
77 warn "inside init low-level Z80 from ",ref($self),"\n";
78
79 foreach my $p ( qw/read write/ ) {
80 confess "need $p argument as coderef" unless ( $args->{$p} && ref($args->{$p}) eq 'CODE' );
81 $_rw_hooks->{$p} = $args->{$p};
82 }
83
84 };
85
86 =head2 poke_code
87
88 Write series of bytes into memory passing through MMU (C<read> and C<write>)
89 functions. If you don't want to trigger MMU, use C<write_chunk>.
90
91 $emu->poke_code( 0xbeef, 0xff, 0x00, 0xff, 0x00, 0xaa );
92
93 =cut
94
95 sub poke_code {
96 my $self = shift;
97 my $addr = shift;
98 warn sprintf("## Z80::poke_code(%04x,%s)\n", $addr, dump( @_ )) if $self->debug;
99 #$mem[$addr++] = $_ foreach @_;
100 # call low-level write
101 $_rw_hooks->{write}->( $addr++, $_ ) foreach @_;
102 }
103
104 =head2 ram
105
106 Read series of bytes into memory without MMU interaction
107
108 my @code = $emu->ram( 0xc000, 0xc1000 );
109
110 =cut
111
112 sub ram {
113 my $self = shift;
114 my ( $from, $to ) = @_;
115 warn sprintf("## Z80::ram(%04x,%04x)\n", $from, $to) if $self->debug;
116 return @mem[ $from .. $to ];
117 }
118
119 =head2 write_chunk
120
121 Low-level update of memory, overriding user specified MMU functions C<read> and C<write>
122
123 $emu->write_chunk( $address, $chunk_of_data );
124
125 =cut
126
127 sub write_chunk {
128 my ($self, $addr, $chunk) = @_;
129 my $len = length($chunk);
130 splice @mem, $addr, $len, unpack('C*', $chunk);
131 }
132
133 =head1 XS Callbacks
134
135 This functions are called from C<Z80.xs>
136
137 =head2 _read
138
139 Read from memory C callback
140
141 $byte = Z80::_read( $address );
142
143 =cut
144
145 sub _read {
146 return $_rw_hooks->{read}->( @_ );
147 }
148
149 =head2 _write
150
151 Write into memory C callback
152
153 Z80:_write( $address, $byte );
154
155 =cut
156
157 sub _write {
158 return $_rw_hooks->{write}->( @_ );
159 }
160
161 =head2 _update_perl_R
162
163 called by C<Z80.xs> to push changes in registars back to perl variables
164
165 =cut
166
167 sub _update_perl_R {
168 warn "## Z80::update_perl_R(",dump(@_),")\n" if $debug;
169 (
170 $AF, $BC, $DE, $HL, $IX, $IY, $PC, $SP,
171 $AF1, $BC1, $DE1, $HL1,
172 $IFF, $I,
173 $R,
174 $IPeriod, $ICount, $IRequest, $IAutoReset, $TrapBadOps, $Trap, $Trace
175 ) = @_;
176
177 dump_R();
178 }
179
180 =head1 XS
181
182 Following functions are implemented in C<Z80.xs> and exported to perl.
183
184 =head2 set_debug
185
186 Z80::set_debug( 0 );
187
188 =head2 get_debug
189
190 my $debug = Z80::set_debug();
191
192 =head2 reset
193
194 Reset 6502 CPU, reading PC from C<0xfffc>
195
196 Z80::reset();
197
198 =head2 update_C_R
199
200 Push perl notion of register values to CPU emulator
201
202 Z80::update_C_R();
203
204 =head2 update_perl_R
205
206 Update perl notion of register values
207
208 Z80::update_perl_R();
209
210 =head2 exec
211
212 Execute cpu for specified number of cycles
213
214 my $cycles_left = Z80::exec( $execute_cpu_cycles );
215
216 =head1 Helpers
217
218 =head2 dump_R
219
220 helper function which dumps registers in humanly readable form
221
222 my $dump = dump_R;
223
224 =cut
225
226 sub dump_R {
227 my $dump = sprintf( " " .
228 "AF:%04x BC:%04x DE:%04x HL:%04x IX:%04x IY:%04x PC:%04x SP:%04x | " .
229 "AF1:%04x BC1:%04x DE1:%04x HL1:%04x | " .
230 "IFF: %02x I: %02x R: %02x | " .
231 "IPeriod:%d ICount:%d IRequest:%02x IAutoReset:%02x TrapBadOps:%d Trap:%d Trace:%d" .
232 "\n",
233 $AF, $BC, $DE, $HL, $IX, $IY, $PC, $SP,
234 $AF1, $BC1, $DE1, $HL1,
235 $IFF, $I,
236 $R,
237 $IPeriod, $ICount, $IRequest, $IAutoReset, $TrapBadOps, $Trap, $Trace,
238 );
239 warn "## Z80::dump_R $dump" if $debug;
240 return $dump;
241 }
242
243 =head2 debug
244
245 Turn perl and C-level debugging on/off
246
247 $emu->debug( 0 );
248 $emu->debug( 1 );
249 print $emu->debug;
250
251 =cut
252
253 sub debug {
254 my $self = shift;
255 my $value = shift;
256 if (defined($value)) {
257 $debug = Z80::set_debug($value);
258 } else {
259 $debug = Z80::get_debug();
260 }
261 return $debug;
262 }
263
264 =head1 SEE ALSO
265
266 L<Orao> is sample implementation using this module
267
268 =head1 AUTHOR
269
270 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
271
272 =head1 COPYRIGHT & LICENSE
273
274 Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
275
276 This program is free software; you can redistribute it and/or modify it
277 under the same terms as Perl itself.
278
279 =cut
280 1;

  ViewVC Help
Powered by ViewVC 1.1.26