/[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 42 - (show annotations)
Tue Jul 31 09:37:01 2007 UTC (16 years, 8 months ago) by dpavlin
File size: 7498 byte(s)
- use M6502::run_for to Exec6502 with run_for cycles
- added primitive command-line callback (cli)
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 $self->load_oraoemu( 'dump/orao-1.2' );
59 $self->load_oraoemu( 'dump/SCRINV.BIN', 0x1000 );
60 $PC = 0x1000;
61
62 $orao = $self;
63
64 # $self->prompt( 0x1000 );
65
66 my $trace = $self->trace;
67 $self->trace( 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
109 #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
110
111 warn "Orao init finished", $self->trace ? ' trace on' : '', "\n";
112
113 }
114
115 =head2 load_rom
116
117 called to init memory and load initial rom images
118
119 $orao->load_rom;
120
121 =cut
122
123 sub load_rom {
124 my ($self, $loaded_files) = @_;
125
126 #my $time_base = time();
127
128 foreach my $addr ( sort keys %$loaded_files ) {
129 my $path = $loaded_files->{$addr};
130 $self->load_oraoemu( $path, $addr );
131 }
132 }
133
134
135 =head2 load_oraoemu
136
137 =cut
138
139 sub load_oraoemu {
140 my $self = shift;
141 my ( $path, $addr ) = @_;
142
143 my $size = -s $path || confess "no size for $path: $!";
144
145 my $buff = read_file( $path );
146
147 if ( $size == 65538 ) {
148 $addr = 0;
149 warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
150 $self->write_chunk( $addr, substr($buff,2) );
151 return;
152 } elsif ( $size == 32800 ) {
153 $addr = 0;
154 warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
155 $self->write_chunk( $addr, substr($buff,0x20) );
156 return;
157 }
158 printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
159 return $self->write_chunk( $addr, $buff );
160
161 my $chunk;
162
163 my $pos = 0;
164
165 while ( my $long = substr($buff,$pos,4) ) {
166 my @b = split(//, $long, 4);
167 $chunk .=
168 ( $b[3] || '' ) .
169 ( $b[2] || '' ) .
170 ( $b[1] || '' ) .
171 ( $b[0] || '' );
172 $pos += 4;
173 }
174
175 $self->write_chunk( $addr, $chunk );
176
177 };
178
179 =head2 save_dump
180
181 $orao->save_dump( 'filename', $from, $to );
182
183 =cut
184
185 sub save_dump {
186 my $self = shift;
187
188 my ( $path, $from, $to ) = @_;
189
190 $from ||= 0;
191 $to ||= 0xffff;
192
193 open(my $fh, '>', $path) || die "can't open $path: $!";
194 print $fh $self->read_chunk( $from, $to );
195 close($fh);
196
197 my $size = -s $path;
198 warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
199 }
200
201 =head2 hexdump
202
203 $orao->hexdump( $address );
204
205 =cut
206
207 sub hexdump {
208 my $self = shift;
209 my $a = shift;
210 return sprintf(" %04x %s\n", $a,
211 join(" ",
212 map {
213 sprintf( "%02x", $_ )
214 } $self->ram( $a, $a+8 )
215 )
216 );
217 }
218
219 =head2 prompt
220
221 $orao->prompt( $address, $last_command );
222
223 =cut
224
225 sub prompt {
226 my $self = shift;
227 my $a = shift;
228 my $last = shift;
229 print STDERR $self->hexdump( $a ),
230 $last ? "[$last] " : '',
231 "> ";
232 my $in = <STDIN>;
233 chomp($in);
234 $in ||= $last;
235 $last = $in;
236 return split(/\s+/, $in) if $in;
237 }
238
239 =head1 Memory management
240
241 Orao implements all I/O using mmap addresses. This was main reason why
242 L<Acme::6502> was just too slow to handle it.
243
244 =cut
245
246 =head2 read
247
248 Read from memory
249
250 $byte = read( $address );
251
252 =cut
253
254 sub read {
255 my $self = shift;
256 my ($addr) = @_;
257 my $byte = $mem[$addr];
258 warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
259 $self->mmap_pixel( $addr, 0, $byte, 0 );
260 return $byte;
261 }
262
263 =head2 write
264
265 Write into emory
266
267 write( $address, $byte );
268
269 =cut
270
271 sub write {
272 my $self = shift;
273 my ($addr,$byte) = @_;
274 warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
275
276 if ( $addr >= 0x6000 && $addr < 0x8000 ) {
277 $self->vram( $addr - 0x6000 , $byte );
278 }
279
280 if ( $addr > 0xafff ) {
281 warn sprintf "access to %04x above affff aborting\n", $addr;
282 return -1;
283 }
284 if ( $addr == 0x8800 ) {
285 warn sprintf "sound ignored: %x\n", $byte;
286 }
287
288 $self->mmap_pixel( $addr, $byte, 0, 0 );
289
290 $mem[$addr] = $byte;
291 return;
292 }
293
294 =head1 Command Line
295
296 Command-line debugging intrerface is implemented for communication with
297 emulated device
298
299 =head2 cli
300
301 $orao->cli();
302
303 =cut
304
305 my $last = 'r 1';
306
307 sub cli {
308 my $self = shift;
309 my $a = $PC || confess "no pc?";
310 $self->app->sync;
311 while ( my @v = $orao->prompt( $a, $last ) ) {
312 my $c = shift @v;
313 my $v = shift @v;
314 $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
315 printf "## [%s] %s\n", ($v || 'undef'), join(",",@v) if $self->debug;
316 @v = map { hex($_) } @v;
317 if ( $c =~ m/^[qx]/i ) {
318 exit;
319 } elsif ( $c eq '?' ) {
320 warn <<__USAGE__;
321 uage:
322 x|q\t\texit
323 e 6000 6010\tdump memory, +/- to walk forward/backward
324 m 1000 ff 00\tput ff 00 on 1000
325 j|u 1000\t\tjump (change pc)
326 r 42\t\trun 42 instruction opcodes
327 __USAGE__
328 } elsif ( $c =~ m/^e/i ) {
329 $a ||= $v;
330 my $to = shift @v;
331 $to = $a + 32 if ( ! $to || $to <= $a );
332 my $lines = int( ($to - $a - 8) / 8 );
333 printf "## m %04x %04x lines: %d\n", $a, $to, $lines;
334 while ( $lines ) {
335 print $self->hexdump( $a );
336 $a += 8;
337 $lines--;
338 }
339 $last = '+';
340 } elsif ( $c =~ m/^\+/ ) {
341 $a += 8;
342 } elsif ( $c =~ m/^\-/ ) {
343 $a -= 8;
344 } elsif ( $c =~ m/^m/i ) {
345 $a = $v;
346 $self->poke_code( $a, @v );
347 printf "poke %d bytes at %04x\n", $#v + 1, $a;
348 } elsif ( $c =~ m/^l/i ) {
349 my $to = shift @v || 0x1000;
350 $a = $to;
351 $self->load_oraoemu( $v, $a );
352 } elsif ( $c =~ m/^s/i ) {
353 $self->save_dump( $v || 'mem.dump', @v );
354 } elsif ( $c =~ m/^r/i ) {
355 $run_for = $v || 1;
356 print "run_for $run_for instructions\n";
357 last;
358 } elsif ( $c =~ m/^(u|j)/ ) {
359 my $to = $v || $a;
360 printf "set pc to %04x\n", $to;
361 $PC = $to; # remember for restart
362 $run_for = 1;
363 last;
364 } elsif ( $c =~ m/^t/ ) {
365 $self->trace( not $self->trace );
366 print "trace ", $self->trace ? 'on' : 'off', "\n";
367 } else {
368 warn "# ignore $c\n";
369 last;
370 }
371 }
372
373
374 }
375
376 =head1 AUTHOR
377
378 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
379
380 =head1 BUGS
381
382 =head1 ACKNOWLEDGEMENTS
383
384 See also L<http://www.foing.hr/~fng_josip/orao.htm> which is source of all
385 info about this machine (and even hardware implementation from 2007).
386
387 =head1 COPYRIGHT & LICENSE
388
389 Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
390
391 This program is free software; you can redistribute it and/or modify it
392 under the same terms as Perl itself.
393
394 =cut
395
396 1; # End of Orao

  ViewVC Help
Powered by ViewVC 1.1.26