/[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

Diff of /Orao.pm

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

revision 30 by dpavlin, Mon Jul 30 17:56:13 2007 UTC revision 34 by dpavlin, Mon Jul 30 21:34:30 2007 UTC
# Line 7  use Carp; Line 7  use Carp;
7  use lib './lib';  use lib './lib';
8  #use Time::HiRes qw(time);  #use Time::HiRes qw(time);
9  use File::Slurp;  use File::Slurp;
10    use Data::Dump qw/dump/;
11    use M6502;
12    
13  use base qw(Class::Accessor M6502 Screen);  use base qw(Class::Accessor M6502 Screen);
14  __PACKAGE__->mk_accessors(qw(debug trace run_for mem_dump trace));  __PACKAGE__->mk_accessors(qw(debug trace run_for mem_dump trace));
# Line 35  Start emulator Line 37  Start emulator
37    
38  =cut  =cut
39    
40    our $orao;
41    
42    our $PC = 0x1000;
43    
44  sub init {  sub init {
45          my $self = shift;          my $self = shift;
46          warn "call upstream init\n";          warn "Orao calling upstream init\n";
47          $self->SUPER::init( @_ );          $self->SUPER::init( $self, @_ );
48    
49          warn "staring Orao $ORAO::VERSION emulation\n";          warn "staring Orao $Orao::VERSION emulation\n";
50    
51          $self->open_screen;          $self->open_screen;
52          $self->load_rom;          $self->load_rom({
53  }                  0x1000 => 'dump/SCRINV.BIN',
54                    0xC000 => 'rom/BAS12.ROM',
55                    0xE000 => 'rom/CRT12.ROM',
56            });
57    
58            $orao = $self;
59    
60    #       $self->prompt( 0x1000 );
61    
62            warn "rendering memory map\n";
63    
64            my @mmap = (
65                    0x0000, 0x03FF, 'nulti blok',
66                    0x0400, 0x5FFF, 'korisnički RAM (23K)',
67                    0x6000, 0x7FFF, 'video RAM',
68                    0x8000, 0x9FFF, 'sistemske lokacije',
69                    0xA000, 0xAFFF, 'ekstenzija',
70                    0xB000, 0xBFFF, 'DOS',
71                    0xC000, 0xDFFF, 'BASIC ROM',
72                    0xE000, 0xFFFF, 'sistemski ROM',
73            );
74    
75  my $loaded_files = {          foreach my $i ( 0 .. $#mmap / 3 ) {
76          0xC000 => 'rom/BAS12.ROM',                  my $o = $i * 3;
77          0xE000 => 'rom/CRT12.ROM',                  my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];
78  };                  printf "%04x - %04x - %s\n", $from, $to, $desc;
79                    for my $a ( $from .. $to ) {
80                            $orao->read( $a );
81                    }
82                    $self->sync;
83            }
84    
85            warn "Orao init finished\n";
86    
87    }
88    
89  =head2 load_rom  =head2 load_rom
90    
# Line 60  called to init memory and load initial r Line 95  called to init memory and load initial r
95  =cut  =cut
96    
97  sub load_rom {  sub load_rom {
98      my ($self) = @_;      my ($self, $loaded_files) = @_;
99    
100      #my $time_base = time();      #my $time_base = time();
101    
102          foreach my $addr ( sort keys %$loaded_files ) {          foreach my $addr ( sort keys %$loaded_files ) {
103                  my $path = $loaded_files->{$addr};                  my $path = $loaded_files->{$addr};
                 printf "loading '%s' at %04x\n", $path, $addr;  
104                  $self->load_oraoemu( $path, $addr );                  $self->load_oraoemu( $path, $addr );
105          }          }
106  }  }
# Line 80  sub load_oraoemu { Line 114  sub load_oraoemu {
114          my $self = shift;          my $self = shift;
115          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
116    
117          my $size = -s $path || die "no size for $path: $!";          my $size = -s $path || confess "no size for $path: $!";
118    
119          my $buff = read_file( $path );          my $buff = read_file( $path );
120    
121          if ( $size == 65538 ) {          if ( $size == 65538 ) {
122                  $addr = 0;                  $addr = 0;
123                  printf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;                  warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
124                  $self->write_chunk( $addr, substr($buff,2) );                  $self->write_chunk( $addr, substr($buff,2) );
125                  return;                  return;
126          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
127                  $addr = 0;                  $addr = 0;
128                  printf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;                  warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
129                  #$self->write_chunk( $addr, substr($buff,0x20) );                  #$self->write_chunk( $addr, substr($buff,0x20) );
130                  $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );                  $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );
131                  return;                  return;
132          }          }
133          printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $size;          printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
134            return $self->poke_code( $addr, map { ord($_) } split(//,$buff) );
135          return $self->write_chunk( $addr, $buff );          return $self->write_chunk( $addr, $buff );
136    
137          my $chunk;          my $chunk;
# Line 136  sub save_dump { Line 171  sub save_dump {
171          close($fh);          close($fh);
172    
173          my $size = -s $path;          my $size = -s $path;
174          printf "saved %s %d %x bytes\n", $path, $size, $size;          warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
175  }  }
176    
177  =head2 hexdump  =head2 hexdump
# Line 167  sub prompt { Line 202  sub prompt {
202          my $self = shift;          my $self = shift;
203          my $a = shift;          my $a = shift;
204          my $last = shift;          my $last = shift;
205          print $self->hexdump( $a ),          print STDERR $self->hexdump( $a ),
206                  $last ? "[$last] " : '',                  $last ? "[$last] " : '',
207                  "> ";                  "> ";
208          my $in = <STDIN>;          my $in = <STDIN>;
# Line 177  sub prompt { Line 212  sub prompt {
212          return split(/\s+/, $in) if $in;          return split(/\s+/, $in) if $in;
213  }  }
214    
215    =head1 Memory management
216    
217    Orao implements all I/O using mmap addresses. This was main reason why
218    L<Acme::6502> was just too slow to handle it.
219    
220    =cut
221    
222    =head2 read
223    
224    Read from memory
225    
226      $byte = read( $address );
227    
228    =cut
229    
230    sub read {
231            my $self = shift;
232            my ($addr) = @_;
233            my $byte = $mem[$addr];
234            warn "# Orao::read(",dump(@_),") = ",dump( $byte ),"\n" if $self->debug;
235            $self->mmap_pixel( $addr, 0, $byte, 0 );
236            return $byte;
237    }
238    
239    =head2 write
240    
241    Write into emory
242    
243      write( $address, $byte );
244    
245    =cut
246    
247    sub write {
248            my $self = shift;
249            warn "# Orao::write(",dump(@_),")\n" if $self->debug;
250            my ($addr,$byte) = @_;
251    
252            if ( $addr >= 0x6000 && $addr < 0x8000 ) {
253                    $self->vram( $addr - 0x6000 , $byte );
254            }
255    
256            if ( $addr > 0xafff ) {
257                    warn sprintf "access to %04x above affff aborting\n", $addr;
258                    return -1;
259            }
260            if ( $addr == 0x8800 ) {
261                    warn sprintf "sound ignored: %x\n", $byte;
262            }
263    
264            $self->mmap_pixel( $addr, $byte, 0, 0 );
265    
266            $mem[$addr] = $byte;
267    }
268    
269    
270  =head1 AUTHOR  =head1 AUTHOR
271    
Legend:
Removed from v.30  
changed lines
  Added in v.34
  ViewVC Help
Powered by ViewVC 1.1.26