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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 71 - (show annotations)
Tue Jul 31 17:42:03 2007 UTC (16 years, 8 months ago) by dpavlin
Original Path: M6502/Orao.pm
File size: 9122 byte(s)
other minor tweaks: j ff89 works for the first time!
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 if ( defined($_) ) {
252 sprintf( "%02x", $_ )
253 } else {
254 ' '
255 }
256 } @mem[ $a .. $a+8 ]
257 )
258 );
259 }
260
261 =head1 Memory management
262
263 Orao implements all I/O using mmap addresses. This was main reason why
264 L<Acme::6502> was just too slow to handle it.
265
266 =cut
267
268 =head2 read
269
270 Read from memory
271
272 $byte = read( $address );
273
274 =cut
275
276 sub read {
277 my $self = shift;
278 my ($addr) = @_;
279 my $byte = $mem[$addr];
280 warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
281 $self->mmap_pixel( $addr, 0, $byte, 0 );
282 return $byte;
283 }
284
285 =head2 write
286
287 Write into emory
288
289 write( $address, $byte );
290
291 =cut
292
293 sub write {
294 my $self = shift;
295 my ($addr,$byte) = @_;
296 warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
297
298 if ( $addr >= 0x6000 && $addr < 0x8000 ) {
299 $self->vram( $addr - 0x6000 , $byte );
300 }
301
302 if ( $addr == 0x8800 ) {
303 warn sprintf "sound ignored: %x\n", $byte;
304 }
305
306 if ( $addr > 0xafff ) {
307 warn sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
308 return;
309 }
310
311 $self->mmap_pixel( $addr, $byte, 0, 0 );
312
313 $mem[$addr] = $byte;
314 return;
315 }
316
317 =head1 Command Line
318
319 Command-line debugging intrerface is implemented for communication with
320 emulated device
321
322 =head2 prompt
323
324 my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
325
326 =cut
327
328 my $last = 'r 1';
329
330 sub prompt {
331 my $self = shift;
332 $self->app->sync;
333 my $a = shift;
334 print STDERR $self->hexdump( $a ),
335 $last ? "[$last] " : '',
336 "> ";
337 my $in = <STDIN>;
338 chomp($in);
339 warn "## prompt got: $in\n" if $self->debug;
340 $in ||= $last;
341 $last = $in;
342 return ( $in, split(/\s+/, $in) ) if $in;
343 }
344
345 =head2 cli
346
347 $orao->cli();
348
349 =cut
350
351 my $show_R = 0;
352
353 sub cli {
354 my $self = shift;
355 my $a = $PC || confess "no pc?";
356 warn $self->dump_R() if $show_R;
357 while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
358 my $c = shift @v;
359 next unless defined($c);
360 my $v = shift @v;
361 $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
362 @v = map { hex($_) } @v;
363 printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
364 if ( $c =~ m/^[qx]/i ) {
365 exit;
366 } elsif ( $c eq '?' ) {
367 my $t = $self->trace ? 'on' : 'off' ;
368 my $d = $self->debug ? 'on' : 'off' ;
369 warn <<__USAGE__;
370 Usage:
371
372 x|q\t\texit
373 e 6000 6010\tdump memory, +/- to walk forward/backward
374 m 1000 ff 00\tput ff 00 on 1000
375 j|u 1000\t\tjump (change pc)
376 r 42\t\trun 42 instruction opcodes
377 t\t\ttrace [$t]
378 d\t\tdebug [$d]
379
380 __USAGE__
381 warn $self->dump_R;
382 } elsif ( $c =~ m/^e/i ) {
383 $a = $v if defined($v);
384 my $to = shift @v;
385 $to = $a + 32 if ( ! $to || $to <= $a );
386 $to = 0xffff if ( $to > 0xffff );
387 my $lines = int( ($to - $a + 8) / 8 );
388 printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
389 while ( --$lines ) {
390 print $self->hexdump( $a );
391 $a += 8;
392 }
393 $last = '+';
394 $show_R = 0;
395 } elsif ( $c =~ m/^\+/ ) {
396 $a += 8;
397 $show_R = 0;
398 } elsif ( $c =~ m/^\-/ ) {
399 $a -= 8;
400 $show_R = 0;
401 } elsif ( $c =~ m/^m/i ) {
402 $a = $v if defined($v);
403 $self->poke_code( $a, @v );
404 printf "poke %d bytes at %04x\n", $#v + 1, $a;
405 $last = '+';
406 $show_R = 0;
407 } elsif ( $c =~ m/^l/i ) {
408 my $to = shift @v || 0x1000;
409 $a = $to;
410 $self->load_oraoemu( $v, $a );
411 $last = '';
412 } elsif ( $c =~ m/^s/i ) {
413 $self->save_dump( $v || 'mem.dump', @v );
414 $last = '';
415 } elsif ( $c =~ m/^r/i ) {
416 $run_for = $v || 1;
417 print "run_for $run_for instructions\n";
418 $show_R = 1;
419 last;
420 } elsif ( $c =~ m/^(u|j)/ ) {
421 my $to = $v || $a;
422 printf "set pc to %04x\n", $to;
423 $PC = $to; # remember for restart
424 $run_for = 1;
425 $last = "r $run_for";
426 $show_R = 1;
427 last;
428 } elsif ( $c =~ m/^t/ ) {
429 $self->trace( not $self->trace );
430 print "trace ", $self->trace ? 'on' : 'off', "\n";
431 $last = '';
432 } elsif ( $c =~ m/^d/ ) {
433 $self->debug( not $self->debug );
434 print "debug ", $self->debug ? 'on' : 'off', "\n";
435 $last = '';
436 } else {
437 warn "# ignored $line\n" if ($line);
438 $last = '';
439 }
440 }
441
442 }
443
444 =head1 AUTHOR
445
446 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
447
448 =head1 BUGS
449
450 =head1 ACKNOWLEDGEMENTS
451
452 See also L<http://www.foing.hr/~fng_josip/orao.htm> which is source of all
453 info about this machine (and even hardware implementation from 2007).
454
455 =head1 COPYRIGHT & LICENSE
456
457 Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
458
459 This program is free software; you can redistribute it and/or modify it
460 under the same terms as Perl itself.
461
462 =cut
463
464 1; # End of Orao

  ViewVC Help
Powered by ViewVC 1.1.26