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

  ViewVC Help
Powered by ViewVC 1.1.26