/[VRac]/VRac.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 /VRac.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 148 - (show annotations)
Sun Aug 5 14:08:01 2007 UTC (16 years, 7 months ago) by dpavlin
File size: 7639 byte(s)
pod tweaks
1 package VRac;
2
3 use warnings;
4 use strict;
5
6 use Carp qw/confess croak/;
7 use File::Slurp;
8 use Data::Dump qw/dump/;
9
10 use base qw(Class::Accessor);
11 __PACKAGE__->mk_accessors(qw(booted));
12
13 =head1 NAME
14
15 VRac - Virtualno Računalo
16
17 =head1 VERSION
18
19 Version 0.00
20
21 =cut
22
23 our $VERSION = '0.00';
24
25 =head1 DESCRIPTION
26
27 Emulator of 8-bit architectures based on L<M6502> or L<Z80> emulation.
28
29 This project is homage to 8-bit computers in Croatia and former Yugoslavia
30 from 1980-1990. Word B<vrac> means also I<wizard> in Croatian.
31
32 This project should enable anyone with limited knowledge of perl and 8-bit
33 arhitecture of some machine to write emulator in an afternoon. To achieve this,
34 code is written is as cleanly as possible.
35
36 Porting existing emulators should be especially easy: you need passive
37 understaning of language in which emulator is written and you can be on your
38 way C<:-)>
39
40 =cut
41
42 =head1 FUNCTIONS
43
44 =head2 run
45
46 Start emulator, open L<Screen>, load initial ROM images, and start emulator loop
47
48 my $emu = Orao->new();
49 $emu->run;
50
51 =cut
52
53 our $emu;
54
55 sub run {
56 my $self = shift;
57 confess "please implement $self::run\n";
58 }
59
60
61 =head1 Memory management
62
63 VRac implements callback for all I/O operations. This was main reason why
64 L<Acme::6502> module with tied memory was too slow to emulate L<Orao>, so I
65 had to write C binding for L<M6502>.
66
67 B<This functions will die with stack trace when called>. They should be
68 implemented for each architecture.
69
70 =cut
71
72 =head2 read
73
74 Read from memory
75
76 $byte = read( $address );
77
78 =cut
79
80 sub read {
81 my $self = shift;
82 confess "please implement $self::read()";
83 }
84
85 =head2 write
86
87 Write into emory
88
89 write( $address, $byte );
90
91 =cut
92
93 sub write {
94 my $self = shift;
95 confess "please implement $self::write()";
96 }
97
98 =head1 Helper functions
99
100 =head2 load_rom
101
102 called to init memory and load initial rom images
103
104 $emu->load_rom;
105
106 =cut
107
108 sub load_rom {
109 my ($self, $loaded_files) = @_;
110
111 #my $time_base = time();
112
113 foreach my $addr ( sort keys %$loaded_files ) {
114 my $path = $loaded_files->{$addr};
115 $self->load_image( $path, $addr );
116 }
117 }
118
119 =head2 load_image
120
121 Load binary files, ROM images and VRac Emulator files
122
123 $emu->load_image( '/path/to/file', 0x1000 );
124
125 Returns true on success.
126
127 =cut
128
129 sub load_image {
130 my $self = shift;
131 my ( $path, $addr ) = @_;
132
133 croak "ERROR: file $path doesn't exist\n" if ( ! -e $path );
134
135 my $size = -s $path || confess "no size for $path: $!";
136
137 my $buff = read_file( $path );
138
139 printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
140 $self->write_chunk( $addr, $buff );
141 return 1;
142 };
143
144 =head2 save_dump
145
146 $emu->save_dump( 'filename', $from, $to );
147
148 =cut
149
150 sub save_dump {
151 my $self = shift;
152
153 my ( $path, $from, $to ) = @_;
154
155 $from ||= 0;
156 $to ||= 0xffff;
157
158 if ( open(my $fh, '>', $path) ) {
159 print $fh $self->read_chunk( $from, $to );
160 close($fh);
161
162 my $size = -s $path;
163 warn sprintf "saved %s %04x-%04x %d %x bytes\n", $path, $from, $to, $size, $size;
164 } else {
165 warn "can't create $path: $!";
166 }
167
168 }
169
170 =head2 hexdump
171
172 $emu->hexdump( $address );
173
174 =cut
175
176 sub hexdump {
177 my $self = shift;
178 my $a = shift;
179 return sprintf(" %04x %s\n", $a,
180 join(" ",
181 map {
182 my $b = $self->read( $a + $_ );
183 if ( defined($b) ) {
184 sprintf( "%02x", $b )
185 } else {
186 ' '
187 }
188 } 0 .. 7
189 )
190 );
191 }
192
193 =head2 append_to_file
194
195 $self->append_to_file( '/path/to/file', $byte, $byte ... );
196
197 =cut
198
199 sub append_to_file {
200 my $self = shift;
201 my $path = shift || confess "no path?";
202 my $bytes = join('', @_);
203
204 open(my $fh, '>>', $path) || confess "can't open $path: $!";
205
206 print $fh $bytes;
207 warn sprintf("## append_to_file('%s',%s)\n", $path, dump($bytes));
208 }
209
210 =head1 Command Line
211
212 Command-line debugging intrerface is implemented for communication with
213 emulated device
214
215 =head2 prompt
216
217 my ( $entered_line, @p ) = $emu->prompt( $address, $last_command );
218
219 =cut
220
221 my $last = 'r 1';
222
223 sub prompt {
224 my $self = shift;
225 $self->app->sync;
226 my $a = shift;
227 print $self->hexdump( $a ),
228 $last ? "[$last] " : '',
229 "> ";
230 my $in = <STDIN>;
231 chomp($in);
232 warn "## prompt got: $in\n" if $self->debug;
233 $in ||= $last;
234 $last = $in;
235 return ( $in, split(/\s+/, $in) ) if $in;
236 }
237
238 =head2 cli
239
240 my $run_for = $emu->cli;
241
242 =cut
243
244 my $show_R = 0;
245
246 sub cli {
247 my $self = shift;
248 my $a = $self->cpu_PC() || confess "can't find PC";
249 my $run_for = 0;
250 warn $self->dump_R() if $show_R;
251 while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
252 my $c = shift @v;
253 next unless defined($c);
254 my $v = shift @v;
255 $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
256 @v = map { hex($_) } @v;
257 printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
258 if ( $c =~ m/^[qx]/i ) {
259 exit;
260 } elsif ( $c eq '?' ) {
261 my $t = $self->trace ? 'on' : 'off' ;
262 my $d = $self->debug ? 'on' : 'off' ;
263 warn <<__USAGE__;
264 Usage:
265
266 x|q\t\texit
267 e 6000 6010\tdump memory, +/- to walk forward/backward
268 m 1000 ff 00\tput ff 00 on 1000
269 j|u 1000\t\tjump (change pc)
270 r 42\t\trun 42 instruction opcodes
271 t\t\ttrace [$t]
272 d\t\tdebug [$d]
273
274 __USAGE__
275 warn $self->dump_R;
276 $last = '';
277 } elsif ( $c =~ m/^e/i ) {
278 $a = $v if defined($v);
279 my $to = shift @v;
280 $to = $a + 32 if ( ! $to || $to <= $a );
281 $to = 0xffff if ( $to > 0xffff );
282 my $lines = int( ($to - $a + 8) / 8 );
283 printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
284 while ( --$lines ) {
285 print $self->hexdump( $a );
286 $a += 8;
287 }
288 $last = '+';
289 $show_R = 0;
290 } elsif ( $c =~ m/^\+/ ) {
291 $a += 8;
292 $show_R = 0;
293 } elsif ( $c =~ m/^\-/ ) {
294 $a -= 8;
295 $show_R = 0;
296 } elsif ( $c =~ m/^m/i ) {
297 $a = $v if defined($v);
298 $self->poke_code( $a, @v );
299 printf "poke %d bytes at %04x\n", $#v + 1, $a;
300 $last = '+';
301 $show_R = 0;
302 } elsif ( $c =~ m/^l/i ) {
303 my $to = shift @v || 0x1000;
304 $a = $to;
305 $self->load_image( $v, $a );
306 $last = '';
307 } elsif ( $c =~ m/^s/i ) {
308 $self->save_dump( $v || 'mem.dump', @v );
309 $last = '';
310 } elsif ( $c =~ m/^re/i ) { # reset
311 M6502::reset();
312 $last = 'r 1';
313 } elsif ( $c =~ m/^r/i ) { # run
314 $run_for = $v || 1;
315 print "run_for $run_for instructions\n";
316 $show_R = 1;
317 last;
318 } elsif ( $c =~ m/^(u|j)/i ) {
319 my $to = $v || $a;
320 # change PC to new address
321 $self->cpu_PC( $to );
322 $run_for = 1;
323 $last = "r $run_for";
324 $show_R = 1;
325 last;
326 } elsif ( $c =~ m/^tape/ ) {
327 if ( $c =~ m/rate/ ) {
328 $self->tape_rate( $v );
329 warn "will read table with rate $v\n";
330 } elsif ( ! $v ) {
331 warn "ERROR: please specify tape name!\n";
332 } elsif ( ! -e $v ) {
333 warn "ERROR: tape $v: $!\n";
334 } else {
335 $self->load_tape( $v );
336 }
337 $last = '';
338 } elsif ( $c =~ m/^t/i ) {
339 $self->trace( not $self->trace );
340 print "trace ", $self->trace ? 'on' : 'off', "\n";
341 $last = '';
342 } elsif ( $c =~ m/^d/i ) {
343 $self->debug( not $self->debug );
344 print "debug ", $self->debug ? 'on' : 'off', "\n";
345 $last = '';
346 } else {
347 warn "# ignored $line\n" if ($line);
348 $last = '';
349 }
350 }
351
352 return $run_for;
353 }
354
355 =head1 SEE ALSO
356
357 Components: L<M6502>, L<Z80>, L<Screen>, L<Tape>
358
359 Emulators: L<Orao>, L<Galaksija>
360
361 =head1 AUTHOR
362
363 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
364
365 =head1 ACKNOWLEDGEMENTS
366
367 Structure and Interpretation of Computer Programs by Abelson, Sussman, and
368 Sussman L<http://mitpress.mit.edu/sicp/> is a great book. It gave me idea
369 that you should have wizard powers over your computer, even if it's 8 bit
370 one.
371
372 =head1 COPYRIGHT & LICENSE
373
374 Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
375
376 This program is free software; you can redistribute it and/or modify it
377 under the same terms as Perl itself.
378
379 =cut
380
381 1; # End of VRac

  ViewVC Help
Powered by ViewVC 1.1.26