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