/[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 162 - (hide annotations)
Sun Aug 5 20:01:44 2007 UTC (16 years, 7 months ago) by dpavlin
File size: 7910 byte(s)
yes, I know about a bug :-)
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     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 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     warn $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     warn <<__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     warn $self->dump_R;
288     $last = '';
289     } elsif ( $c =~ m/^e/i ) {
290     $a = $v if defined($v);
291     my $to = shift @v;
292     $to = $a + 32 if ( ! $to || $to <= $a );
293     $to = 0xffff if ( $to > 0xffff );
294     my $lines = int( ($to - $a + 8) / 8 );
295     printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
296     while ( --$lines ) {
297     print $self->hexdump( $a );
298     $a += 8;
299     }
300     $last = '+';
301     $show_R = 0;
302     } elsif ( $c =~ m/^\+/ ) {
303     $a += 8;
304     $show_R = 0;
305     } elsif ( $c =~ m/^\-/ ) {
306     $a -= 8;
307     $show_R = 0;
308     } elsif ( $c =~ m/^m/i ) {
309     $a = $v if defined($v);
310     $self->poke_code( $a, @v );
311     printf "poke %d bytes at %04x\n", $#v + 1, $a;
312     $last = '+';
313     $show_R = 0;
314     } elsif ( $c =~ m/^l/i ) {
315     my $to = shift @v || 0x1000;
316     $a = $to;
317     $self->load_image( $v, $a );
318     $last = '';
319     } elsif ( $c =~ m/^s/i ) {
320     $self->save_dump( $v || 'mem.dump', @v );
321     $last = '';
322     } elsif ( $c =~ m/^re/i ) { # reset
323     M6502::reset();
324     $last = 'r 1';
325     } elsif ( $c =~ m/^r/i ) { # run
326     $run_for = $v || 1;
327     print "run_for $run_for instructions\n";
328     $show_R = 1;
329     last;
330     } elsif ( $c =~ m/^(u|j)/i ) {
331     my $to = $v || $a;
332     # change PC to new address
333     $self->cpu_PC( $to );
334     $run_for = 1;
335     $last = "r $run_for";
336     $show_R = 1;
337     last;
338     } elsif ( $c =~ m/^tape/ ) {
339     if ( $c =~ m/rate/ ) {
340     $self->tape_rate( $v );
341     warn "will read table with rate $v\n";
342     } elsif ( ! $v ) {
343     warn "ERROR: please specify tape name!\n";
344     } elsif ( ! -e $v ) {
345     warn "ERROR: tape $v: $!\n";
346     } else {
347     $self->load_tape( $v );
348     }
349     $last = '';
350     } elsif ( $c =~ m/^t/i ) {
351     $self->trace( not $self->trace );
352     print "trace ", $self->trace ? 'on' : 'off', "\n";
353     $last = '';
354     } elsif ( $c =~ m/^d/i ) {
355     $self->debug( not $self->debug );
356     print "debug ", $self->debug ? 'on' : 'off', "\n";
357     $last = '';
358     } else {
359     warn "# ignored $line\n" if ($line);
360     $last = '';
361     }
362     }
363    
364     return $run_for;
365     }
366    
367 dpavlin 136 =head1 SEE ALSO
368    
369 dpavlin 157 Components: L<M6502>, L<Z80>, L<Screen>, L<Tape>, L<Session>
370 dpavlin 136
371     Emulators: L<Orao>, L<Galaksija>
372    
373 dpavlin 128 =head1 AUTHOR
374    
375     Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
376    
377     =head1 ACKNOWLEDGEMENTS
378    
379 dpavlin 148 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 dpavlin 128 =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