/[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 32 - (show 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 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
12 use base qw(Class::Accessor M6502 Screen);
13 __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 =head2 init
34
35 Start emulator
36
37 =cut
38
39 our $orao;
40
41 sub init {
42 my $self = shift;
43 warn "call upstream init\n";
44 $self->SUPER::init( @_ );
45
46 warn "staring Orao $Orao::VERSION emulation\n";
47
48 $self->open_screen;
49 $self->load_rom;
50
51 $orao = $self;
52
53 $self->prompt( 0x1000 );
54 }
55
56 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 warn sprintf "loading '%s' at %04x\n", $path, $addr;
77 $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 my $size = -s $path || confess "no size for $path: $!";
91
92 my $buff = read_file( $path );
93
94 if ( $size == 65538 ) {
95 $addr = 0;
96 warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;
97 $self->write_chunk( $addr, substr($buff,2) );
98 return;
99 } elsif ( $size == 32800 ) {
100 $addr = 0;
101 warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;
102 #$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 warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
147 }
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 print STDERR $self->hexdump( $a ),
178 $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 =head1 Memory management
188
189 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 =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