/[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 36 - (hide 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 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 30 sub init {
43     my $self = shift;
44 dpavlin 34 warn "Orao calling upstream init\n";
45 dpavlin 33 $self->SUPER::init( $self, @_ );
46 dpavlin 30
47 dpavlin 31 warn "staring Orao $Orao::VERSION emulation\n";
48 dpavlin 30
49     $self->open_screen;
50 dpavlin 33 $self->load_rom({
51     0x1000 => 'dump/SCRINV.BIN',
52     0xC000 => 'rom/BAS12.ROM',
53     0xE000 => 'rom/CRT12.ROM',
54     });
55 dpavlin 32
56 dpavlin 35 $self->load_oraoemu( 'dump/orao-1.2' );
57     $self->load_oraoemu( 'dump/SCRINV.BIN' );
58     $PC = 0x1000;
59    
60 dpavlin 32 $orao = $self;
61    
62 dpavlin 33 # $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 dpavlin 34 for my $a ( $from .. $to ) {
82 dpavlin 36 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 dpavlin 34 }
89     $self->sync;
90 dpavlin 33 }
91    
92 dpavlin 34 warn "Orao init finished\n";
93    
94 dpavlin 30 }
95    
96 dpavlin 29 =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 dpavlin 33 my ($self, $loaded_files) = @_;
106 dpavlin 29
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 dpavlin 31 my $size = -s $path || confess "no size for $path: $!";
125 dpavlin 29
126     my $buff = read_file( $path );
127    
128     if ( $size == 65538 ) {
129     $addr = 0;
130 dpavlin 33 warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
131 dpavlin 29 $self->write_chunk( $addr, substr($buff,2) );
132     return;
133     } elsif ( $size == 32800 ) {
134     $addr = 0;
135 dpavlin 33 warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
136 dpavlin 29 #$self->write_chunk( $addr, substr($buff,0x20) );
137     $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );
138     return;
139     }
140 dpavlin 33 printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
141 dpavlin 34 return $self->poke_code( $addr, map { ord($_) } split(//,$buff) );
142 dpavlin 29 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 dpavlin 32 warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
182 dpavlin 29 }
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 dpavlin 32 print STDERR $self->hexdump( $a ),
213 dpavlin 29 $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 dpavlin 32 =head1 Memory management
223 dpavlin 30
224 dpavlin 32 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 dpavlin 33 my $self = shift;
239 dpavlin 32 my ($addr) = @_;
240     my $byte = $mem[$addr];
241     warn "# Orao::read(",dump(@_),") = ",dump( $byte ),"\n" if $self->debug;
242 dpavlin 33 $self->mmap_pixel( $addr, 0, $byte, 0 );
243 dpavlin 32 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 dpavlin 33 my $self = shift;
256 dpavlin 32 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 dpavlin 33 $self->mmap_pixel( $addr, $byte, 0, 0 );
272 dpavlin 32
273     $mem[$addr] = $byte;
274 dpavlin 36 return;
275 dpavlin 32 }
276    
277    
278 dpavlin 29 =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