/[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

Annotation of /Z80/Z80.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 113 - (hide annotations)
Fri Aug 3 16:28:06 2007 UTC (11 years, 9 months ago) by dpavlin
File size: 5240 byte(s)
and perl part which is at least syntax correct :-)
1 dpavlin 112 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 dpavlin 113 $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 dpavlin 112 ) = @_;
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