/[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 145 - (show annotations)
Sun Aug 5 13:27:27 2007 UTC (16 years, 7 months ago) by dpavlin
File size: 7064 byte(s)
- sessions which allows you to record your interaction with machine
- tape writer which create file on disk
- improved pod for VRac

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

  ViewVC Help
Powered by ViewVC 1.1.26