3 |
use warnings; |
use warnings; |
4 |
use strict; |
use strict; |
5 |
|
|
6 |
use Carp qw/confess croak/; |
use Carp qw/confess croak cluck carp/; |
7 |
use File::Slurp; |
use File::Slurp; |
8 |
use Data::Dump qw/dump/; |
use Data::Dump qw/dump/; |
9 |
|
|
29 |
This project is homage to 8-bit computers in Croatia and former Yugoslavia |
This project is homage to 8-bit computers in Croatia and former Yugoslavia |
30 |
from 1980-1990. Word B<vrac> means also I<wizard> in Croatian. |
from 1980-1990. Word B<vrac> means also I<wizard> in Croatian. |
31 |
|
|
32 |
|
This project should enable anyone with limited knowledge of perl and 8-bit |
33 |
|
arhitecture of some machine to write emulator in an afternoon. To achieve this, |
34 |
|
code is written is as cleanly as possible. |
35 |
|
|
36 |
|
Porting existing emulators should be especially easy: you need passive |
37 |
|
understaning of language in which emulator is written and you can be on your |
38 |
|
way C<:-)> |
39 |
|
|
40 |
=cut |
=cut |
41 |
|
|
42 |
=head1 FUNCTIONS |
=head1 FUNCTIONS |
160 |
close($fh); |
close($fh); |
161 |
|
|
162 |
my $size = -s $path; |
my $size = -s $path; |
163 |
warn sprintf "saved %s %04x-%04x %d %x bytes\n", $path, $from, $to, $size, $size; |
print sprintf "saved %s %04x-%04x %d %x bytes\n", $path, $from, $to, $size, $size; |
164 |
} else { |
} else { |
165 |
warn "can't create $path: $!"; |
warn "can't create $path: $!"; |
166 |
} |
} |
201 |
my $path = shift || confess "no path?"; |
my $path = shift || confess "no path?"; |
202 |
my $bytes = join('', @_); |
my $bytes = join('', @_); |
203 |
|
|
204 |
|
my $size = -s $path || 0; |
205 |
|
my $len = length($bytes); |
206 |
|
|
207 |
open(my $fh, '>>', $path) || confess "can't open $path: $!"; |
open(my $fh, '>>', $path) || confess "can't open $path: $!"; |
208 |
|
print($fh $bytes); |
209 |
|
my $pos = tell($fh); |
210 |
|
|
211 |
|
my $expected = $size + $len; |
212 |
|
if ( $pos != $expected ) { |
213 |
|
#cluck "BUG: file grows too big got $pos, expected $expected !"; |
214 |
|
truncate $fh, $expected; |
215 |
|
} |
216 |
|
|
217 |
|
close($fh); |
218 |
|
|
|
print $fh $bytes; |
|
219 |
warn sprintf("## append_to_file('%s',%s)\n", $path, dump($bytes)); |
warn sprintf("## append_to_file('%s',%s)\n", $path, dump($bytes)); |
220 |
} |
} |
221 |
|
|
259 |
my $self = shift; |
my $self = shift; |
260 |
my $a = $self->cpu_PC() || confess "can't find PC"; |
my $a = $self->cpu_PC() || confess "can't find PC"; |
261 |
my $run_for = 0; |
my $run_for = 0; |
262 |
warn $self->dump_R() if $show_R; |
print $self->dump_R() if $show_R; |
263 |
while ( my ($line, @v) = $self->prompt( $a, $last ) ) { |
while ( my ($line, @v) = $self->prompt( $a, $last ) ) { |
264 |
my $c = shift @v; |
my $c = shift @v; |
265 |
next unless defined($c); |
next unless defined($c); |
272 |
} elsif ( $c eq '?' ) { |
} elsif ( $c eq '?' ) { |
273 |
my $t = $self->trace ? 'on' : 'off' ; |
my $t = $self->trace ? 'on' : 'off' ; |
274 |
my $d = $self->debug ? 'on' : 'off' ; |
my $d = $self->debug ? 'on' : 'off' ; |
275 |
warn <<__USAGE__; |
print <<__USAGE__; |
276 |
Usage: |
Usage: |
277 |
|
|
278 |
x|q\t\texit |
x|q\t\texit |
282 |
r 42\t\trun 42 instruction opcodes |
r 42\t\trun 42 instruction opcodes |
283 |
t\t\ttrace [$t] |
t\t\ttrace [$t] |
284 |
d\t\tdebug [$d] |
d\t\tdebug [$d] |
285 |
|
tape name 168\tload tape and start at offset |
286 |
|
|
287 |
__USAGE__ |
__USAGE__ |
288 |
warn $self->dump_R; |
print $self->tape_status if $self->can('tape_status'); |
289 |
|
print $self->dump_R; |
290 |
$last = ''; |
$last = ''; |
291 |
} elsif ( $c =~ m/^e/i ) { |
} elsif ( $c =~ m/^e/i ) { |
292 |
$a = $v if defined($v); |
$a = $v if defined($v); |
338 |
$show_R = 1; |
$show_R = 1; |
339 |
last; |
last; |
340 |
} elsif ( $c =~ m/^tape/ ) { |
} elsif ( $c =~ m/^tape/ ) { |
341 |
if ( $c =~ m/rate/ ) { |
if ( ! $v ) { |
|
$self->tape_rate( $v ); |
|
|
warn "will read table with rate $v\n"; |
|
|
} elsif ( ! $v ) { |
|
342 |
warn "ERROR: please specify tape name!\n"; |
warn "ERROR: please specify tape name!\n"; |
343 |
} elsif ( ! -e $v ) { |
} elsif ( ! -e $v ) { |
344 |
warn "ERROR: tape $v: $!\n"; |
warn "ERROR: tape $v: $!\n"; |
345 |
} else { |
} else { |
346 |
$self->load_tape( $v ); |
$self->load_tape( $v, shift @v ); |
347 |
} |
} |
348 |
$last = ''; |
$last = ''; |
349 |
} elsif ( $c =~ m/^t/i ) { |
} elsif ( $c =~ m/^t/i ) { |
365 |
|
|
366 |
=head1 SEE ALSO |
=head1 SEE ALSO |
367 |
|
|
368 |
Components: L<M6502>, L<Z80>, L<Screen>, L<Tape> |
Components: L<M6502>, L<Z80>, L<Screen>, L<Tape>, L<Session> |
369 |
|
|
370 |
Emulators: L<Orao>, L<Galaksija> |
Emulators: L<Orao>, L<Galaksija> |
371 |
|
|
372 |
|
L<References> about different architectures |
373 |
|
|
374 |
=head1 AUTHOR |
=head1 AUTHOR |
375 |
|
|
376 |
Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >> |
Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >> |
377 |
|
|
|
=head1 BUGS |
|
|
|
|
378 |
=head1 ACKNOWLEDGEMENTS |
=head1 ACKNOWLEDGEMENTS |
379 |
|
|
380 |
|
Structure and Interpretation of Computer Programs by Abelson, Sussman, and |
381 |
|
Sussman L<http://mitpress.mit.edu/sicp/> is a great book. It gave me idea |
382 |
|
that you should have wizard powers over your computer, even if it's 8 bit |
383 |
|
one. |
384 |
|
|
385 |
=head1 COPYRIGHT & LICENSE |
=head1 COPYRIGHT & LICENSE |
386 |
|
|
387 |
Copyright 2007 Dobrica Pavlinusic, All Rights Reserved. |
Copyright 2007 Dobrica Pavlinusic, All Rights Reserved. |