/[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 49 - (show annotations)
Tue Jul 31 10:52:06 2007 UTC (16 years, 8 months ago) by dpavlin
Original Path: M6502/Orao.pm
File size: 8239 byte(s)
- trace and debug are off during init phase (to speed up things)
1 package Orao;
2
3 use warnings;
4 use strict;
5
6 use Carp;
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);
14 __PACKAGE__->mk_accessors(qw(debug trace run_for mem_dump trace));
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
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 "staring Orao $Orao::VERSION emulation\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
139 =head2 load_oraoemu
140
141 =cut
142
143 sub _write_chunk {
144 my $self = shift;
145 my ( $addr, $chunk ) = @_;
146 $self->write_chunk( $addr, $chunk );
147 my $end = $addr + length($chunk);
148 my ( $f, $t ) = ( 0x6000, 0x7fff );
149
150 if ( $end < $f || $addr >= $t ) {
151 warn "skip vram update\n";
152 return;
153 };
154
155 $f = $addr if ( $addr > $f );
156 $t = $end if ( $end < $t );
157
158 warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
159 foreach my $a ( $f .. $t ) {
160 $self->vram( $a - 0x6000 , $mem[ $a ] );
161 }
162 }
163
164 sub load_oraoemu {
165 my $self = shift;
166 my ( $path, $addr ) = @_;
167
168 my $size = -s $path || confess "no size for $path: $!";
169
170 my $buff = read_file( $path );
171
172 if ( $size == 65538 ) {
173 $addr = 0;
174 warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
175 $self->_write_chunk( $addr, substr($buff,2) );
176 return;
177 } elsif ( $size == 32800 ) {
178 $addr = 0;
179 warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
180 $self->_write_chunk( $addr, substr($buff,0x20) );
181 return;
182 }
183 printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
184 return $self->_write_chunk( $addr, $buff );
185
186 my $chunk;
187
188 my $pos = 0;
189
190 while ( my $long = substr($buff,$pos,4) ) {
191 my @b = split(//, $long, 4);
192 $chunk .=
193 ( $b[3] || '' ) .
194 ( $b[2] || '' ) .
195 ( $b[1] || '' ) .
196 ( $b[0] || '' );
197 $pos += 4;
198 }
199
200 $self->_write_chunk( $addr, $chunk );
201
202 };
203
204 =head2 save_dump
205
206 $orao->save_dump( 'filename', $from, $to );
207
208 =cut
209
210 sub save_dump {
211 my $self = shift;
212
213 my ( $path, $from, $to ) = @_;
214
215 $from ||= 0;
216 $to ||= 0xffff;
217
218 open(my $fh, '>', $path) || die "can't open $path: $!";
219 print $fh $self->read_chunk( $from, $to );
220 close($fh);
221
222 my $size = -s $path;
223 warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
224 }
225
226 =head2 hexdump
227
228 $orao->hexdump( $address );
229
230 =cut
231
232 sub hexdump {
233 my $self = shift;
234 my $a = shift;
235 return sprintf(" %04x %s\n", $a,
236 join(" ",
237 map {
238 sprintf( "%02x", $_ )
239 } @mem[ $a .. $a+8 ]
240 )
241 );
242 }
243
244 =head2 prompt
245
246 $orao->prompt( $address, $last_command );
247
248 =cut
249
250 sub prompt {
251 my $self = shift;
252 $self->app->sync;
253 my $a = shift;
254 my $last = shift;
255 print STDERR $self->hexdump( $a ),
256 $last ? "[$last] " : '',
257 "> ";
258 my $in = <STDIN>;
259 chomp($in);
260 warn "## prompt got: $in\n" if $self->debug;
261 $in ||= $last;
262 $last = $in;
263 return split(/\s+/, $in) if $in;
264 }
265
266 =head1 Memory management
267
268 Orao implements all I/O using mmap addresses. This was main reason why
269 L<Acme::6502> was just too slow to handle it.
270
271 =cut
272
273 =head2 read
274
275 Read from memory
276
277 $byte = read( $address );
278
279 =cut
280
281 sub read {
282 my $self = shift;
283 my ($addr) = @_;
284 my $byte = $mem[$addr];
285 warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
286 $self->mmap_pixel( $addr, 0, $byte, 0 );
287 return $byte;
288 }
289
290 =head2 write
291
292 Write into emory
293
294 write( $address, $byte );
295
296 =cut
297
298 sub write {
299 my $self = shift;
300 my ($addr,$byte) = @_;
301 warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
302
303 if ( $addr >= 0x6000 && $addr < 0x8000 ) {
304 $self->vram( $addr - 0x6000 , $byte );
305 }
306
307 if ( $addr > 0xafff ) {
308 warn sprintf "access to %04x above affff aborting\n", $addr;
309 return -1;
310 }
311 if ( $addr == 0x8800 ) {
312 warn sprintf "sound ignored: %x\n", $byte;
313 }
314
315 $self->mmap_pixel( $addr, $byte, 0, 0 );
316
317 $mem[$addr] = $byte;
318 return;
319 }
320
321 =head1 Command Line
322
323 Command-line debugging intrerface is implemented for communication with
324 emulated device
325
326 =head2 cli
327
328 $orao->cli();
329
330 =cut
331
332 my $last = 'r 1';
333
334 sub cli {
335 my $self = shift;
336 my $a = $PC || confess "no pc?";
337 while ( my @v = $self->prompt( $a, $last ) ) {
338 my $c = shift @v;
339 my $v = shift @v;
340 $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
341 @v = map { hex($_) } @v;
342 printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
343 if ( $c =~ m/^[qx]/i ) {
344 exit;
345 } elsif ( $c eq '?' ) {
346 warn <<__USAGE__;
347 uage:
348 x|q\t\texit
349 e 6000 6010\tdump memory, +/- to walk forward/backward
350 m 1000 ff 00\tput ff 00 on 1000
351 j|u 1000\t\tjump (change pc)
352 r 42\t\trun 42 instruction opcodes
353 t\t\ttrace on/off
354 d\t\tdebug on/off
355 __USAGE__
356 } elsif ( $c =~ m/^e/i ) {
357 $a = $v if defined($v);
358 my $to = shift @v;
359 $to = $a + 32 if ( ! $to || $to <= $a );
360 my $lines = int( ($to - $a - 8) / 8 );
361 printf "## m %04x %04x lines: %d\n", $a, $to, $lines;
362 while ( $lines ) {
363 print $self->hexdump( $a );
364 $a += 8;
365 $lines--;
366 }
367 $last = '+';
368 } elsif ( $c =~ m/^\+/ ) {
369 $a += 8;
370 } elsif ( $c =~ m/^\-/ ) {
371 $a -= 8;
372 } elsif ( $c =~ m/^m/i ) {
373 $a = $v;
374 $self->poke_code( $a, @v );
375 printf "poke %d bytes at %04x\n", $#v + 1, $a;
376 } elsif ( $c =~ m/^l/i ) {
377 my $to = shift @v || 0x1000;
378 $a = $to;
379 $self->load_oraoemu( $v, $a );
380 } elsif ( $c =~ m/^s/i ) {
381 $self->save_dump( $v || 'mem.dump', @v );
382 } elsif ( $c =~ m/^r/i ) {
383 $run_for = $v || 1;
384 print "run_for $run_for instructions\n";
385 last;
386 } elsif ( $c =~ m/^(u|j)/ ) {
387 my $to = $v || $a;
388 printf "set pc to %04x\n", $to;
389 $PC = $to; # remember for restart
390 $run_for = 1;
391 last;
392 } elsif ( $c =~ m/^t/ ) {
393 $self->trace( not $self->trace );
394 print "trace ", $self->trace ? 'on' : 'off', "\n";
395 } elsif ( $c =~ m/^d/ ) {
396 $self->debug( not $self->debug );
397 print "debug ", $self->debug ? 'on' : 'off', "\n";
398 } else {
399 warn "# ignore $c\n";
400 last;
401 }
402 }
403
404
405 }
406
407 =head1 AUTHOR
408
409 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
410
411 =head1 BUGS
412
413 =head1 ACKNOWLEDGEMENTS
414
415 See also L<http://www.foing.hr/~fng_josip/orao.htm> which is source of all
416 info about this machine (and even hardware implementation from 2007).
417
418 =head1 COPYRIGHT & LICENSE
419
420 Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
421
422 This program is free software; you can redistribute it and/or modify it
423 under the same terms as Perl itself.
424
425 =cut
426
427 1; # End of Orao

  ViewVC Help
Powered by ViewVC 1.1.26