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

  ViewVC Help
Powered by ViewVC 1.1.26