/[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 169 - (show annotations)
Mon Aug 6 09:20:20 2007 UTC (16 years, 7 months ago) by dpavlin
File size: 7910 byte(s)
implement tape_status and report it in cli under '?'
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 <<__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
286 __USAGE__
287 print $self->tape_status if $self->can('tape_status');
288 print $self->dump_R;
289 $last = '';
290 } elsif ( $c =~ m/^e/i ) {
291 $a = $v if defined($v);
292 my $to = shift @v;
293 $to = $a + 32 if ( ! $to || $to <= $a );
294 $to = 0xffff if ( $to > 0xffff );
295 my $lines = int( ($to - $a + 8) / 8 );
296 printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
297 while ( --$lines ) {
298 print $self->hexdump( $a );
299 $a += 8;
300 }
301 $last = '+';
302 $show_R = 0;
303 } elsif ( $c =~ m/^\+/ ) {
304 $a += 8;
305 $show_R = 0;
306 } elsif ( $c =~ m/^\-/ ) {
307 $a -= 8;
308 $show_R = 0;
309 } elsif ( $c =~ m/^m/i ) {
310 $a = $v if defined($v);
311 $self->poke_code( $a, @v );
312 printf "poke %d bytes at %04x\n", $#v + 1, $a;
313 $last = '+';
314 $show_R = 0;
315 } elsif ( $c =~ m/^l/i ) {
316 my $to = shift @v || 0x1000;
317 $a = $to;
318 $self->load_image( $v, $a );
319 $last = '';
320 } elsif ( $c =~ m/^s/i ) {
321 $self->save_dump( $v || 'mem.dump', @v );
322 $last = '';
323 } elsif ( $c =~ m/^re/i ) { # reset
324 M6502::reset();
325 $last = 'r 1';
326 } elsif ( $c =~ m/^r/i ) { # run
327 $run_for = $v || 1;
328 print "run_for $run_for instructions\n";
329 $show_R = 1;
330 last;
331 } elsif ( $c =~ m/^(u|j)/i ) {
332 my $to = $v || $a;
333 # change PC to new address
334 $self->cpu_PC( $to );
335 $run_for = 1;
336 $last = "r $run_for";
337 $show_R = 1;
338 last;
339 } elsif ( $c =~ m/^tape/ ) {
340 if ( ! $v ) {
341 warn "ERROR: please specify tape name!\n";
342 } elsif ( ! -e $v ) {
343 warn "ERROR: tape $v: $!\n";
344 } else {
345 $self->load_tape( $v );
346 }
347 $last = '';
348 } elsif ( $c =~ m/^t/i ) {
349 $self->trace( not $self->trace );
350 print "trace ", $self->trace ? 'on' : 'off', "\n";
351 $last = '';
352 } elsif ( $c =~ m/^d/i ) {
353 $self->debug( not $self->debug );
354 print "debug ", $self->debug ? 'on' : 'off', "\n";
355 $last = '';
356 } else {
357 warn "# ignored $line\n" if ($line);
358 $last = '';
359 }
360 }
361
362 return $run_for;
363 }
364
365 =head1 SEE ALSO
366
367 Components: L<M6502>, L<Z80>, L<Screen>, L<Tape>, L<Session>
368
369 Emulators: L<Orao>, L<Galaksija>
370
371 L<References> about different architectures
372
373 =head1 AUTHOR
374
375 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
376
377 =head1 ACKNOWLEDGEMENTS
378
379 Structure and Interpretation of Computer Programs by Abelson, Sussman, and
380 Sussman L<http://mitpress.mit.edu/sicp/> is a great book. It gave me idea
381 that you should have wizard powers over your computer, even if it's 8 bit
382 one.
383
384 =head1 COPYRIGHT & LICENSE
385
386 Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
387
388 This program is free software; you can redistribute it and/or modify it
389 under the same terms as Perl itself.
390
391 =cut
392
393 1; # End of VRac

  ViewVC Help
Powered by ViewVC 1.1.26