/[VRac]/M6502/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 /M6502/Orao.pm

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

revision 38 by dpavlin, Mon Jul 30 23:28:25 2007 UTC revision 47 by dpavlin, Tue Jul 31 10:16:36 2007 UTC
# Line 39  Start emulator Line 39  Start emulator
39    
40  our $orao;  our $orao;
41    
42    select(STDERR); $| = 1;
43    
44  sub init {  sub init {
45          my $self = shift;          my $self = shift;
46          warn "Orao calling upstream init\n";          warn "Orao calling upstream init\n";
# Line 53  sub init { Line 55  sub init {
55                  0xE000 => 'rom/CRT12.ROM',                  0xE000 => 'rom/CRT12.ROM',
56          });          });
57    
58          $self->load_oraoemu( 'dump/orao-1.2' );          $PC = 0xDD11;   # BC
59          $self->load_oraoemu( 'dump/SCRINV.BIN' );  #       $PC = 0xC274;   # MC
         $PC = 0x1000;  
60    
61          $orao = $self;          $orao = $self;
62    
# Line 104  sub init { Line 105  sub init {
105          $self->sync;          $self->sync;
106          $self->trace( $trace );          $self->trace( $trace );
107    
108          ( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );          #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
109    
110          warn "Orao init finished", $self->trace ? ' trace on' : '', "\n";          warn "Orao init finished", $self->trace ? ' trace on' : '', "\n";
111    
# Line 134  sub load_rom { Line 135  sub load_rom {
135    
136  =cut  =cut
137    
138    sub _write_chunk {
139            my $self = shift;
140            my ( $addr, $chunk ) = @_;
141            $self->write_chunk( $addr, $chunk );
142            my $end = $addr + length($chunk);
143            my ( $f, $t ) = ( 0x6000, 0x7fff );
144    
145            if ( $end < $f || $addr >= $t ) {
146                    warn "skip vram update\n";
147                    return;
148            };
149    
150            $f = $addr if ( $addr > $f );
151            $t = $end if ( $end < $t );
152    
153            warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
154            foreach my $a ( $f .. $t ) {
155                    $self->vram( $a - 0x6000 , $mem[ $a ] );
156            }
157    }
158    
159  sub load_oraoemu {  sub load_oraoemu {
160          my $self = shift;          my $self = shift;
161          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
# Line 145  sub load_oraoemu { Line 167  sub load_oraoemu {
167          if ( $size == 65538 ) {          if ( $size == 65538 ) {
168                  $addr = 0;                  $addr = 0;
169                  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;
170                  $self->write_chunk( $addr, substr($buff,2) );                  $self->_write_chunk( $addr, substr($buff,2) );
171                  return;                  return;
172          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
173                  $addr = 0;                  $addr = 0;
174                  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;
175                  #$self->write_chunk( $addr, substr($buff,0x20) );                  $self->_write_chunk( $addr, substr($buff,0x20) );
                 $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );  
176                  return;                  return;
177          }          }
178          printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;          printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
179          return $self->poke_code( $addr, map { ord($_) } split(//,$buff) );          return $self->_write_chunk( $addr, $buff );
         return $self->write_chunk( $addr, $buff );  
180    
181          my $chunk;          my $chunk;
182    
# Line 172  sub load_oraoemu { Line 192  sub load_oraoemu {
192                  $pos += 4;                  $pos += 4;
193          }          }
194    
195          $self->write_chunk( $addr, $chunk );          $self->_write_chunk( $addr, $chunk );
196    
197  };  };
198    
# Line 211  sub hexdump { Line 231  sub hexdump {
231                  join(" ",                  join(" ",
232                          map {                          map {
233                                  sprintf( "%02x", $_ )                                  sprintf( "%02x", $_ )
234                          } $self->ram( $a, $a+8 )                          } @mem[ $a .. $a+8 ]
235                  )                  )
236          );          );
237  }  }
# Line 224  sub hexdump { Line 244  sub hexdump {
244    
245  sub prompt {  sub prompt {
246          my $self = shift;          my $self = shift;
247            $self->app->sync;
248          my $a = shift;          my $a = shift;
249          my $last = shift;          my $last = shift;
250          print STDERR $self->hexdump( $a ),          print STDERR $self->hexdump( $a ),
# Line 255  sub read { Line 276  sub read {
276          my $self = shift;          my $self = shift;
277          my ($addr) = @_;          my ($addr) = @_;
278          my $byte = $mem[$addr];          my $byte = $mem[$addr];
279          warn "# Orao::read(",dump(@_),") = ",dump( $byte ),"\n" if $self->debug;          warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
280          $self->mmap_pixel( $addr, 0, $byte, 0 );          $self->mmap_pixel( $addr, 0, $byte, 0 );
281          return $byte;          return $byte;
282  }  }
# Line 270  Write into emory Line 291  Write into emory
291    
292  sub write {  sub write {
293          my $self = shift;          my $self = shift;
         warn "# Orao::write(",dump(@_),")\n" if $self->debug;  
294          my ($addr,$byte) = @_;          my ($addr,$byte) = @_;
295            warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
296    
297          if ( $addr >= 0x6000 && $addr < 0x8000 ) {          if ( $addr >= 0x6000 && $addr < 0x8000 ) {
298                  $self->vram( $addr - 0x6000 , $byte );                  $self->vram( $addr - 0x6000 , $byte );
# Line 291  sub write { Line 312  sub write {
312          return;          return;
313  }  }
314    
315    =head1 Command Line
316    
317    Command-line debugging intrerface is implemented for communication with
318    emulated device
319    
320    =head2 cli
321    
322      $orao->cli();
323    
324    =cut
325    
326    my $last = 'r 1';
327    
328    sub cli {
329            my $self = shift;
330            my $a = $PC || confess "no pc?";
331            while ( my @v = $self->prompt( $a, $last ) ) {
332                    my $c = shift @v;
333                    my $v = shift @v;
334                    $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
335                    printf "## [%s] %s\n", ($v || 'undef'), join(",",@v) if $self->debug;
336                    @v = map { hex($_) } @v;
337                    if ( $c =~ m/^[qx]/i ) {
338                            exit;
339                    } elsif ( $c eq '?' ) {
340                            warn <<__USAGE__;
341    uage:
342    x|q\t\texit
343    e 6000 6010\tdump memory, +/- to walk forward/backward
344    m 1000 ff 00\tput ff 00 on 1000
345    j|u 1000\t\tjump (change pc)
346    r 42\t\trun 42 instruction opcodes
347    __USAGE__
348                    } elsif ( $c =~ m/^e/i ) {
349                            $a ||= $v;
350                            my $to = shift @v;
351                            $to = $a + 32 if ( ! $to || $to <= $a );
352                            my $lines = int( ($to - $a - 8) / 8 );
353                            printf "## m %04x %04x lines: %d\n", $a, $to, $lines;
354                            while ( $lines ) {
355                                    print $self->hexdump( $a );
356                                    $a += 8;
357                                    $lines--;
358                            }
359                            $last = '+';
360                    } elsif ( $c =~ m/^\+/ ) {
361                            $a += 8;
362                    } elsif ( $c =~ m/^\-/ ) {
363                            $a -= 8;
364                    } elsif ( $c =~ m/^m/i ) {
365                            $a = $v;
366                            $self->poke_code( $a, @v );
367                            printf "poke %d bytes at %04x\n", $#v + 1, $a;
368                    } elsif ( $c =~ m/^l/i ) {
369                            my $to = shift @v || 0x1000;
370                            $a = $to;
371                            $self->load_oraoemu( $v, $a );
372                    } elsif ( $c =~ m/^s/i ) {
373                            $self->save_dump( $v || 'mem.dump', @v );
374                    } elsif ( $c =~ m/^r/i ) {
375                            $run_for = $v || 1;
376                            print "run_for $run_for instructions\n";
377                            last;
378                    } elsif ( $c =~ m/^(u|j)/ ) {
379                            my $to = $v || $a;
380                            printf "set pc to %04x\n", $to;
381                            $PC = $to;      # remember for restart
382                            $run_for = 1;
383                            last;
384                    } elsif ( $c =~ m/^t/ ) {
385                            $self->trace( not $self->trace );
386                            print "trace ", $self->trace ? 'on' : 'off', "\n";
387                    } else {
388                            warn "# ignore $c\n";
389                            last;
390                    }
391            }
392    
393    
394    }
395    
396  =head1 AUTHOR  =head1 AUTHOR
397    

Legend:
Removed from v.38  
changed lines
  Added in v.47

  ViewVC Help
Powered by ViewVC 1.1.26