/[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 36 - (show annotations)
Mon Jul 30 22:06:13 2007 UTC (16 years, 8 months ago) by dpavlin
Original Path: M6502/Orao.pm
File size: 5365 byte(s)
more tweaks
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 warn "rendering memory map\n";
65
66 my @mmap = (
67 0x0000, 0x03FF, 'nulti blok',
68 0x0400, 0x5FFF, 'korisnièki RAM (23K)',
69 0x6000, 0x7FFF, 'video RAM',
70 0x8000, 0x9FFF, 'sistemske lokacije',
71 0xA000, 0xAFFF, 'ekstenzija',
72 0xB000, 0xBFFF, 'DOS',
73 0xC000, 0xDFFF, 'BASIC ROM',
74 0xE000, 0xFFFF, 'sistemski ROM',
75 );
76
77 foreach my $i ( 0 .. $#mmap / 3 ) {
78 my $o = $i * 3;
79 my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];
80 printf "%04x - %04x - %s\n", $from, $to, $desc;
81 for my $a ( $from .. $to ) {
82 if ( $a >= 0x6000 && $a < 0x8000 ) {
83 my $b = $orao->read( $a );
84 $orao->vram( $a - 0x6000, $b );
85 } else {
86 $orao->read( $a );
87 }
88 }
89 $self->sync;
90 }
91
92 warn "Orao init finished\n";
93
94 }
95
96 =head2 load_rom
97
98 called to init memory and load initial rom images
99
100 $orao->load_rom;
101
102 =cut
103
104 sub load_rom {
105 my ($self, $loaded_files) = @_;
106
107 #my $time_base = time();
108
109 foreach my $addr ( sort keys %$loaded_files ) {
110 my $path = $loaded_files->{$addr};
111 $self->load_oraoemu( $path, $addr );
112 }
113 }
114
115
116 =head2 load_oraoemu
117
118 =cut
119
120 sub load_oraoemu {
121 my $self = shift;
122 my ( $path, $addr ) = @_;
123
124 my $size = -s $path || confess "no size for $path: $!";
125
126 my $buff = read_file( $path );
127
128 if ( $size == 65538 ) {
129 $addr = 0;
130 warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
131 $self->write_chunk( $addr, substr($buff,2) );
132 return;
133 } elsif ( $size == 32800 ) {
134 $addr = 0;
135 warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
136 #$self->write_chunk( $addr, substr($buff,0x20) );
137 $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );
138 return;
139 }
140 printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
141 return $self->poke_code( $addr, map { ord($_) } split(//,$buff) );
142 return $self->write_chunk( $addr, $buff );
143
144 my $chunk;
145
146 my $pos = 0;
147
148 while ( my $long = substr($buff,$pos,4) ) {
149 my @b = split(//, $long, 4);
150 $chunk .=
151 ( $b[3] || '' ) .
152 ( $b[2] || '' ) .
153 ( $b[1] || '' ) .
154 ( $b[0] || '' );
155 $pos += 4;
156 }
157
158 $self->write_chunk( $addr, $chunk );
159
160 };
161
162 =head2 save_dump
163
164 $orao->save_dump( 'filename', $from, $to );
165
166 =cut
167
168 sub save_dump {
169 my $self = shift;
170
171 my ( $path, $from, $to ) = @_;
172
173 $from ||= 0;
174 $to ||= 0xffff;
175
176 open(my $fh, '>', $path) || die "can't open $path: $!";
177 print $fh $self->read_chunk( $from, $to );
178 close($fh);
179
180 my $size = -s $path;
181 warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
182 }
183
184 =head2 hexdump
185
186 $orao->hexdump( $address );
187
188 =cut
189
190 sub hexdump {
191 my $self = shift;
192 my $a = shift;
193 return sprintf(" %04x %s\n", $a,
194 join(" ",
195 map {
196 sprintf( "%02x", $_ )
197 } $self->ram( $a, $a+8 )
198 )
199 );
200 }
201
202 =head2 prompt
203
204 $orao->prompt( $address, $last_command );
205
206 =cut
207
208 sub prompt {
209 my $self = shift;
210 my $a = shift;
211 my $last = shift;
212 print STDERR $self->hexdump( $a ),
213 $last ? "[$last] " : '',
214 "> ";
215 my $in = <STDIN>;
216 chomp($in);
217 $in ||= $last;
218 $last = $in;
219 return split(/\s+/, $in) if $in;
220 }
221
222 =head1 Memory management
223
224 Orao implements all I/O using mmap addresses. This was main reason why
225 L<Acme::6502> was just too slow to handle it.
226
227 =cut
228
229 =head2 read
230
231 Read from memory
232
233 $byte = read( $address );
234
235 =cut
236
237 sub read {
238 my $self = shift;
239 my ($addr) = @_;
240 my $byte = $mem[$addr];
241 warn "# Orao::read(",dump(@_),") = ",dump( $byte ),"\n" if $self->debug;
242 $self->mmap_pixel( $addr, 0, $byte, 0 );
243 return $byte;
244 }
245
246 =head2 write
247
248 Write into emory
249
250 write( $address, $byte );
251
252 =cut
253
254 sub write {
255 my $self = shift;
256 warn "# Orao::write(",dump(@_),")\n" if $self->debug;
257 my ($addr,$byte) = @_;
258
259 if ( $addr >= 0x6000 && $addr < 0x8000 ) {
260 $self->vram( $addr - 0x6000 , $byte );
261 }
262
263 if ( $addr > 0xafff ) {
264 warn sprintf "access to %04x above affff aborting\n", $addr;
265 return -1;
266 }
267 if ( $addr == 0x8800 ) {
268 warn sprintf "sound ignored: %x\n", $byte;
269 }
270
271 $self->mmap_pixel( $addr, $byte, 0, 0 );
272
273 $mem[$addr] = $byte;
274 return;
275 }
276
277
278 =head1 AUTHOR
279
280 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
281
282 =head1 BUGS
283
284 =head1 ACKNOWLEDGEMENTS
285
286 See also L<http://www.foing.hr/~fng_josip/orao.htm> which is source of all
287 info about this machine (and even hardware implementation from 2007).
288
289 =head1 COPYRIGHT & LICENSE
290
291 Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
292
293 This program is free software; you can redistribute it and/or modify it
294 under the same terms as Perl itself.
295
296 =cut
297
298 1; # End of Orao

  ViewVC Help
Powered by ViewVC 1.1.26