/[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 38 by dpavlin, Mon Jul 30 23:28:25 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            my $trace = $self->trace;
65            $self->trace( 0 );
66    
67            if ( $self->show_mem ) {
68    
69                    warn "rendering memory map\n";
70    
71                    my @mmap = (
72                            0x0000, 0x03FF, 'nulti blok',
73                            0x0400, 0x5FFF, 'korisnički RAM (23K)',
74                            0x6000, 0x7FFF, 'video RAM',
75                            0x8000, 0x9FFF, 'sistemske lokacije',
76                            0xA000, 0xAFFF, 'ekstenzija',
77                            0xB000, 0xBFFF, 'DOS',
78                            0xC000, 0xDFFF, 'BASIC ROM',
79                            0xE000, 0xFFFF, 'sistemski ROM',
80                    );
81    
82                    foreach my $i ( 0 .. $#mmap / 3 ) {
83                            my $o = $i * 3;
84                            my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];
85                            printf "%04x - %04x - %s\n", $from, $to, $desc;
86                            for my $a ( $from .. $to ) {
87                                    if ( $a >= 0x6000 && $a < 0x8000 ) {
88                                            my $b = $self->read( $a );
89                                            $self->vram( $a - 0x6000, $b );
90                                    } else {
91                                            $self->read( $a );
92                                    }
93                            }
94                    }
95    
96            } else {
97    
98                    warn "rendering video memory\n";
99                    for my $a ( 0x6000 .. 0x7fff ) {
100                            $self->vram( $a - 0x6000, $mem[$a] );
101                    }
102            
103            }
104            $self->sync;
105            $self->trace( $trace );
106    
107            ( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
108    
109            warn "Orao init finished", $self->trace ? ' trace on' : '', "\n";
110    
111    }
112    
113  =head2 load_rom  =head2 load_rom
114    
# Line 43  called to init memory and load initial r Line 119  called to init memory and load initial r
119  =cut  =cut
120    
121  sub load_rom {  sub load_rom {
122      my ($self) = @_;      my ($self, $loaded_files) = @_;
123    
124      #my $time_base = time();      #my $time_base = time();
125    
126          foreach my $addr ( sort keys %$loaded_files ) {          foreach my $addr ( sort keys %$loaded_files ) {
127                  my $path = $loaded_files->{$addr};                  my $path = $loaded_files->{$addr};
                 printf "loading '%s' at %04x\n", $path, $addr;  
128                  $self->load_oraoemu( $path, $addr );                  $self->load_oraoemu( $path, $addr );
129          }          }
130  }  }
# Line 63  sub load_oraoemu { Line 138  sub load_oraoemu {
138          my $self = shift;          my $self = shift;
139          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
140    
141          my $size = -s $path || die "no size for $path: $!";          my $size = -s $path || confess "no size for $path: $!";
142    
143          my $buff = read_file( $path );          my $buff = read_file( $path );
144    
145          if ( $size == 65538 ) {          if ( $size == 65538 ) {
146                  $addr = 0;                  $addr = 0;
147                  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;
148                  $self->write_chunk( $addr, substr($buff,2) );                  $self->write_chunk( $addr, substr($buff,2) );
149                  return;                  return;
150          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
151                  $addr = 0;                  $addr = 0;
152                  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;
153                  #$self->write_chunk( $addr, substr($buff,0x20) );                  #$self->write_chunk( $addr, substr($buff,0x20) );
154                  $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );                  $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );
155                  return;                  return;
156          }          }
157          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;
158            return $self->poke_code( $addr, map { ord($_) } split(//,$buff) );
159          return $self->write_chunk( $addr, $buff );          return $self->write_chunk( $addr, $buff );
160    
161          my $chunk;          my $chunk;
# Line 119  sub save_dump { Line 195  sub save_dump {
195          close($fh);          close($fh);
196    
197          my $size = -s $path;          my $size = -s $path;
198          printf "saved %s %d %x bytes\n", $path, $size, $size;          warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
199  }  }
200    
201  =head2 hexdump  =head2 hexdump
# Line 150  sub prompt { Line 226  sub prompt {
226          my $self = shift;          my $self = shift;
227          my $a = shift;          my $a = shift;
228          my $last = shift;          my $last = shift;
229          print $self->hexdump( $a ),          print STDERR $self->hexdump( $a ),
230                  $last ? "[$last] " : '',                  $last ? "[$last] " : '',
231                  "> ";                  "> ";
232          my $in = <STDIN>;          my $in = <STDIN>;
# Line 160  sub prompt { Line 236  sub prompt {
236          return split(/\s+/, $in) if $in;          return split(/\s+/, $in) if $in;
237  }  }
238    
239    =head1 Memory management
240    
241    Orao implements all I/O using mmap addresses. This was main reason why
242    L<Acme::6502> was just too slow to handle it.
243    
244    =cut
245    
246    =head2 read
247    
248    Read from memory
249    
250      $byte = read( $address );
251    
252    =cut
253    
254    sub read {
255            my $self = shift;
256            my ($addr) = @_;
257            my $byte = $mem[$addr];
258            warn "# Orao::read(",dump(@_),") = ",dump( $byte ),"\n" if $self->debug;
259            $self->mmap_pixel( $addr, 0, $byte, 0 );
260            return $byte;
261    }
262    
263    =head2 write
264    
265    Write into emory
266    
267      write( $address, $byte );
268    
269    =cut
270    
271    sub write {
272            my $self = shift;
273            warn "# Orao::write(",dump(@_),")\n" if $self->debug;
274            my ($addr,$byte) = @_;
275    
276            if ( $addr >= 0x6000 && $addr < 0x8000 ) {
277                    $self->vram( $addr - 0x6000 , $byte );
278            }
279    
280            if ( $addr > 0xafff ) {
281                    warn sprintf "access to %04x above affff aborting\n", $addr;
282                    return -1;
283            }
284            if ( $addr == 0x8800 ) {
285                    warn sprintf "sound ignored: %x\n", $byte;
286            }
287    
288            $self->mmap_pixel( $addr, $byte, 0, 0 );
289    
290            $mem[$addr] = $byte;
291            return;
292    }
293    
294    
295  =head1 AUTHOR  =head1 AUTHOR
296    
297  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.29  
changed lines
  Added in v.38
  ViewVC Help
Powered by ViewVC 1.1.26