/[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 32 - (hide annotations)
Mon Jul 30 18:37:37 2007 UTC (16 years, 8 months ago) by dpavlin
Original Path: M6502/Orao.pm
File size: 4496 byte(s)
comming along nicely: implement parts of memory maps
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 29
12 dpavlin 30 use base qw(Class::Accessor M6502 Screen);
13 dpavlin 29 __PACKAGE__->mk_accessors(qw(debug trace run_for mem_dump trace));
14    
15     =head1 NAME
16    
17     Orao - Orao emulator
18    
19     =head1 VERSION
20    
21     Version 0.02
22    
23     =cut
24    
25     our $VERSION = '0.02';
26    
27     =head1 SUMMARY
28    
29     Emulator or Orao 8-bit 6502 machine popular in Croatia
30    
31     =cut
32    
33 dpavlin 30 =head2 init
34    
35     Start emulator
36    
37     =cut
38    
39 dpavlin 32 our $orao;
40    
41 dpavlin 30 sub init {
42     my $self = shift;
43     warn "call upstream init\n";
44     $self->SUPER::init( @_ );
45    
46 dpavlin 31 warn "staring Orao $Orao::VERSION emulation\n";
47 dpavlin 30
48     $self->open_screen;
49     $self->load_rom;
50 dpavlin 32
51     $orao = $self;
52    
53     $self->prompt( 0x1000 );
54 dpavlin 30 }
55    
56 dpavlin 29 my $loaded_files = {
57     0xC000 => 'rom/BAS12.ROM',
58     0xE000 => 'rom/CRT12.ROM',
59     };
60    
61     =head2 load_rom
62    
63     called to init memory and load initial rom images
64    
65     $orao->load_rom;
66    
67     =cut
68    
69     sub load_rom {
70     my ($self) = @_;
71    
72     #my $time_base = time();
73    
74     foreach my $addr ( sort keys %$loaded_files ) {
75     my $path = $loaded_files->{$addr};
76 dpavlin 32 warn sprintf "loading '%s' at %04x\n", $path, $addr;
77 dpavlin 29 $self->load_oraoemu( $path, $addr );
78     }
79     }
80    
81    
82     =head2 load_oraoemu
83    
84     =cut
85    
86     sub load_oraoemu {
87     my $self = shift;
88     my ( $path, $addr ) = @_;
89    
90 dpavlin 31 my $size = -s $path || confess "no size for $path: $!";
91 dpavlin 29
92     my $buff = read_file( $path );
93    
94     if ( $size == 65538 ) {
95     $addr = 0;
96 dpavlin 32 warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;
97 dpavlin 29 $self->write_chunk( $addr, substr($buff,2) );
98     return;
99     } elsif ( $size == 32800 ) {
100     $addr = 0;
101 dpavlin 32 warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;
102 dpavlin 29 #$self->write_chunk( $addr, substr($buff,0x20) );
103     $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );
104     return;
105     }
106     printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;
107     return $self->write_chunk( $addr, $buff );
108    
109     my $chunk;
110    
111     my $pos = 0;
112    
113     while ( my $long = substr($buff,$pos,4) ) {
114     my @b = split(//, $long, 4);
115     $chunk .=
116     ( $b[3] || '' ) .
117     ( $b[2] || '' ) .
118     ( $b[1] || '' ) .
119     ( $b[0] || '' );
120     $pos += 4;
121     }
122    
123     $self->write_chunk( $addr, $chunk );
124    
125     };
126    
127     =head2 save_dump
128    
129     $orao->save_dump( 'filename', $from, $to );
130    
131     =cut
132    
133     sub save_dump {
134     my $self = shift;
135    
136     my ( $path, $from, $to ) = @_;
137    
138     $from ||= 0;
139     $to ||= 0xffff;
140    
141     open(my $fh, '>', $path) || die "can't open $path: $!";
142     print $fh $self->read_chunk( $from, $to );
143     close($fh);
144    
145     my $size = -s $path;
146 dpavlin 32 warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
147 dpavlin 29 }
148    
149     =head2 hexdump
150    
151     $orao->hexdump( $address );
152    
153     =cut
154    
155     sub hexdump {
156     my $self = shift;
157     my $a = shift;
158     return sprintf(" %04x %s\n", $a,
159     join(" ",
160     map {
161     sprintf( "%02x", $_ )
162     } $self->ram( $a, $a+8 )
163     )
164     );
165     }
166    
167     =head2 prompt
168    
169     $orao->prompt( $address, $last_command );
170    
171     =cut
172    
173     sub prompt {
174     my $self = shift;
175     my $a = shift;
176     my $last = shift;
177 dpavlin 32 print STDERR $self->hexdump( $a ),
178 dpavlin 29 $last ? "[$last] " : '',
179     "> ";
180     my $in = <STDIN>;
181     chomp($in);
182     $in ||= $last;
183     $last = $in;
184     return split(/\s+/, $in) if $in;
185     }
186    
187 dpavlin 32 =head1 Memory management
188 dpavlin 30
189 dpavlin 32 Orao implements all I/O using mmap addresses. This was main reason why
190     L<Acme::6502> was just too slow to handle it.
191    
192     =cut
193    
194     my @mem = (0xff) x 0x100000; # 64Mb
195    
196     =head2 read
197    
198     Read from memory
199    
200     $byte = read( $address );
201    
202     =cut
203    
204     sub read {
205     my $self = $orao;
206     my ($addr) = @_;
207     my $byte = $mem[$addr];
208     warn "# Orao::read(",dump(@_),") = ",dump( $byte ),"\n" if $self->debug;
209     mmap_pixel( $addr, 0, $byte, 0 );
210     return $byte;
211     }
212    
213     =head2 write
214    
215     Write into emory
216    
217     write( $address, $byte );
218    
219     =cut
220    
221     sub write {
222     my $self = $orao;
223     warn "# Orao::write(",dump(@_),")\n" if $self->debug;
224     my ($addr,$byte) = @_;
225    
226     if ( $addr >= 0x6000 && $addr < 0x8000 ) {
227     $self->vram( $addr - 0x6000 , $byte );
228     }
229    
230     if ( $addr > 0xafff ) {
231     warn sprintf "access to %04x above affff aborting\n", $addr;
232     return -1;
233     }
234     if ( $addr == 0x8800 ) {
235     warn sprintf "sound ignored: %x\n", $byte;
236     }
237    
238     mmap_pixel( $addr, $byte, 0, 0 );
239    
240     $mem[$addr] = $byte;
241     }
242    
243    
244 dpavlin 29 =head1 AUTHOR
245    
246     Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
247    
248     =head1 BUGS
249    
250     =head1 ACKNOWLEDGEMENTS
251    
252     See also L<http://www.foing.hr/~fng_josip/orao.htm> which is source of all
253     info about this machine (and even hardware implementation from 2007).
254    
255     =head1 COPYRIGHT & LICENSE
256    
257     Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
258    
259     This program is free software; you can redistribute it and/or modify it
260     under the same terms as Perl itself.
261    
262     =cut
263    
264     1; # End of Orao

  ViewVC Help
Powered by ViewVC 1.1.26