/[VRac]/M6502/Orao.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 /M6502/Orao.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 68 - (show annotations)
Tue Jul 31 17:15:54 2007 UTC (16 years, 8 months ago) by dpavlin
File size: 9015 byte(s)
dump_R now returs registar dump and cli uses it to dump registers state
1 package Orao;
2
3 use warnings;
4 use strict;
5
6 use Carp qw/confess/;
7 use lib './lib';
8 #use Time::HiRes qw(time);
9 use File::Slurp;
10 use Data::Dump qw/dump/;
11 use M6502;
12
13 use base qw(Class::Accessor M6502 Screen Prefs);
14 __PACKAGE__->mk_accessors(qw(run_for));
15
16 =head1 NAME
17
18 Orao - Orao emulator
19
20 =head1 VERSION
21
22 Version 0.02
23
24 =cut
25
26 our $VERSION = '0.02';
27
28 =head1 SUMMARY
29
30 Emulator or Orao 8-bit 6502 machine popular in Croatia
31
32 =cut
33
34 =head2 init
35
36 Start emulator, open L<Screen>, load initial ROM images, and render memory
37
38 =cut
39
40 our $orao;
41
42 select(STDERR); $| = 1;
43
44 sub init {
45 my $self = shift;
46 warn "Orao calling upstream init\n";
47 $self->SUPER::init( $self, @_ );
48
49 warn "Orao $Orao::VERSION emulation starting\n";
50
51 $self->open_screen;
52 $self->load_rom({
53 0x1000 => 'dump/SCRINV.BIN',
54 0xC000 => 'rom/BAS12.ROM',
55 0xE000 => 'rom/CRT12.ROM',
56 });
57
58 $PC = 0xDD11; # BC
59 # $PC = 0xC274; # MC
60
61 $orao = $self;
62
63 # $self->prompt( 0x1000 );
64
65 my ( $trace, $debug ) = ( $self->trace, $self->debug );
66 $self->trace( 0 );
67 $self->debug( 0 );
68
69 if ( $self->show_mem ) {
70
71 warn "rendering memory map\n";
72
73 my @mmap = (
74 0x0000, 0x03FF, 'nulti blok',
75 0x0400, 0x5FFF, 'korisnièki RAM (23K)',
76 0x6000, 0x7FFF, 'video RAM',
77 0x8000, 0x9FFF, 'sistemske lokacije',
78 0xA000, 0xAFFF, 'ekstenzija',
79 0xB000, 0xBFFF, 'DOS',
80 0xC000, 0xDFFF, 'BASIC ROM',
81 0xE000, 0xFFFF, 'sistemski ROM',
82 );
83
84 foreach my $i ( 0 .. $#mmap / 3 ) {
85 my $o = $i * 3;
86 my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];
87 printf "%04x - %04x - %s\n", $from, $to, $desc;
88 for my $a ( $from .. $to ) {
89 if ( $a >= 0x6000 && $a < 0x8000 ) {
90 my $b = $self->read( $a );
91 $self->vram( $a - 0x6000, $b );
92 } else {
93 $self->read( $a );
94 }
95 }
96 }
97
98 } else {
99
100 warn "rendering video memory\n";
101 for my $a ( 0x6000 .. 0x7fff ) {
102 $self->vram( $a - 0x6000, $mem[$a] );
103 }
104
105 }
106 $self->sync;
107 $self->trace( $trace );
108 $self->debug( $debug );
109
110 #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
111
112 warn "Orao init finished",
113 $self->trace ? ' trace' : '',
114 $self->debug ? ' debug' : '',
115 "\n";
116
117 }
118
119 =head2 load_rom
120
121 called to init memory and load initial rom images
122
123 $orao->load_rom;
124
125 =cut
126
127 sub load_rom {
128 my ($self, $loaded_files) = @_;
129
130 #my $time_base = time();
131
132 foreach my $addr ( sort keys %$loaded_files ) {
133 my $path = $loaded_files->{$addr};
134 $self->load_oraoemu( $path, $addr );
135 }
136 }
137
138 # write chunk directly into memory, updateing vram if needed
139 sub _write_chunk {
140 my $self = shift;
141 my ( $addr, $chunk ) = @_;
142 $self->write_chunk( $addr, $chunk );
143 my $end = $addr + length($chunk);
144 my ( $f, $t ) = ( 0x6000, 0x7fff );
145
146 if ( $end < $f || $addr >= $t ) {
147 warn "skip vram update\n";
148 return;
149 };
150
151 $f = $addr if ( $addr > $f );
152 $t = $end if ( $end < $t );
153
154 warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
155 foreach my $a ( $f .. $t ) {
156 $self->vram( $a - 0x6000 , $mem[ $a ] );
157 }
158 }
159
160 =head2 load_oraoemu
161
162 Load binary files, ROM images and Orao Emulator files
163
164 $orao->load_oraoemu( '/path/to/file', 0x1000 );
165
166 Returns true on success.
167
168 =cut
169
170 sub load_oraoemu {
171 my $self = shift;
172 my ( $path, $addr ) = @_;
173
174 if ( ! -e $path ) {
175 warn "ERROR: file $path doesn't exist\n";
176 return;
177 }
178
179 my $size = -s $path || confess "no size for $path: $!";
180
181 my $buff = read_file( $path );
182
183 if ( $size == 65538 ) {
184 $addr = 0;
185 warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
186 $self->_write_chunk( $addr, substr($buff,2) );
187 return 1;
188 } elsif ( $size == 32800 ) {
189 $addr = 0;
190 warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
191 $self->_write_chunk( $addr, substr($buff,0x20) );
192 return 1;
193 }
194 printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
195 $self->_write_chunk( $addr, $buff );
196 return 1;
197
198 my $chunk;
199
200 my $pos = 0;
201
202 while ( my $long = substr($buff,$pos,4) ) {
203 my @b = split(//, $long, 4);
204 $chunk .=
205 ( $b[3] || '' ) .
206 ( $b[2] || '' ) .
207 ( $b[1] || '' ) .
208 ( $b[0] || '' );
209 $pos += 4;
210 }
211
212 $self->_write_chunk( $addr, $chunk );
213
214 return 1;
215 };
216
217 =head2 save_dump
218
219 $orao->save_dump( 'filename', $from, $to );
220
221 =cut
222
223 sub save_dump {
224 my $self = shift;
225
226 my ( $path, $from, $to ) = @_;
227
228 $from ||= 0;
229 $to ||= 0xffff;
230
231 open(my $fh, '>', $path) || die "can't open $path: $!";
232 print $fh $self->read_chunk( $from, $to );
233 close($fh);
234
235 my $size = -s $path;
236 warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
237 }
238
239 =head2 hexdump
240
241 $orao->hexdump( $address );
242
243 =cut
244
245 sub hexdump {
246 my $self = shift;
247 my $a = shift;
248 return sprintf(" %04x %s\n", $a,
249 join(" ",
250 map {
251 sprintf( "%02x", $_ )
252 } @mem[ $a .. $a+8 ]
253 )
254 );
255 }
256
257 =head1 Memory management
258
259 Orao implements all I/O using mmap addresses. This was main reason why
260 L<Acme::6502> was just too slow to handle it.
261
262 =cut
263
264 =head2 read
265
266 Read from memory
267
268 $byte = read( $address );
269
270 =cut
271
272 sub read {
273 my $self = shift;
274 my ($addr) = @_;
275 my $byte = $mem[$addr];
276 warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
277 $self->mmap_pixel( $addr, 0, $byte, 0 );
278 return $byte;
279 }
280
281 =head2 write
282
283 Write into emory
284
285 write( $address, $byte );
286
287 =cut
288
289 sub write {
290 my $self = shift;
291 my ($addr,$byte) = @_;
292 warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
293
294 if ( $addr >= 0x6000 && $addr < 0x8000 ) {
295 $self->vram( $addr - 0x6000 , $byte );
296 }
297
298 if ( $addr == 0x8800 ) {
299 warn sprintf "sound ignored: %x\n", $byte;
300 }
301
302 if ( $addr > 0xafff ) {
303 warn sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
304 return;
305 }
306
307 $self->mmap_pixel( $addr, $byte, 0, 0 );
308
309 $mem[$addr] = $byte;
310 return;
311 }
312
313 =head1 Command Line
314
315 Command-line debugging intrerface is implemented for communication with
316 emulated device
317
318 =head2 prompt
319
320 my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
321
322 =cut
323
324 my $last = 'r 1';
325
326 sub prompt {
327 my $self = shift;
328 $self->app->sync;
329 my $a = shift;
330 print STDERR $self->hexdump( $a ),
331 $last ? "[$last] " : '',
332 "> ";
333 my $in = <STDIN>;
334 chomp($in);
335 warn "## prompt got: $in\n" if $self->debug;
336 $in ||= $last;
337 $last = $in;
338 return ( $in, split(/\s+/, $in) ) if $in;
339 }
340
341 =head2 cli
342
343 $orao->cli();
344
345 =cut
346
347 my $show_R = 0;
348
349 sub cli {
350 my $self = shift;
351 my $a = $PC || confess "no pc?";
352 warn $self->dump_R() if $show_R;
353 while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
354 my $c = shift @v;
355 next unless defined($c);
356 my $v = shift @v;
357 $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
358 @v = map { hex($_) } @v;
359 printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
360 if ( $c =~ m/^[qx]/i ) {
361 exit;
362 } elsif ( $c eq '?' ) {
363 my $t = $self->trace ? 'on' : 'off' ;
364 my $d = $self->debug ? 'on' : 'off' ;
365 warn <<__USAGE__;
366 Usage:
367
368 x|q\t\texit
369 e 6000 6010\tdump memory, +/- to walk forward/backward
370 m 1000 ff 00\tput ff 00 on 1000
371 j|u 1000\t\tjump (change pc)
372 r 42\t\trun 42 instruction opcodes
373 t\t\ttrace [$t]
374 d\t\tdebug [$d]
375
376 __USAGE__
377 warn $self->dump_R;
378 } elsif ( $c =~ m/^e/i ) {
379 $a = $v if defined($v);
380 my $to = shift @v;
381 $to = $a + 32 if ( ! $to || $to <= $a );
382 my $lines = int( ($to - $a + 8) / 8 );
383 printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
384 while ( --$lines ) {
385 print $self->hexdump( $a );
386 $a += 8;
387 }
388 $last = '+';
389 $show_R = 0;
390 } elsif ( $c =~ m/^\+/ ) {
391 $a += 8;
392 $show_R = 0;
393 } elsif ( $c =~ m/^\-/ ) {
394 $a -= 8;
395 $show_R = 0;
396 } elsif ( $c =~ m/^m/i ) {
397 $a = $v;
398 $self->poke_code( $a, @v );
399 printf "poke %d bytes at %04x\n", $#v + 1, $a;
400 $last = '+';
401 $show_R = 0;
402 } elsif ( $c =~ m/^l/i ) {
403 my $to = shift @v || 0x1000;
404 $a = $to;
405 $self->load_oraoemu( $v, $a );
406 $last = '';
407 } elsif ( $c =~ m/^s/i ) {
408 $self->save_dump( $v || 'mem.dump', @v );
409 $last = '';
410 } elsif ( $c =~ m/^r/i ) {
411 $run_for = $v || 1;
412 print "run_for $run_for instructions\n";
413 $show_R = 1;
414 last;
415 } elsif ( $c =~ m/^(u|j)/ ) {
416 my $to = $v || $a;
417 printf "set pc to %04x\n", $to;
418 $PC = $to; # remember for restart
419 $run_for = 1;
420 $last = "r $run_for";
421 $show_R = 1;
422 last;
423 } elsif ( $c =~ m/^t/ ) {
424 $self->trace( not $self->trace );
425 print "trace ", $self->trace ? 'on' : 'off', "\n";
426 $last = '';
427 } elsif ( $c =~ m/^d/ ) {
428 $self->debug( not $self->debug );
429 print "debug ", $self->debug ? 'on' : 'off', "\n";
430 $last = '';
431 } else {
432 warn "# ignored $line\n" if ($line);
433 $last = '';
434 }
435 }
436
437 }
438
439 =head1 AUTHOR
440
441 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
442
443 =head1 BUGS
444
445 =head1 ACKNOWLEDGEMENTS
446
447 See also L<http://www.foing.hr/~fng_josip/orao.htm> which is source of all
448 info about this machine (and even hardware implementation from 2007).
449
450 =head1 COPYRIGHT & LICENSE
451
452 Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
453
454 This program is free software; you can redistribute it and/or modify it
455 under the same terms as Perl itself.
456
457 =cut
458
459 1; # End of Orao

  ViewVC Help
Powered by ViewVC 1.1.26