/[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 126 by dpavlin, Sat Aug 4 15:43:28 2007 UTC revision 138 by dpavlin, Sat Aug 4 22:47:32 2007 UTC
# Line 32  Emulator or Orao 8-bit 6502 machine popu Line 32  Emulator or Orao 8-bit 6502 machine popu
32    
33  =head1 FUNCTIONS  =head1 FUNCTIONS
34    
35  =head2 boot  =head2 run
   
 Start emulator, open L<Screen>, load initial ROM images, and render memory  
36    
37    my $emu = Orao->new({});  Start emulator, open L<Screen>, load initial ROM images, and start emulator loop
   $emu->boot;  
38    
39  =cut  =cut
40    
41  our $emu;  our $emu;
42    
43  select(STDERR); $| = 1;  sub run {
   
 sub boot {  
44          my $self = shift;          my $self = shift;
45    
46          warn "Orao calling upstream init\n";          warn "Orao calling upstream init\n";
47          $self->SUPER::init(          $self->SUPER::init(
48                  read => sub { $self->read( @_ ) },                  read => sub { $self->read( @_ ) },
# Line 58  sub boot { Line 54  sub boot {
54          warn "emulating ", $#mem, " bytes of memory\n";          warn "emulating ", $#mem, " bytes of memory\n";
55    
56  #       $self->scale( 2 );  #       $self->scale( 2 );
57            $self->show_mem( 1 );
58    
59          $self->open_screen;          $self->open_screen;
60          $self->load_rom({          $self->load_rom({
# Line 83  sub boot { Line 80  sub boot {
80          $self->trace( 0 );          $self->trace( 0 );
81          $self->debug( 0 );          $self->debug( 0 );
82    
83          warn "rendering video memory\n";          warn "rendering memory\n";
84          $self->render_vram( @mem[ 0x6000 .. 0x7fff ] );          $self->render_mem( @mem );
85    
86          if ( $self->show_mem ) {          if ( $self->show_mem ) {
87    
                 warn "rendering memory map\n";  
   
                 $self->render_mem( @mem );  
   
88                  my @mmap = (                  my @mmap = (
89                          0x0000, 0x03FF, 'nulti blok',                          0x0000, 0x03FF, 'nulti blok',
90                          0x0400, 0x5FFF, 'korisnički RAM (23K)',                          0x0400, 0x5FFF, 'korisnički RAM (23K)',
# Line 103  sub boot { Line 96  sub boot {
96                          0xE000, 0xFFFF, 'sistemski ROM',                          0xE000, 0xFFFF, 'sistemski ROM',
97                  );                  );
98    
99                    print "Orao memory map:";
100    
101                    while ( @mmap ) {
102                            my ( $from, $to, $desc ) = splice(@mmap, 0, 3);
103                            printf("%04x-%04x %s\n", $from, $to, $desc);
104                    }
105    
106          }          }
107          $self->sync;  
108          $self->trace( $trace );          $self->trace( $trace );
109          $self->debug( $debug );          $self->debug( $debug );
110    
         #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );  
   
111          warn "Orao boot finished",          warn "Orao boot finished",
112                  $self->trace ? ' trace' : '',                  $self->trace ? ' trace' : '',
113                  $self->debug ? ' debug' : '',                  $self->debug ? ' debug' : '',
# Line 117  sub boot { Line 115  sub boot {
115    
116          M6502::reset();          M6502::reset();
117    
         $self->booted( 1 );  
 }  
   
 =head2 run  
   
 Run interactive emulation loop  
   
   $emu->run;  
   
 =cut  
   
 sub run {  
         my $self = shift;  
   
         $self->boot if ( ! $self->booted );  
   
118  #       $self->load_tape( '../oraoigre/bdash.tap' );  #       $self->load_tape( '../oraoigre/bdash.tap' );
119    
120          $self->loop( sub {          $self->loop( sub {
121                  M6502::exec( $_[0] );                  my $run_for = shift;
122                    warn sprintf("about to exec from PC %04x for %d cycles\n", $PC, $run_for) if $self->trace;
123                    M6502::exec( $run_for );
124                  $self->render_vram;                  $self->render_vram;
125          });          });
126  };  };
127    
128    
129  =head1 Helper functions  =head1 Helper functions
130    
131    =head2 write_chunk
132    
133    Write chunk directly into memory, updateing vram if needed
134    
135      $emu->write_chunk( 0x1000, $chunk_data );
136    
137  =cut  =cut
138    
139  # write chunk directly into memory, updateing vram if needed  sub write_chunk {
 sub _write_chunk {  
140          my $self = shift;          my $self = shift;
141          my ( $addr, $chunk ) = @_;          my ( $addr, $chunk ) = @_;
142          $self->write_chunk( $addr, $chunk );          $self->SUPER::write_chunk( $addr, $chunk );
143          my $end = $addr + length($chunk);          my $end = $addr + length($chunk);
144          my ( $f, $t ) = ( 0x6000, 0x7fff );          my ( $f, $t ) = ( 0x6000, 0x7fff );
145    
# Line 162  sub _write_chunk { Line 152  sub _write_chunk {
152          $t = $end if ( $end < $t );          $t = $end if ( $end < $t );
153    
154          warn sprintf("refresh video ram %04x-%04x\n", $f, $t);          warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
155          $self->render_vram( @mem[ 0x6000 .. 0x7fff ] );          $self->render_vram;
156          $self->render_mem( @mem ) if $self->show_mem;          $self->render_mem( @mem );
157  }  }
158    
159  =head2 load_image  =head2 load_image
# Line 192  sub load_image { Line 182  sub load_image {
182          if ( $size == 65538 ) {          if ( $size == 65538 ) {
183                  $addr = 0;                  $addr = 0;
184                  warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;                  warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
185                  $self->_write_chunk( $addr, substr($buff,2) );                  $self->write_chunk( $addr, substr($buff,2) );
186                  return 1;                  return 1;
187          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
188                  $addr = 0;                  $addr = 0;
189                  warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;                  warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
190                  $self->_write_chunk( $addr, substr($buff,0x20) );                  $self->write_chunk( $addr, substr($buff,0x20) );
191                  return 1;                  return 1;
192          }          }
         printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;  
         $self->_write_chunk( $addr, $buff );  
         return 1;  
   
         my $chunk;  
   
         my $pos = 0;  
   
         while ( my $long = substr($buff,$pos,4) ) {  
                 my @b = split(//, $long, 4);  
                 $chunk .=  
                         ( $b[3] || '' ) .  
                         ( $b[2] || '' ) .  
                         ( $b[1] || '' ) .  
                         ( $b[0] || '' );  
                 $pos += 4;  
         }  
   
         $self->_write_chunk( $addr, $chunk );  
193    
194            printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
195            $self->write_chunk( $addr, $buff );
196          return 1;          return 1;
197  };  };
198    
# Line 365  my $keyboard = { Line 338  my $keyboard = {
338  sub read {  sub read {
339          my $self = shift;          my $self = shift;
340          my ($addr) = @_;          my ($addr) = @_;
341            return if ( $addr > 0xffff );
342          my $byte = $mem[$addr];          my $byte = $mem[$addr];
343          confess sprintf("can't find memory at address %04x",$addr) unless defined($byte);          confess sprintf("can't find memory at address %04x",$addr) unless defined($byte);
344          warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;          warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
# Line 397  sub read { Line 371  sub read {
371                  return $self->read_tape;                  return $self->read_tape;
372          }          }
373    
374          $self->mmap_pixel( $addr, 0, $byte, 0 );          $self->mmap_pixel( $addr, 0, $byte, 0 ) if $self->show_mem;
375          return $byte;          return $byte;
376  }  }
377    
# Line 422  sub write { Line 396  sub write {
396                  confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;                  confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
397          }          }
398    
399          $self->mmap_pixel( $addr, $byte, 0, 0 );          $self->mmap_pixel( $addr, $byte, 0, 0 ) if $self->show_mem;
   
400          $mem[$addr] = $byte;          $mem[$addr] = $byte;
401          return;          return;
402  }  }
403    
404    =head1 Architecture specific
405    
406  =head2 render_vram  =head2 render_vram
407    
408  Render one frame of video ram  Render one frame of video ram
# Line 456  foreach my $i ( 0 .. 255 ) { Line 431  foreach my $i ( 0 .. 255 ) {
431  sub render_vram {  sub render_vram {
432          my $self = shift;          my $self = shift;
433    
         return unless $self->booted;  
   
434          my $pixels = pack("C*", map { $flip[$_] } @mem[ 0x6000 .. 0x7fff ]);          my $pixels = pack("C*", map { $flip[$_] } @mem[ 0x6000 .. 0x7fff ]);
435    
436          my $vram = SDL::Surface->new(          my $vram = SDL::Surface->new(
# Line 472  sub render_vram { Line 445  sub render_vram {
445          $self->render_frame( $vram );          $self->render_frame( $vram );
446  }  }
447    
448    =head2 cpu_PC
449    
450    Helper metod to set or get PC for current architecture
451    
452    =cut
453    
454    sub cpu_PC {
455            my ( $self, $addr ) = @_;
456            if ( defined($addr) ) {
457                    $PC = $addr;
458                    warn sprintf("running from PC %04x\n", $PC);
459            };
460            return $PC;
461    }
462    
463  =head1 AUTHOR  =head1 AUTHOR
464    
465  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.126  
changed lines
  Added in v.138
  ViewVC Help
Powered by ViewVC 1.1.26