/[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 38 - (show annotations)
Mon Jul 30 23:28:25 2007 UTC (16 years, 8 months ago) by dpavlin
Original Path: M6502/Orao.pm
File size: 5716 byte(s)
- implemented push_R to push register changes back to perl
- don't trace while rendering memory map
- render just video ram without show_mem
- use Exec6502 to execute limited number of cycles
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 sub init {
43 my $self = shift;
44 warn "Orao calling upstream init\n";
45 $self->SUPER::init( $self, @_ );
46
47 warn "staring Orao $Orao::VERSION emulation\n";
48
49 $self->open_screen;
50 $self->load_rom({
51 0x1000 => 'dump/SCRINV.BIN',
52 0xC000 => 'rom/BAS12.ROM',
53 0xE000 => 'rom/CRT12.ROM',
54 });
55
56 $self->load_oraoemu( 'dump/orao-1.2' );
57 $self->load_oraoemu( 'dump/SCRINV.BIN' );
58 $PC = 0x1000;
59
60 $orao = $self;
61
62 # $self->prompt( 0x1000 );
63
64 my $trace = $self->trace;
65 $self->trace( 0 );
66
67 if ( $self->show_mem ) {
68
69 warn "rendering memory map\n";
70
71 my @mmap = (
72 0x0000, 0x03FF, 'nulti blok',
73 0x0400, 0x5FFF, 'korisnièki RAM (23K)',
74 0x6000, 0x7FFF, 'video RAM',
75 0x8000, 0x9FFF, 'sistemske lokacije',
76 0xA000, 0xAFFF, 'ekstenzija',
77 0xB000, 0xBFFF, 'DOS',
78 0xC000, 0xDFFF, 'BASIC ROM',
79 0xE000, 0xFFFF, 'sistemski ROM',
80 );
81
82 foreach my $i ( 0 .. $#mmap / 3 ) {
83 my $o = $i * 3;
84 my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];
85 printf "%04x - %04x - %s\n", $from, $to, $desc;
86 for my $a ( $from .. $to ) {
87 if ( $a >= 0x6000 && $a < 0x8000 ) {
88 my $b = $self->read( $a );
89 $self->vram( $a - 0x6000, $b );
90 } else {
91 $self->read( $a );
92 }
93 }
94 }
95
96 } else {
97
98 warn "rendering video memory\n";
99 for my $a ( 0x6000 .. 0x7fff ) {
100 $self->vram( $a - 0x6000, $mem[$a] );
101 }
102
103 }
104 $self->sync;
105 $self->trace( $trace );
106
107 ( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
108
109 warn "Orao init finished", $self->trace ? ' trace on' : '', "\n";
110
111 }
112
113 =head2 load_rom
114
115 called to init memory and load initial rom images
116
117 $orao->load_rom;
118
119 =cut
120
121 sub load_rom {
122 my ($self, $loaded_files) = @_;
123
124 #my $time_base = time();
125
126 foreach my $addr ( sort keys %$loaded_files ) {
127 my $path = $loaded_files->{$addr};
128 $self->load_oraoemu( $path, $addr );
129 }
130 }
131
132
133 =head2 load_oraoemu
134
135 =cut
136
137 sub load_oraoemu {
138 my $self = shift;
139 my ( $path, $addr ) = @_;
140
141 my $size = -s $path || confess "no size for $path: $!";
142
143 my $buff = read_file( $path );
144
145 if ( $size == 65538 ) {
146 $addr = 0;
147 warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
148 $self->write_chunk( $addr, substr($buff,2) );
149 return;
150 } elsif ( $size == 32800 ) {
151 $addr = 0;
152 warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
153 #$self->write_chunk( $addr, substr($buff,0x20) );
154 $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );
155 return;
156 }
157 printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
158 return $self->poke_code( $addr, map { ord($_) } split(//,$buff) );
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 "# Orao::read(",dump(@_),") = ",dump( $byte ),"\n" if $self->debug;
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 warn "# Orao::write(",dump(@_),")\n" if $self->debug;
274 my ($addr,$byte) = @_;
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
295 =head1 AUTHOR
296
297 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
298
299 =head1 BUGS
300
301 =head1 ACKNOWLEDGEMENTS
302
303 See also L<http://www.foing.hr/~fng_josip/orao.htm> which is source of all
304 info about this machine (and even hardware implementation from 2007).
305
306 =head1 COPYRIGHT & LICENSE
307
308 Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
309
310 This program is free software; you can redistribute it and/or modify it
311 under the same terms as Perl itself.
312
313 =cut
314
315 1; # End of Orao

  ViewVC Help
Powered by ViewVC 1.1.26