/[VRac]/VRac.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

Diff of /VRac.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 145 by dpavlin, Sun Aug 5 13:27:27 2007 UTC revision 169 by dpavlin, Mon Aug 6 09:20:20 2007 UTC
# Line 3  package VRac; Line 3  package VRac;
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    
# Line 29  Emulator of 8-bit architectures based on Line 29  Emulator of 8-bit architectures based on
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
# Line 152  sub save_dump { Line 160  sub save_dump {
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          }          }
# Line 193  sub append_to_file { Line 201  sub append_to_file {
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    
# Line 239  sub cli { Line 259  sub cli {
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);
# Line 252  sub cli { Line 272  sub cli {
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__;                           <<__USAGE__;
276  Usage:  Usage:
277    
278  x|q\t\texit  x|q\t\texit
# Line 264  t\t\ttrace [$t] Line 284  t\t\ttrace [$t]
284  d\t\tdebug [$d]  d\t\tdebug [$d]
285    
286  __USAGE__  __USAGE__
287                          warn $self->dump_R;                          print $self->tape_status if $self->can('tape_status');
288                            print $self->dump_R;
289                          $last = '';                          $last = '';
290                  } elsif ( $c =~ m/^e/i ) {                  } elsif ( $c =~ m/^e/i ) {
291                          $a = $v if defined($v);                          $a = $v if defined($v);
# Line 316  __USAGE__ Line 337  __USAGE__
337                          $show_R = 1;                          $show_R = 1;
338                          last;                          last;
339                  } elsif ( $c =~ m/^tape/ ) {                  } elsif ( $c =~ m/^tape/ ) {
340                          if ( $c =~ m/rate/ ) {                          if ( ! $v ) {
                                 $self->tape_rate( $v );  
                                 warn "will read table with rate $v\n";  
                         } elsif ( ! $v ) {  
341                                  warn "ERROR: please specify tape name!\n";                                  warn "ERROR: please specify tape name!\n";
342                          } elsif ( ! -e $v ) {                          } elsif ( ! -e $v ) {
343                                  warn "ERROR: tape $v: $!\n";                                  warn "ERROR: tape $v: $!\n";
# Line 346  __USAGE__ Line 364  __USAGE__
364    
365  =head1 SEE ALSO  =head1 SEE ALSO
366    
367  Components: L<M6502>, L<Z80>, L<Screen>, L<Tape>  Components: L<M6502>, L<Z80>, L<Screen>, L<Tape>, L<Session>
368    
369  Emulators: L<Orao>, L<Galaksija>  Emulators: L<Orao>, L<Galaksija>
370    
371    L<References> about different architectures
372    
373  =head1 AUTHOR  =head1 AUTHOR
374    
375  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
376    
 =head1 BUGS  
   
377  =head1 ACKNOWLEDGEMENTS  =head1 ACKNOWLEDGEMENTS
378    
379    Structure and Interpretation of Computer Programs by Abelson, Sussman, and
380    Sussman L<http://mitpress.mit.edu/sicp/> is a great book. It gave me idea
381    that you should have wizard powers over your computer, even if it's 8 bit
382    one.
383    
384  =head1 COPYRIGHT & LICENSE  =head1 COPYRIGHT & LICENSE
385    
386  Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.  Copyright 2007 Dobrica Pavlinusic, All Rights Reserved.
Legend:
Removed from v.145  
changed lines
  Added in v.169
  ViewVC Help
Powered by ViewVC 1.1.26