/[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 211 - (show annotations)
Mon Apr 14 21:26:16 2008 UTC (11 years, 4 months ago) by dpavlin
File size: 7970 byte(s)
fix usage, tape now has beginning offset as optional argument
1 package VRac;
2
3 use warnings;
4 use strict;
5
6 use Carp qw/confess croak cluck carp/;
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 print 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 my $size = -s $path || 0;
205 my $len = length($bytes);
206
207 open(my $fh, '>>', $path) || confess "can't open $path: $!";
208 print($fh $bytes);
209 my $pos = tell($fh);
210
211 my $expected = $size + $len;
212 if ( $pos != $expected ) {
213 #cluck "BUG: file grows too big got $pos, expected $expected !";
214 truncate $fh, $expected;
215 }
216
217 close($fh);
218
219 warn sprintf("## append_to_file('%s',%s)\n", $path, dump($bytes));
220 }
221
222 =head1 Command Line
223
224 Command-line debugging intrerface is implemented for communication with
225 emulated device
226
227 =head2 prompt
228
229 my ( $entered_line, @p ) = $emu->prompt( $address, $last_command );
230
231 =cut
232
233 my $last = 'r 1';
234
235 sub prompt {
236 my $self = shift;
237 $self->app->sync;
238 my $a = shift;
239 print $self->hexdump( $a ),
240 $last ? "[$last] " : '',
241 "> ";
242 my $in = <STDIN>;
243 chomp($in);
244 warn "## prompt got: $in\n" if $self->debug;
245 $in ||= $last;
246 $last = $in;
247 return ( $in, split(/\s+/, $in) ) if $in;
248 }
249
250 =head2 cli
251
252 my $run_for = $emu->cli;
253
254 =cut
255
256 my $show_R = 0;
257
258 sub cli {
259 my $self = shift;
260 my $a = $self->cpu_PC() || confess "can't find PC";
261 my $run_for = 0;
262 print $self->dump_R() if $show_R;
263 while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
264 my $c = shift @v;
265 next unless defined($c);
266 my $v = shift @v;
267 $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
268 @v = map { hex($_) } @v;
269 printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
270 if ( $c =~ m/^[qx]/i ) {
271 exit;
272 } elsif ( $c eq '?' ) {
273 my $t = $self->trace ? 'on' : 'off' ;
274 my $d = $self->debug ? 'on' : 'off' ;
275 print <<__USAGE__;
276 Usage:
277
278 x|q\t\texit
279 e 6000 6010\tdump memory, +/- to walk forward/backward
280 m 1000 ff 00\tput ff 00 on 1000
281 j|u 1000\t\tjump (change pc)
282 r 42\t\trun 42 instruction opcodes
283 t\t\ttrace [$t]
284 d\t\tdebug [$d]
285 tape name 168\tload tape and start at offset
286
287 __USAGE__
288 print $self->tape_status if $self->can('tape_status');
289 print $self->dump_R;
290 $last = '';
291 } elsif ( $c =~ m/^e/i ) {
292 $a = $v if defined($v);
293 my $to = shift @v;
294 $to = $a + 32 if ( ! $to || $to <= $a );
295 $to = 0xffff if ( $to > 0xffff );
296 my $lines = int( ($to - $a + 8) / 8 );
297 printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
298 while ( --$lines ) {
299 print $self->hexdump( $a );
300 $a += 8;
301 }
302 $last = '+';
303 $show_R = 0;
304 } elsif ( $c =~ m/^\+/ ) {
305 $a += 8;
306 $show_R = 0;
307 } elsif ( $c =~ m/^\-/ ) {
308 $a -= 8;
309 $show_R = 0;
310 } elsif ( $c =~ m/^m/i ) {
311 $a = $v if defined($v);
312 $self->poke_code( $a, @v );
313 printf "poke %d bytes at %04x\n", $#v + 1, $a;
314 $last = '+';
315 $show_R = 0;
316 } elsif ( $c =~ m/^l/i ) {
317 my $to = shift @v || 0x1000;
318 $a = $to;
319 $self->load_image( $v, $a );
320 $last = '';
321 } elsif ( $c =~ m/^s/i ) {
322 $self->save_dump( $v || 'mem.dump', @v );
323 $last = '';
324 } elsif ( $c =~ m/^re/i ) { # reset
325 M6502::reset();
326 $last = 'r 1';
327 } elsif ( $c =~ m/^r/i ) { # run
328 $run_for = $v || 1;
329 print "run_for $run_for instructions\n";
330 $show_R = 1;
331 last;
332 } elsif ( $c =~ m/^(u|j)/i ) {
333 my $to = $v || $a;
334 # change PC to new address
335 $self->cpu_PC( $to );
336 $run_for = 1;
337 $last = "r $run_for";
338 $show_R = 1;
339 last;
340 } elsif ( $c =~ m/^tape/ ) {
341 if ( ! $v ) {
342 warn "ERROR: please specify tape name!\n";
343 } elsif ( ! -e $v ) {
344 warn "ERROR: tape $v: $!\n";
345 } else {
346 $self->load_tape( $v, shift @v );
347 }
348 $last = '';
349 } elsif ( $c =~ m/^t/i ) {
350 $self->trace( not $self->trace );
351 print "trace ", $self->trace ? 'on' : 'off', "\n";
352 $last = '';
353 } elsif ( $c =~ m/^d/i ) {
354 $self->debug( not $self->debug );
355 print "debug ", $self->debug ? 'on' : 'off', "\n";
356 $last = '';
357 } else {
358 warn "# ignored $line\n" if ($line);
359 $last = '';
360 }
361 }
362
363 return $run_for;
364 }
365
366 =head1 SEE ALSO
367
368 Components: L<M6502>, L<Z80>, L<Screen>, L<Tape>, L<Session>
369
370 Emulators: L<Orao>, L<Galaksija>
371
372 L<References> about different architectures
373
374 =head1 AUTHOR
375
376 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
377
378 =head1 ACKNOWLEDGEMENTS
379
380 Structure and Interpretation of Computer Programs by Abelson, Sussman, and
381 Sussman L<http://mitpress.mit.edu/sicp/> is a great book. It gave me idea
382 that you should have wizard powers over your computer, even if it's 8 bit
383 one.
384
385 =head1 COPYRIGHT & LICENSE
386
387 Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
388
389 This program is free software; you can redistribute it and/or modify it
390 under the same terms as Perl itself.
391
392 =cut
393
394 1; # End of VRac

  ViewVC Help
Powered by ViewVC 1.1.26