/[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 136 - (hide annotations)
Sat Aug 4 22:34:16 2007 UTC (16 years, 7 months ago) by dpavlin
File size: 6481 byte(s)
added links to other components and emulator
1 dpavlin 128 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 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     =cut
33    
34     =head1 FUNCTIONS
35    
36     =head2 run
37    
38     Start emulator, open L<Screen>, load initial ROM images, and start emulator loop
39    
40     my $emu = Orao->new();
41     $emu->run;
42    
43     =cut
44    
45     our $emu;
46    
47     sub run {
48     my $self = shift;
49     confess "please implement $self::run\n";
50     }
51    
52    
53     =head1 Helper functions
54    
55     =head2 load_rom
56    
57     called to init memory and load initial rom images
58    
59     $emu->load_rom;
60    
61     =cut
62    
63     sub load_rom {
64     my ($self, $loaded_files) = @_;
65    
66     #my $time_base = time();
67    
68     foreach my $addr ( sort keys %$loaded_files ) {
69     my $path = $loaded_files->{$addr};
70     $self->load_image( $path, $addr );
71     }
72     }
73    
74     =head2 load_image
75    
76     Load binary files, ROM images and VRac Emulator files
77    
78     $emu->load_image( '/path/to/file', 0x1000 );
79    
80     Returns true on success.
81    
82     =cut
83    
84     sub load_image {
85     my $self = shift;
86     my ( $path, $addr ) = @_;
87    
88     croak "ERROR: file $path doesn't exist\n" if ( ! -e $path );
89    
90     my $size = -s $path || confess "no size for $path: $!";
91    
92     my $buff = read_file( $path );
93    
94     printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
95     $self->write_chunk( $addr, $buff );
96     return 1;
97     };
98    
99     =head2 save_dump
100    
101     $emu->save_dump( 'filename', $from, $to );
102    
103     =cut
104    
105     sub save_dump {
106     my $self = shift;
107    
108     my ( $path, $from, $to ) = @_;
109    
110     $from ||= 0;
111     $to ||= 0xffff;
112    
113     open(my $fh, '>', $path) || die "can't open $path: $!";
114     print $fh $self->read_chunk( $from, $to );
115     close($fh);
116    
117     my $size = -s $path;
118     warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
119     }
120    
121     =head2 hexdump
122    
123     $emu->hexdump( $address );
124    
125     =cut
126    
127     sub hexdump {
128     my $self = shift;
129     my $a = shift;
130     return sprintf(" %04x %s\n", $a,
131     join(" ",
132     map {
133     my $b = $self->read( $a + $_ );
134     if ( defined($b) ) {
135     sprintf( "%02x", $b )
136     } else {
137     ' '
138     }
139     } 0 .. 7
140     )
141     );
142     }
143    
144     =head1 Memory management
145    
146     VRac implements all I/O using mmap addresses. This was main reason why
147     L<Acme::6502> was just too slow to handle it.
148    
149     =cut
150    
151     =head2 read
152    
153     Read from memory
154    
155     $byte = read( $address );
156    
157     =cut
158    
159     sub read {
160     my $self = shift;
161     confess "please implement $self::read()";
162     }
163    
164     =head2 write
165    
166     Write into emory
167    
168     write( $address, $byte );
169    
170     =cut
171    
172     sub write {
173     my $self = shift;
174     confess "please implement $self::write()";
175     }
176    
177     =head1 Command Line
178    
179     Command-line debugging intrerface is implemented for communication with
180     emulated device
181    
182     =head2 prompt
183    
184     my ( $entered_line, @p ) = $emu->prompt( $address, $last_command );
185    
186     =cut
187    
188     my $last = 'r 1';
189    
190     sub prompt {
191     my $self = shift;
192     $self->app->sync;
193     my $a = shift;
194     print $self->hexdump( $a ),
195     $last ? "[$last] " : '',
196     "> ";
197     my $in = <STDIN>;
198     chomp($in);
199     warn "## prompt got: $in\n" if $self->debug;
200     $in ||= $last;
201     $last = $in;
202     return ( $in, split(/\s+/, $in) ) if $in;
203     }
204    
205     =head2 cli
206    
207     my $run_for = $emu->cli;
208    
209     =cut
210    
211     my $show_R = 0;
212    
213     sub cli {
214     my $self = shift;
215     my $a = $self->cpu_PC() || confess "can't find PC";
216     my $run_for = 0;
217     warn $self->dump_R() if $show_R;
218     while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
219     my $c = shift @v;
220     next unless defined($c);
221     my $v = shift @v;
222     $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
223     @v = map { hex($_) } @v;
224     printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
225     if ( $c =~ m/^[qx]/i ) {
226     exit;
227     } elsif ( $c eq '?' ) {
228     my $t = $self->trace ? 'on' : 'off' ;
229     my $d = $self->debug ? 'on' : 'off' ;
230     warn <<__USAGE__;
231     Usage:
232    
233     x|q\t\texit
234     e 6000 6010\tdump memory, +/- to walk forward/backward
235     m 1000 ff 00\tput ff 00 on 1000
236     j|u 1000\t\tjump (change pc)
237     r 42\t\trun 42 instruction opcodes
238     t\t\ttrace [$t]
239     d\t\tdebug [$d]
240    
241     __USAGE__
242     warn $self->dump_R;
243     $last = '';
244     } elsif ( $c =~ m/^e/i ) {
245     $a = $v if defined($v);
246     my $to = shift @v;
247     $to = $a + 32 if ( ! $to || $to <= $a );
248     $to = 0xffff if ( $to > 0xffff );
249     my $lines = int( ($to - $a + 8) / 8 );
250     printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
251     while ( --$lines ) {
252     print $self->hexdump( $a );
253     $a += 8;
254     }
255     $last = '+';
256     $show_R = 0;
257     } elsif ( $c =~ m/^\+/ ) {
258     $a += 8;
259     $show_R = 0;
260     } elsif ( $c =~ m/^\-/ ) {
261     $a -= 8;
262     $show_R = 0;
263     } elsif ( $c =~ m/^m/i ) {
264     $a = $v if defined($v);
265     $self->poke_code( $a, @v );
266     printf "poke %d bytes at %04x\n", $#v + 1, $a;
267     $last = '+';
268     $show_R = 0;
269     } elsif ( $c =~ m/^l/i ) {
270     my $to = shift @v || 0x1000;
271     $a = $to;
272     $self->load_image( $v, $a );
273     $last = '';
274     } elsif ( $c =~ m/^s/i ) {
275     $self->save_dump( $v || 'mem.dump', @v );
276     $last = '';
277     } elsif ( $c =~ m/^re/i ) { # reset
278     M6502::reset();
279     $last = 'r 1';
280     } elsif ( $c =~ m/^r/i ) { # run
281     $run_for = $v || 1;
282     print "run_for $run_for instructions\n";
283     $show_R = 1;
284     last;
285     } elsif ( $c =~ m/^(u|j)/i ) {
286     my $to = $v || $a;
287     # change PC to new address
288     $self->cpu_PC( $to );
289     $run_for = 1;
290     $last = "r $run_for";
291     $show_R = 1;
292     last;
293     } elsif ( $c =~ m/^tape/ ) {
294     if ( $c =~ m/rate/ ) {
295     $self->tape_rate( $v );
296     warn "will read table with rate $v\n";
297     } elsif ( ! $v ) {
298     warn "ERROR: please specify tape name!\n";
299     } elsif ( ! -e $v ) {
300     warn "ERROR: tape $v: $!\n";
301     } else {
302     $self->load_tape( $v );
303     }
304     $last = '';
305     } elsif ( $c =~ m/^t/i ) {
306     $self->trace( not $self->trace );
307     print "trace ", $self->trace ? 'on' : 'off', "\n";
308     $last = '';
309     } elsif ( $c =~ m/^d/i ) {
310     $self->debug( not $self->debug );
311     print "debug ", $self->debug ? 'on' : 'off', "\n";
312     $last = '';
313     } else {
314     warn "# ignored $line\n" if ($line);
315     $last = '';
316     }
317     }
318    
319     return $run_for;
320     }
321    
322 dpavlin 136 =head1 SEE ALSO
323    
324     Components: L<M6502>, L<Z80>, L<Screen>, L<Tape>
325    
326     Emulators: L<Orao>, L<Galaksija>
327    
328 dpavlin 128 =head1 AUTHOR
329    
330     Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
331    
332     =head1 BUGS
333    
334     =head1 ACKNOWLEDGEMENTS
335    
336     =head1 COPYRIGHT & LICENSE
337    
338     Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
339    
340     This program is free software; you can redistribute it and/or modify it
341     under the same terms as Perl itself.
342    
343     =cut
344    
345     1; # End of VRac

  ViewVC Help
Powered by ViewVC 1.1.26