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

  ViewVC Help
Powered by ViewVC 1.1.26