/[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 64 - (show annotations)
Tue Jul 31 16:33:41 2007 UTC (16 years, 8 months ago) by dpavlin
Original Path: M6502/Orao.pm
File size: 8930 byte(s)
debug and trace shouldn't be remembered
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 confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
304 }
305
306 $self->mmap_pixel( $addr, $byte, 0, 0 );
307
308 $mem[$addr] = $byte;
309 return;
310 }
311
312 =head1 Command Line
313
314 Command-line debugging intrerface is implemented for communication with
315 emulated device
316
317 =head2 prompt
318
319 my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
320
321 =cut
322
323 my $last = 'r 1';
324
325 sub prompt {
326 my $self = shift;
327 $self->app->sync;
328 my $a = shift;
329 print STDERR $self->hexdump( $a ),
330 $last ? "[$last] " : '',
331 "> ";
332 my $in = <STDIN>;
333 chomp($in);
334 warn "## prompt got: $in\n" if $self->debug;
335 $in ||= $last;
336 $last = $in;
337 return ( $in, split(/\s+/, $in) ) if $in;
338 }
339
340 =head2 cli
341
342 $orao->cli();
343
344 =cut
345
346 sub cli {
347 my $self = shift;
348 my $a = $PC || confess "no pc?";
349 while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
350 my $c = shift @v;
351 next unless defined($c);
352 my $v = shift @v;
353 $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
354 @v = map { hex($_) } @v;
355 printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
356 if ( $c =~ m/^[qx]/i ) {
357 exit;
358 } elsif ( $c eq '?' ) {
359 my $t = $self->trace ? 'on' : 'off' ;
360 my $d = $self->debug ? 'on' : 'off' ;
361 warn <<__USAGE__;
362 Usage:
363
364 x|q\t\texit
365 e 6000 6010\tdump memory, +/- to walk forward/backward
366 m 1000 ff 00\tput ff 00 on 1000
367 j|u 1000\t\tjump (change pc)
368 r 42\t\trun 42 instruction opcodes
369 t\t\ttrace [$t]
370 d\t\tdebug [$d]
371
372 __USAGE__
373 warn sprintf(" PC: %04x A:%02x P:%02x X:%02x Y:%02x S:%02x\n", $PC, $A, $P, $X, $Y, $S);
374 } elsif ( $c =~ m/^e/i ) {
375 $a = $v if defined($v);
376 my $to = shift @v;
377 $to = $a + 32 if ( ! $to || $to <= $a );
378 my $lines = int( ($to - $a + 8) / 8 );
379 printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
380 while ( --$lines ) {
381 print $self->hexdump( $a );
382 $a += 8;
383 }
384 $last = '+';
385 } elsif ( $c =~ m/^\+/ ) {
386 $a += 8;
387 } elsif ( $c =~ m/^\-/ ) {
388 $a -= 8;
389 } elsif ( $c =~ m/^m/i ) {
390 $a = $v;
391 $self->poke_code( $a, @v );
392 printf "poke %d bytes at %04x\n", $#v + 1, $a;
393 $last = '+';
394 } elsif ( $c =~ m/^l/i ) {
395 my $to = shift @v || 0x1000;
396 $a = $to;
397 $self->load_oraoemu( $v, $a );
398 $last = '';
399 } elsif ( $c =~ m/^s/i ) {
400 $self->save_dump( $v || 'mem.dump', @v );
401 $last = '';
402 } elsif ( $c =~ m/^r/i ) {
403 $run_for = $v || 1;
404 print "run_for $run_for instructions\n";
405 last;
406 } elsif ( $c =~ m/^(u|j)/ ) {
407 my $to = $v || $a;
408 printf "set pc to %04x\n", $to;
409 $PC = $to; # remember for restart
410 $run_for = 1;
411 $last = "r $run_for";
412 last;
413 } elsif ( $c =~ m/^t/ ) {
414 $self->trace( not $self->trace );
415 print "trace ", $self->trace ? 'on' : 'off', "\n";
416 $last = '';
417 } elsif ( $c =~ m/^d/ ) {
418 $self->debug( not $self->debug );
419 print "debug ", $self->debug ? 'on' : 'off', "\n";
420 $last = '';
421 } else {
422 warn "# ignored $line\n" if ($line);
423 $last = '';
424 }
425 }
426
427 }
428
429 =head1 AUTHOR
430
431 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
432
433 =head1 BUGS
434
435 =head1 ACKNOWLEDGEMENTS
436
437 See also L<http://www.foing.hr/~fng_josip/orao.htm> which is source of all
438 info about this machine (and even hardware implementation from 2007).
439
440 =head1 COPYRIGHT & LICENSE
441
442 Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
443
444 This program is free software; you can redistribute it and/or modify it
445 under the same terms as Perl itself.
446
447 =cut
448
449 1; # End of Orao

  ViewVC Help
Powered by ViewVC 1.1.26