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

  ViewVC Help
Powered by ViewVC 1.1.26