/[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 112 - (hide 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 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     # 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