/[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 29 by dpavlin, Mon Jul 30 17:32:41 2007 UTC revision 36 by dpavlin, Mon Jul 30 22:06:13 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);  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));
15    
16  =head1 NAME  =head1 NAME
# Line 29  Emulator or Orao 8-bit 6502 machine popu Line 31  Emulator or Orao 8-bit 6502 machine popu
31    
32  =cut  =cut
33    
34  my $loaded_files = {  =head2 init
35          0xC000 => 'rom/BAS12.ROM',  
36          0xE000 => 'rom/CRT12.ROM',  Start emulator
37  };  
38    =cut
39    
40    our $orao;
41    
42    sub init {
43            my $self = shift;
44            warn "Orao calling upstream init\n";
45            $self->SUPER::init( $self, @_ );
46    
47            warn "staring Orao $Orao::VERSION emulation\n";
48    
49            $self->open_screen;
50            $self->load_rom({
51                    0x1000 => 'dump/SCRINV.BIN',
52                    0xC000 => 'rom/BAS12.ROM',
53                    0xE000 => 'rom/CRT12.ROM',
54            });
55    
56            $self->load_oraoemu( 'dump/orao-1.2' );
57            $self->load_oraoemu( 'dump/SCRINV.BIN' );
58            $PC = 0x1000;
59    
60            $orao = $self;
61    
62    #       $self->prompt( 0x1000 );
63    
64            warn "rendering memory map\n";
65    
66            my @mmap = (
67                    0x0000, 0x03FF, 'nulti blok',
68                    0x0400, 0x5FFF, 'korisnički RAM (23K)',
69                    0x6000, 0x7FFF, 'video RAM',
70                    0x8000, 0x9FFF, 'sistemske lokacije',
71                    0xA000, 0xAFFF, 'ekstenzija',
72                    0xB000, 0xBFFF, 'DOS',
73                    0xC000, 0xDFFF, 'BASIC ROM',
74                    0xE000, 0xFFFF, 'sistemski ROM',
75            );
76    
77            foreach my $i ( 0 .. $#mmap / 3 ) {
78                    my $o = $i * 3;
79                    my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];
80                    printf "%04x - %04x - %s\n", $from, $to, $desc;
81                    for my $a ( $from .. $to ) {
82                            if ( $a >= 0x6000 && $a < 0x8000 ) {
83                                    my $b = $orao->read( $a );
84                                    $orao->vram( $a - 0x6000, $b );
85                            } else {
86                                    $orao->read( $a );
87                            }
88                    }
89                    $self->sync;
90            }
91    
92            warn "Orao init finished\n";
93    
94    }
95    
96  =head2 load_rom  =head2 load_rom
97    
# Line 43  called to init memory and load initial r Line 102  called to init memory and load initial r
102  =cut  =cut
103    
104  sub load_rom {  sub load_rom {
105      my ($self) = @_;      my ($self, $loaded_files) = @_;
106    
107      #my $time_base = time();      #my $time_base = time();
108    
109          foreach my $addr ( sort keys %$loaded_files ) {          foreach my $addr ( sort keys %$loaded_files ) {
110                  my $path = $loaded_files->{$addr};                  my $path = $loaded_files->{$addr};
                 printf "loading '%s' at %04x\n", $path, $addr;  
111                  $self->load_oraoemu( $path, $addr );                  $self->load_oraoemu( $path, $addr );
112          }          }
113  }  }
# Line 63  sub load_oraoemu { Line 121  sub load_oraoemu {
121          my $self = shift;          my $self = shift;
122          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
123    
124          my $size = -s $path || die "no size for $path: $!";          my $size = -s $path || confess "no size for $path: $!";
125    
126          my $buff = read_file( $path );          my $buff = read_file( $path );
127    
128          if ( $size == 65538 ) {          if ( $size == 65538 ) {
129                  $addr = 0;                  $addr = 0;
130                  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;
131                  $self->write_chunk( $addr, substr($buff,2) );                  $self->write_chunk( $addr, substr($buff,2) );
132                  return;                  return;
133          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
134                  $addr = 0;                  $addr = 0;
135                  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;
136                  #$self->write_chunk( $addr, substr($buff,0x20) );                  #$self->write_chunk( $addr, substr($buff,0x20) );
137                  $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );                  $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );
138                  return;                  return;
139          }          }
140          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;
141            return $self->poke_code( $addr, map { ord($_) } split(//,$buff) );
142          return $self->write_chunk( $addr, $buff );          return $self->write_chunk( $addr, $buff );
143    
144          my $chunk;          my $chunk;
# Line 119  sub save_dump { Line 178  sub save_dump {
178          close($fh);          close($fh);
179    
180          my $size = -s $path;          my $size = -s $path;
181          printf "saved %s %d %x bytes\n", $path, $size, $size;          warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
182  }  }
183    
184  =head2 hexdump  =head2 hexdump
# Line 150  sub prompt { Line 209  sub prompt {
209          my $self = shift;          my $self = shift;
210          my $a = shift;          my $a = shift;
211          my $last = shift;          my $last = shift;
212          print $self->hexdump( $a ),          print STDERR $self->hexdump( $a ),
213                  $last ? "[$last] " : '',                  $last ? "[$last] " : '',
214                  "> ";                  "> ";
215          my $in = <STDIN>;          my $in = <STDIN>;
# Line 160  sub prompt { Line 219  sub prompt {
219          return split(/\s+/, $in) if $in;          return split(/\s+/, $in) if $in;
220  }  }
221    
222    =head1 Memory management
223    
224    Orao implements all I/O using mmap addresses. This was main reason why
225    L<Acme::6502> was just too slow to handle it.
226    
227    =cut
228    
229    =head2 read
230    
231    Read from memory
232    
233      $byte = read( $address );
234    
235    =cut
236    
237    sub read {
238            my $self = shift;
239            my ($addr) = @_;
240            my $byte = $mem[$addr];
241            warn "# Orao::read(",dump(@_),") = ",dump( $byte ),"\n" if $self->debug;
242            $self->mmap_pixel( $addr, 0, $byte, 0 );
243            return $byte;
244    }
245    
246    =head2 write
247    
248    Write into emory
249    
250      write( $address, $byte );
251    
252    =cut
253    
254    sub write {
255            my $self = shift;
256            warn "# Orao::write(",dump(@_),")\n" if $self->debug;
257            my ($addr,$byte) = @_;
258    
259            if ( $addr >= 0x6000 && $addr < 0x8000 ) {
260                    $self->vram( $addr - 0x6000 , $byte );
261            }
262    
263            if ( $addr > 0xafff ) {
264                    warn sprintf "access to %04x above affff aborting\n", $addr;
265                    return -1;
266            }
267            if ( $addr == 0x8800 ) {
268                    warn sprintf "sound ignored: %x\n", $byte;
269            }
270    
271            $self->mmap_pixel( $addr, $byte, 0, 0 );
272    
273            $mem[$addr] = $byte;
274            return;
275    }
276    
277    
278  =head1 AUTHOR  =head1 AUTHOR
279    
280  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.29  
changed lines
  Added in v.36
  ViewVC Help
Powered by ViewVC 1.1.26