/[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 36 by dpavlin, Mon Jul 30 22:06:13 2007 UTC revision 49 by dpavlin, Tue Jul 31 10:52:06 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    
63  #       $self->prompt( 0x1000 );  #       $self->prompt( 0x1000 );
64    
65          warn "rendering memory map\n";          my ( $trace, $debug ) = ( $self->trace, $self->debug );
66            $self->trace( 0 );
67            $self->debug( 0 );
68    
69            if ( $self->show_mem ) {
70    
71                    warn "rendering memory map\n";
72    
73                    my @mmap = (
74                            0x0000, 0x03FF, 'nulti blok',
75                            0x0400, 0x5FFF, 'korisnički RAM (23K)',
76                            0x6000, 0x7FFF, 'video RAM',
77                            0x8000, 0x9FFF, 'sistemske lokacije',
78                            0xA000, 0xAFFF, 'ekstenzija',
79                            0xB000, 0xBFFF, 'DOS',
80                            0xC000, 0xDFFF, 'BASIC ROM',
81                            0xE000, 0xFFFF, 'sistemski ROM',
82                    );
83    
84                    foreach my $i ( 0 .. $#mmap / 3 ) {
85                            my $o = $i * 3;
86                            my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];
87                            printf "%04x - %04x - %s\n", $from, $to, $desc;
88                            for my $a ( $from .. $to ) {
89                                    if ( $a >= 0x6000 && $a < 0x8000 ) {
90                                            my $b = $self->read( $a );
91                                            $self->vram( $a - 0x6000, $b );
92                                    } else {
93                                            $self->read( $a );
94                                    }
95                            }
96                    }
97    
98          my @mmap = (          } else {
                 0x0000, 0x03FF, 'nulti blok',  
                 0x0400, 0x5FFF, 'korisnički RAM (23K)',  
                 0x6000, 0x7FFF, 'video RAM',  
                 0x8000, 0x9FFF, 'sistemske lokacije',  
                 0xA000, 0xAFFF, 'ekstenzija',  
                 0xB000, 0xBFFF, 'DOS',  
                 0xC000, 0xDFFF, 'BASIC ROM',  
                 0xE000, 0xFFFF, 'sistemski ROM',  
         );  
99    
100          foreach my $i ( 0 .. $#mmap / 3 ) {                  warn "rendering video memory\n";
101                  my $o = $i * 3;                  for my $a ( 0x6000 .. 0x7fff ) {
102                  my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];                          $self->vram( $a - 0x6000, $mem[$a] );
                 printf "%04x - %04x - %s\n", $from, $to, $desc;  
                 for my $a ( $from .. $to ) {  
                         if ( $a >= 0x6000 && $a < 0x8000 ) {  
                                 my $b = $orao->read( $a );  
                                 $orao->vram( $a - 0x6000, $b );  
                         } else {  
                                 $orao->read( $a );  
                         }  
103                  }                  }
104                  $self->sync;          
105          }          }
106            $self->sync;
107          warn "Orao init finished\n";          $self->trace( $trace );
108            $self->debug( $debug );
109    
110            #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
111    
112            warn "Orao init finished",
113                    $self->trace ? ' trace' : '',
114                    $self->debug ? ' debug' : '',
115                    "\n";
116    
117  }  }
118    
# Line 117  sub load_rom { Line 140  sub load_rom {
140    
141  =cut  =cut
142    
143    sub _write_chunk {
144            my $self = shift;
145            my ( $addr, $chunk ) = @_;
146            $self->write_chunk( $addr, $chunk );
147            my $end = $addr + length($chunk);
148            my ( $f, $t ) = ( 0x6000, 0x7fff );
149    
150            if ( $end < $f || $addr >= $t ) {
151                    warn "skip vram update\n";
152                    return;
153            };
154    
155            $f = $addr if ( $addr > $f );
156            $t = $end if ( $end < $t );
157    
158            warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
159            foreach my $a ( $f .. $t ) {
160                    $self->vram( $a - 0x6000 , $mem[ $a ] );
161            }
162    }
163    
164  sub load_oraoemu {  sub load_oraoemu {
165          my $self = shift;          my $self = shift;
166          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
# Line 128  sub load_oraoemu { Line 172  sub load_oraoemu {
172          if ( $size == 65538 ) {          if ( $size == 65538 ) {
173                  $addr = 0;                  $addr = 0;
174                  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;
175                  $self->write_chunk( $addr, substr($buff,2) );                  $self->_write_chunk( $addr, substr($buff,2) );
176                  return;                  return;
177          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
178                  $addr = 0;                  $addr = 0;
179                  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;
180                  #$self->write_chunk( $addr, substr($buff,0x20) );                  $self->_write_chunk( $addr, substr($buff,0x20) );
                 $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );  
181                  return;                  return;
182          }          }
183          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;
184          return $self->poke_code( $addr, map { ord($_) } split(//,$buff) );          return $self->_write_chunk( $addr, $buff );
         return $self->write_chunk( $addr, $buff );  
185    
186          my $chunk;          my $chunk;
187    
# Line 155  sub load_oraoemu { Line 197  sub load_oraoemu {
197                  $pos += 4;                  $pos += 4;
198          }          }
199    
200          $self->write_chunk( $addr, $chunk );          $self->_write_chunk( $addr, $chunk );
201    
202  };  };
203    
# Line 194  sub hexdump { Line 236  sub hexdump {
236                  join(" ",                  join(" ",
237                          map {                          map {
238                                  sprintf( "%02x", $_ )                                  sprintf( "%02x", $_ )
239                          } $self->ram( $a, $a+8 )                          } @mem[ $a .. $a+8 ]
240                  )                  )
241          );          );
242  }  }
# Line 207  sub hexdump { Line 249  sub hexdump {
249    
250  sub prompt {  sub prompt {
251          my $self = shift;          my $self = shift;
252            $self->app->sync;
253          my $a = shift;          my $a = shift;
254          my $last = shift;          my $last = shift;
255          print STDERR $self->hexdump( $a ),          print STDERR $self->hexdump( $a ),
# Line 214  sub prompt { Line 257  sub prompt {
257                  "> ";                  "> ";
258          my $in = <STDIN>;          my $in = <STDIN>;
259          chomp($in);          chomp($in);
260            warn "## prompt got: $in\n" if $self->debug;
261          $in ||= $last;          $in ||= $last;
262          $last = $in;          $last = $in;
263          return split(/\s+/, $in) if $in;          return split(/\s+/, $in) if $in;
# Line 238  sub read { Line 282  sub read {
282          my $self = shift;          my $self = shift;
283          my ($addr) = @_;          my ($addr) = @_;
284          my $byte = $mem[$addr];          my $byte = $mem[$addr];
285          warn "# Orao::read(",dump(@_),") = ",dump( $byte ),"\n" if $self->debug;          warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
286          $self->mmap_pixel( $addr, 0, $byte, 0 );          $self->mmap_pixel( $addr, 0, $byte, 0 );
287          return $byte;          return $byte;
288  }  }
# Line 253  Write into emory Line 297  Write into emory
297    
298  sub write {  sub write {
299          my $self = shift;          my $self = shift;
         warn "# Orao::write(",dump(@_),")\n" if $self->debug;  
300          my ($addr,$byte) = @_;          my ($addr,$byte) = @_;
301            warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
302    
303          if ( $addr >= 0x6000 && $addr < 0x8000 ) {          if ( $addr >= 0x6000 && $addr < 0x8000 ) {
304                  $self->vram( $addr - 0x6000 , $byte );                  $self->vram( $addr - 0x6000 , $byte );
# Line 274  sub write { Line 318  sub write {
318          return;          return;
319  }  }
320    
321    =head1 Command Line
322    
323    Command-line debugging intrerface is implemented for communication with
324    emulated device
325    
326    =head2 cli
327    
328      $orao->cli();
329    
330    =cut
331    
332    my $last = 'r 1';
333    
334    sub cli {
335            my $self = shift;
336            my $a = $PC || confess "no pc?";
337            while ( my @v = $self->prompt( $a, $last ) ) {
338                    my $c = shift @v;
339                    my $v = shift @v;
340                    $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
341                    @v = map { hex($_) } @v;
342                    printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
343                    if ( $c =~ m/^[qx]/i ) {
344                            exit;
345                    } elsif ( $c eq '?' ) {
346                            warn <<__USAGE__;
347    uage:
348    x|q\t\texit
349    e 6000 6010\tdump memory, +/- to walk forward/backward
350    m 1000 ff 00\tput ff 00 on 1000
351    j|u 1000\t\tjump (change pc)
352    r 42\t\trun 42 instruction opcodes
353    t\t\ttrace on/off
354    d\t\tdebug on/off
355    __USAGE__
356                    } elsif ( $c =~ m/^e/i ) {
357                            $a = $v if defined($v);
358                            my $to = shift @v;
359                            $to = $a + 32 if ( ! $to || $to <= $a );
360                            my $lines = int( ($to - $a - 8) / 8 );
361                            printf "## m %04x %04x lines: %d\n", $a, $to, $lines;
362                            while ( $lines ) {
363                                    print $self->hexdump( $a );
364                                    $a += 8;
365                                    $lines--;
366                            }
367                            $last = '+';
368                    } elsif ( $c =~ m/^\+/ ) {
369                            $a += 8;
370                    } elsif ( $c =~ m/^\-/ ) {
371                            $a -= 8;
372                    } elsif ( $c =~ m/^m/i ) {
373                            $a = $v;
374                            $self->poke_code( $a, @v );
375                            printf "poke %d bytes at %04x\n", $#v + 1, $a;
376                    } elsif ( $c =~ m/^l/i ) {
377                            my $to = shift @v || 0x1000;
378                            $a = $to;
379                            $self->load_oraoemu( $v, $a );
380                    } elsif ( $c =~ m/^s/i ) {
381                            $self->save_dump( $v || 'mem.dump', @v );
382                    } elsif ( $c =~ m/^r/i ) {
383                            $run_for = $v || 1;
384                            print "run_for $run_for instructions\n";
385                            last;
386                    } elsif ( $c =~ m/^(u|j)/ ) {
387                            my $to = $v || $a;
388                            printf "set pc to %04x\n", $to;
389                            $PC = $to;      # remember for restart
390                            $run_for = 1;
391                            last;
392                    } elsif ( $c =~ m/^t/ ) {
393                            $self->trace( not $self->trace );
394                            print "trace ", $self->trace ? 'on' : 'off', "\n";
395                    } elsif ( $c =~ m/^d/ ) {
396                            $self->debug( not $self->debug );
397                            print "debug ", $self->debug ? 'on' : 'off', "\n";
398                    } else {
399                            warn "# ignore $c\n";
400                            last;
401                    }
402            }
403    
404    
405    }
406    
407  =head1 AUTHOR  =head1 AUTHOR
408    
Legend:
Removed from v.36  
changed lines
  Added in v.49
  ViewVC Help
Powered by ViewVC 1.1.26