/[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 43 - (show annotations)
Tue Jul 31 09:43:21 2007 UTC (16 years, 8 months ago) by dpavlin
Original Path: M6502/Orao.pm
File size: 7498 byte(s)
update vram display from prompt
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 $self->app->sync;
228 my $a = shift;
229 my $last = shift;
230 print STDERR $self->hexdump( $a ),
231 $last ? "[$last] " : '',
232 "> ";
233 my $in = <STDIN>;
234 chomp($in);
235 $in ||= $last;
236 $last = $in;
237 return split(/\s+/, $in) if $in;
238 }
239
240 =head1 Memory management
241
242 Orao implements all I/O using mmap addresses. This was main reason why
243 L<Acme::6502> was just too slow to handle it.
244
245 =cut
246
247 =head2 read
248
249 Read from memory
250
251 $byte = read( $address );
252
253 =cut
254
255 sub read {
256 my $self = shift;
257 my ($addr) = @_;
258 my $byte = $mem[$addr];
259 warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
260 $self->mmap_pixel( $addr, 0, $byte, 0 );
261 return $byte;
262 }
263
264 =head2 write
265
266 Write into emory
267
268 write( $address, $byte );
269
270 =cut
271
272 sub write {
273 my $self = shift;
274 my ($addr,$byte) = @_;
275 warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
276
277 if ( $addr >= 0x6000 && $addr < 0x8000 ) {
278 $self->vram( $addr - 0x6000 , $byte );
279 }
280
281 if ( $addr > 0xafff ) {
282 warn sprintf "access to %04x above affff aborting\n", $addr;
283 return -1;
284 }
285 if ( $addr == 0x8800 ) {
286 warn sprintf "sound ignored: %x\n", $byte;
287 }
288
289 $self->mmap_pixel( $addr, $byte, 0, 0 );
290
291 $mem[$addr] = $byte;
292 return;
293 }
294
295 =head1 Command Line
296
297 Command-line debugging intrerface is implemented for communication with
298 emulated device
299
300 =head2 cli
301
302 $orao->cli();
303
304 =cut
305
306 my $last = 'r 1';
307
308 sub cli {
309 my $self = shift;
310 my $a = $PC || confess "no pc?";
311 while ( my @v = $self->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