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

Annotation of /VRac.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 211 - (hide annotations)
Mon Apr 14 21:26:16 2008 UTC (11 years ago) by dpavlin
File size: 7970 byte(s)
fix usage, tape now has beginning offset as optional argument
1 dpavlin 128 package VRac;
2    
3     use warnings;
4     use strict;
5    
6 dpavlin 156 use Carp qw/confess croak cluck carp/;
7 dpavlin 128 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 dpavlin 134 VRac - Virtualno Rańćunalo
16 dpavlin 128
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 dpavlin 134 from 1980-1990. Word B<vrac> means also I<wizard> in Croatian.
31 dpavlin 128
32 dpavlin 148 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 dpavlin 128 =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 dpavlin 145 =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 dpavlin 128 =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 dpavlin 145 if ( open(my $fh, '>', $path) ) {
159     print $fh $self->read_chunk( $from, $to );
160     close($fh);
161 dpavlin 128
162 dpavlin 145 my $size = -s $path;
163 dpavlin 169 print sprintf "saved %s %04x-%04x %d %x bytes\n", $path, $from, $to, $size, $size;
164 dpavlin 145 } else {
165     warn "can't create $path: $!";
166     }
167    
168 dpavlin 128 }
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 dpavlin 145 =head2 append_to_file
194 dpavlin 128
195 dpavlin 145 $self->append_to_file( '/path/to/file', $byte, $byte ... );
196 dpavlin 128
197     =cut
198    
199 dpavlin 145 sub append_to_file {
200 dpavlin 128 my $self = shift;
201 dpavlin 145 my $path = shift || confess "no path?";
202     my $bytes = join('', @_);
203 dpavlin 128
204 dpavlin 156 my $size = -s $path || 0;
205     my $len = length($bytes);
206    
207 dpavlin 145 open(my $fh, '>>', $path) || confess "can't open $path: $!";
208 dpavlin 156 print($fh $bytes);
209     my $pos = tell($fh);
210 dpavlin 128
211 dpavlin 156 my $expected = $size + $len;
212     if ( $pos != $expected ) {
213 dpavlin 162 #cluck "BUG: file grows too big got $pos, expected $expected !";
214 dpavlin 156 truncate $fh, $expected;
215     }
216    
217     close($fh);
218    
219 dpavlin 145 warn sprintf("## append_to_file('%s',%s)\n", $path, dump($bytes));
220 dpavlin 128 }
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 dpavlin 169 print $self->dump_R() if $show_R;
263 dpavlin 128 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 dpavlin 211 print <<__USAGE__;
276 dpavlin 128 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 dpavlin 211 tape name 168\tload tape and start at offset
286 dpavlin 128
287     __USAGE__
288 dpavlin 169 print $self->tape_status if $self->can('tape_status');
289     print $self->dump_R;
290 dpavlin 128 $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 dpavlin 169 if ( ! $v ) {
342 dpavlin 128 warn "ERROR: please specify tape name!\n";
343     } elsif ( ! -e $v ) {
344     warn "ERROR: tape $v: $!\n";
345     } else {
346 dpavlin 211 $self->load_tape( $v, shift @v );
347 dpavlin 128 }
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 dpavlin 136 =head1 SEE ALSO
367    
368 dpavlin 157 Components: L<M6502>, L<Z80>, L<Screen>, L<Tape>, L<Session>
369 dpavlin 136
370     Emulators: L<Orao>, L<Galaksija>
371    
372 dpavlin 169 L<References> about different architectures
373    
374 dpavlin 128 =head1 AUTHOR
375    
376     Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
377    
378     =head1 ACKNOWLEDGEMENTS
379    
380 dpavlin 148 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 dpavlin 128 =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