/[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

Annotation of /Orao.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 43 - (hide 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 dpavlin 29 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 dpavlin 32 use Data::Dump qw/dump/;
11 dpavlin 34 use M6502;
12 dpavlin 29
13 dpavlin 30 use base qw(Class::Accessor M6502 Screen);
14 dpavlin 29 __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 dpavlin 30 =head2 init
35    
36     Start emulator
37    
38     =cut
39    
40 dpavlin 32 our $orao;
41    
42 dpavlin 42 select(STDERR); $| = 1;
43    
44 dpavlin 30 sub init {
45     my $self = shift;
46 dpavlin 34 warn "Orao calling upstream init\n";
47 dpavlin 33 $self->SUPER::init( $self, @_ );
48 dpavlin 30
49 dpavlin 31 warn "staring Orao $Orao::VERSION emulation\n";
50 dpavlin 30
51     $self->open_screen;
52 dpavlin 33 $self->load_rom({
53     0x1000 => 'dump/SCRINV.BIN',
54     0xC000 => 'rom/BAS12.ROM',
55     0xE000 => 'rom/CRT12.ROM',
56     });
57 dpavlin 32
58 dpavlin 35 $self->load_oraoemu( 'dump/orao-1.2' );
59 dpavlin 39 $self->load_oraoemu( 'dump/SCRINV.BIN', 0x1000 );
60 dpavlin 35 $PC = 0x1000;
61    
62 dpavlin 32 $orao = $self;
63    
64 dpavlin 33 # $self->prompt( 0x1000 );
65    
66 dpavlin 38 my $trace = $self->trace;
67     $self->trace( 0 );
68 dpavlin 33
69 dpavlin 38 if ( $self->show_mem ) {
70 dpavlin 33
71 dpavlin 38 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 dpavlin 36 }
96 dpavlin 34 }
97 dpavlin 38
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 dpavlin 33 }
106 dpavlin 38 $self->sync;
107     $self->trace( $trace );
108 dpavlin 33
109 dpavlin 39 #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
110 dpavlin 34
111 dpavlin 38 warn "Orao init finished", $self->trace ? ' trace on' : '', "\n";
112    
113 dpavlin 30 }
114    
115 dpavlin 29 =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 dpavlin 33 my ($self, $loaded_files) = @_;
125 dpavlin 29
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 dpavlin 31 my $size = -s $path || confess "no size for $path: $!";
144 dpavlin 29
145     my $buff = read_file( $path );
146    
147     if ( $size == 65538 ) {
148     $addr = 0;
149 dpavlin 33 warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
150 dpavlin 29 $self->write_chunk( $addr, substr($buff,2) );
151     return;
152     } elsif ( $size == 32800 ) {
153     $addr = 0;
154 dpavlin 33 warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
155 dpavlin 42 $self->write_chunk( $addr, substr($buff,0x20) );
156 dpavlin 29 return;
157     }
158 dpavlin 33 printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
159 dpavlin 29 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 dpavlin 32 warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
199 dpavlin 29 }
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 dpavlin 43 $self->app->sync;
228 dpavlin 29 my $a = shift;
229     my $last = shift;
230 dpavlin 32 print STDERR $self->hexdump( $a ),
231 dpavlin 29 $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 dpavlin 32 =head1 Memory management
241 dpavlin 30
242 dpavlin 32 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 dpavlin 33 my $self = shift;
257 dpavlin 32 my ($addr) = @_;
258     my $byte = $mem[$addr];
259 dpavlin 41 warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
260 dpavlin 33 $self->mmap_pixel( $addr, 0, $byte, 0 );
261 dpavlin 32 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 dpavlin 33 my $self = shift;
274 dpavlin 32 my ($addr,$byte) = @_;
275 dpavlin 41 warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
276 dpavlin 32
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 dpavlin 33 $self->mmap_pixel( $addr, $byte, 0, 0 );
290 dpavlin 32
291     $mem[$addr] = $byte;
292 dpavlin 36 return;
293 dpavlin 32 }
294    
295 dpavlin 42 =head1 Command Line
296 dpavlin 32
297 dpavlin 42 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 dpavlin 43 while ( my @v = $self->prompt( $a, $last ) ) {
312 dpavlin 42 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 dpavlin 29 =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