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

  ViewVC Help
Powered by ViewVC 1.1.26