/[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 89 - (show annotations)
Thu Aug 2 12:01:09 2007 UTC (16 years, 8 months ago) by dpavlin
File size: 10778 byte(s)
Remove all traces of older attempt to embed perl into CPU emulation module
and move forward to just using it via XS bindings
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 }
123
124 =head2 load_rom
125
126 called to init memory and load initial rom images
127
128 $orao->load_rom;
129
130 =cut
131
132 sub load_rom {
133 my ($self, $loaded_files) = @_;
134
135 #my $time_base = time();
136
137 foreach my $addr ( sort keys %$loaded_files ) {
138 my $path = $loaded_files->{$addr};
139 $self->load_oraoemu( $path, $addr );
140 }
141 }
142
143 # write chunk directly into memory, updateing vram if needed
144 sub _write_chunk {
145 my $self = shift;
146 my ( $addr, $chunk ) = @_;
147 $self->write_chunk( $addr, $chunk );
148 my $end = $addr + length($chunk);
149 my ( $f, $t ) = ( 0x6000, 0x7fff );
150
151 if ( $end < $f || $addr >= $t ) {
152 warn "skip vram update\n";
153 return;
154 };
155
156 $f = $addr if ( $addr > $f );
157 $t = $end if ( $end < $t );
158
159 warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
160 # foreach my $a ( $f .. $t ) {
161 # $self->vram( $a - 0x6000 , $mem[ $a ] );
162 # }
163 $self->render( @mem[ 0x6000 .. 0x7fff ] );
164 $self->render_mem( @mem ) if $self->show_mem;
165 }
166
167 =head2 load_oraoemu
168
169 Load binary files, ROM images and Orao Emulator files
170
171 $orao->load_oraoemu( '/path/to/file', 0x1000 );
172
173 Returns true on success.
174
175 =cut
176
177 sub load_oraoemu {
178 my $self = shift;
179 my ( $path, $addr ) = @_;
180
181 if ( ! -e $path ) {
182 warn "ERROR: file $path doesn't exist\n";
183 return;
184 }
185
186 my $size = -s $path || confess "no size for $path: $!";
187
188 my $buff = read_file( $path );
189
190 if ( $size == 65538 ) {
191 $addr = 0;
192 warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
193 $self->_write_chunk( $addr, substr($buff,2) );
194 return 1;
195 } elsif ( $size == 32800 ) {
196 $addr = 0;
197 warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
198 $self->_write_chunk( $addr, substr($buff,0x20) );
199 return 1;
200 }
201 printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
202 $self->_write_chunk( $addr, $buff );
203 return 1;
204
205 my $chunk;
206
207 my $pos = 0;
208
209 while ( my $long = substr($buff,$pos,4) ) {
210 my @b = split(//, $long, 4);
211 $chunk .=
212 ( $b[3] || '' ) .
213 ( $b[2] || '' ) .
214 ( $b[1] || '' ) .
215 ( $b[0] || '' );
216 $pos += 4;
217 }
218
219 $self->_write_chunk( $addr, $chunk );
220
221 return 1;
222 };
223
224 =head2 save_dump
225
226 $orao->save_dump( 'filename', $from, $to );
227
228 =cut
229
230 sub save_dump {
231 my $self = shift;
232
233 my ( $path, $from, $to ) = @_;
234
235 $from ||= 0;
236 $to ||= 0xffff;
237
238 open(my $fh, '>', $path) || die "can't open $path: $!";
239 print $fh $self->read_chunk( $from, $to );
240 close($fh);
241
242 my $size = -s $path;
243 warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
244 }
245
246 =head2 hexdump
247
248 $orao->hexdump( $address );
249
250 =cut
251
252 sub hexdump {
253 my $self = shift;
254 my $a = shift;
255 return sprintf(" %04x %s\n", $a,
256 join(" ",
257 map {
258 if ( defined($_) ) {
259 sprintf( "%02x", $_ )
260 } else {
261 ' '
262 }
263 } @mem[ $a .. $a+8 ]
264 )
265 );
266 }
267
268 =head1 Memory management
269
270 Orao implements all I/O using mmap addresses. This was main reason why
271 L<Acme::6502> was just too slow to handle it.
272
273 =cut
274
275 =head2 read
276
277 Read from memory
278
279 $byte = read( $address );
280
281 =cut
282
283 sub read {
284 my $self = shift;
285 my ($addr) = @_;
286 my $byte = $mem[$addr];
287 confess sprintf("can't find memory at address %04x",$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