1 |
package Galeb; |
2 |
|
3 |
use warnings; |
4 |
use strict; |
5 |
|
6 |
use Carp qw/confess/; |
7 |
use File::Slurp; |
8 |
use Data::Dump qw/dump/; |
9 |
use M6502; |
10 |
use Screen; |
11 |
|
12 |
use base qw(Class::Accessor VRac M6502 Screen Prefs Session); |
13 |
#__PACKAGE__->mk_accessors(qw()); |
14 |
|
15 |
=head1 NAME |
16 |
|
17 |
Galeb - Galeb emulator |
18 |
|
19 |
=head1 VERSION |
20 |
|
21 |
Version 0.00 |
22 |
|
23 |
=cut |
24 |
|
25 |
our $VERSION = '0.00'; |
26 |
|
27 |
=head1 SUMMARY |
28 |
|
29 |
Emulator for Galeb 8-bit 6502 machine from Croatia |
30 |
|
31 |
=cut |
32 |
|
33 |
=head1 FUNCTIONS |
34 |
|
35 |
=head2 run |
36 |
|
37 |
Start emulator, open L<Screen>, load initial ROM images, and start emulator loop |
38 |
|
39 |
=cut |
40 |
|
41 |
our $emu; |
42 |
|
43 |
sub run { |
44 |
my $self = shift; |
45 |
|
46 |
warn "Galeb calling upstream init\n"; |
47 |
$self->SUPER::init( |
48 |
read => sub { $self->read( @_ ) }, |
49 |
write => sub { $self->write( @_ ) }, |
50 |
); |
51 |
|
52 |
warn "Galeb $Galeb::VERSION emulation starting\n"; |
53 |
|
54 |
$self->scale( 2 ); |
55 |
$self->show_mem( 1 ); |
56 |
$self->load_session( 'sess/current' ); |
57 |
|
58 |
$self->open_screen; |
59 |
$self->load_rom({ |
60 |
0xc000 => 'rom/Galeb/BAS01.rom', |
61 |
0xc800 => 'rom/Galeb/BAS02.rom', |
62 |
0xd000 => 'rom/Galeb/BAS03.rom', |
63 |
0xd800 => 'rom/Galeb/BAS04.rom', |
64 |
0xf000 => 'rom/Galeb/EXMD.rom', |
65 |
0xf800 => 'rom/Galeb/MAKbug.rom', |
66 |
}); |
67 |
|
68 |
$PC = $mem[ 0xfffc ]; |
69 |
warn sprintf("starting from address at 0xfffc = 0x%04x", $PC); |
70 |
|
71 |
$emu = $self; |
72 |
|
73 |
my ( $trace, $debug ) = ( $self->trace, $self->debug ); |
74 |
$self->trace( 0 ); |
75 |
$self->debug( 0 ); |
76 |
|
77 |
warn "rendering memory\n"; |
78 |
$self->render_mem( @mem ); |
79 |
|
80 |
M6502::reset(); |
81 |
|
82 |
$self->loop( sub { |
83 |
my $run_for = shift; |
84 |
warn sprintf("about to exec from PC %04x for %d cycles\n", $PC, $run_for) if $self->trace; |
85 |
M6502::exec( $run_for ); |
86 |
$self->render_vram; |
87 |
}); |
88 |
}; |
89 |
|
90 |
|
91 |
=head1 Helper functions |
92 |
|
93 |
=head2 load_image |
94 |
|
95 |
Load binary files, ROM images and Galeb Emulator files |
96 |
|
97 |
$emu->load_image( '/path/to/file', 0x1000 ); |
98 |
|
99 |
Returns true on success. |
100 |
|
101 |
=cut |
102 |
|
103 |
sub load_image { |
104 |
my $self = shift; |
105 |
my ( $path, $addr ) = @_; |
106 |
|
107 |
if ( ! -e $path ) { |
108 |
warn "ERROR: file $path doesn't exist\n"; |
109 |
return; |
110 |
} |
111 |
|
112 |
my $size = -s $path || confess "no size for $path: $!"; |
113 |
|
114 |
my $buff = read_file( $path ); |
115 |
|
116 |
if ( $size == 65567 ) { |
117 |
$addr = 0; |
118 |
warn sprintf "loading Galaksija emulator 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size; |
119 |
$self->write_chunk( $addr, substr($buff,0x20) ); |
120 |
return 1; |
121 |
} |
122 |
|
123 |
printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size; |
124 |
$self->write_chunk( $addr, $buff ); |
125 |
return 1; |
126 |
}; |
127 |
|
128 |
|
129 |
=head1 Memory management |
130 |
|
131 |
=cut |
132 |
|
133 |
=head2 read |
134 |
|
135 |
Read from memory |
136 |
|
137 |
$byte = read( $address ); |
138 |
|
139 |
=cut |
140 |
|
141 |
sub read { |
142 |
my $self = shift; |
143 |
my ($addr) = @_; |
144 |
return if ( $addr > 0xffff ); |
145 |
my $byte = $mem[$addr]; |
146 |
confess sprintf("can't find memory at address %04x",$addr) unless defined($byte); |
147 |
warn sprintf("# Galeb::read(%04x) = %02x\n", $addr, $byte) if $self->trace; |
148 |
|
149 |
$self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem; |
150 |
return $byte; |
151 |
} |
152 |
|
153 |
=head2 write |
154 |
|
155 |
Write into emory |
156 |
|
157 |
write( $address, $byte ); |
158 |
|
159 |
=cut |
160 |
|
161 |
sub write { |
162 |
my $self = shift; |
163 |
my ($addr,$byte) = @_; |
164 |
warn sprintf("# Galeb::write(%04x,%02x)\n", $addr, $byte) if $self->trace; |
165 |
|
166 |
if ( $addr > 0xc000 ) { |
167 |
confess sprintf "write access 0x%04x > 0xc000 aborting\n", $addr; |
168 |
} |
169 |
|
170 |
$self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem; |
171 |
$mem[$addr] = $byte; |
172 |
return; |
173 |
} |
174 |
|
175 |
=head1 Architecture specific |
176 |
|
177 |
=head2 render_vram |
178 |
|
179 |
Render one frame of video ram |
180 |
|
181 |
$self->render_vram; |
182 |
|
183 |
=cut |
184 |
|
185 |
my $last_dump = ''; |
186 |
|
187 |
sub render_vram { |
188 |
my $self = shift; |
189 |
|
190 |
my $addr = 0xb000; |
191 |
|
192 |
my $dump; |
193 |
|
194 |
for my $y ( 0 .. 15 ) { |
195 |
$dump .= sprintf "%2d: %s\n",$y, join('', map { chr( $_ ) } @mem[ $addr+15 .. $addr+62 ] ); |
196 |
$addr += 64; |
197 |
} |
198 |
|
199 |
if ( $dump ne $last_dump ) { |
200 |
print $dump; |
201 |
$last_dump = $dump; |
202 |
} |
203 |
} |
204 |
|
205 |
=head2 cpu_PC |
206 |
|
207 |
Helper metod to set or get PC for current architecture |
208 |
|
209 |
=cut |
210 |
|
211 |
sub cpu_PC { |
212 |
my ( $self, $addr ) = @_; |
213 |
if ( defined($addr) ) { |
214 |
$PC = $addr; |
215 |
warn sprintf("running from PC %04x\n", $PC); |
216 |
}; |
217 |
return $PC; |
218 |
} |
219 |
|
220 |
=head1 SEE ALSO |
221 |
|
222 |
L<VRac>, L<M6502>, L<Screen>, L<Tape> |
223 |
|
224 |
=head1 AUTHOR |
225 |
|
226 |
Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >> |
227 |
|
228 |
=head1 ACKNOWLEDGEMENTS |
229 |
|
230 |
See also L<http://www.foing.hr/~fng_josip/orao.htm> which is source of all |
231 |
info about this machine (and even hardware implementation from 2007). |
232 |
|
233 |
=head1 COPYRIGHT & LICENSE |
234 |
|
235 |
Copyright 2007 Dobrica Pavlinusic, All Rights Reserved. |
236 |
|
237 |
This program is free software; you can redistribute it and/or modify it |
238 |
under the same terms as Perl itself. |
239 |
|
240 |
=cut |
241 |
|
242 |
1; # End of Galeb |