/[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 32 by dpavlin, Mon Jul 30 18:37:37 2007 UTC revision 49 by dpavlin, Tue Jul 31 10:52:06 2007 UTC
# Line 8  use lib './lib'; Line 8  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/;  use Data::Dump qw/dump/;
11    use M6502;
12    
13  use base qw(Class::Accessor M6502 Screen);  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));
# Line 38  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 "call upstream init\n";          warn "Orao calling upstream init\n";
47          $self->SUPER::init( @_ );          $self->SUPER::init( $self, @_ );
48    
49          warn "staring Orao $Orao::VERSION emulation\n";          warn "staring Orao $Orao::VERSION emulation\n";
50    
51          $self->open_screen;          $self->open_screen;
52          $self->load_rom;          $self->load_rom({
53                    0x1000 => 'dump/SCRINV.BIN',
54                    0xC000 => 'rom/BAS12.ROM',
55                    0xE000 => 'rom/CRT12.ROM',
56            });
57    
58            $PC = 0xDD11;   # BC
59    #       $PC = 0xC274;   # MC
60    
61          $orao = $self;          $orao = $self;
62    
63          $self->prompt( 0x1000 );  #       $self->prompt( 0x1000 );
 }  
64    
65  my $loaded_files = {          my ( $trace, $debug ) = ( $self->trace, $self->debug );
66          0xC000 => 'rom/BAS12.ROM',          $self->trace( 0 );
67          0xE000 => 'rom/CRT12.ROM',          $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            } else {
99    
100                    warn "rendering video memory\n";
101                    for my $a ( 0x6000 .. 0x7fff ) {
102                            $self->vram( $a - 0x6000, $mem[$a] );
103                    }
104            
105            }
106            $self->sync;
107            $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    
119  =head2 load_rom  =head2 load_rom
120    
# Line 67  called to init memory and load initial r Line 125  called to init memory and load initial r
125  =cut  =cut
126    
127  sub load_rom {  sub load_rom {
128      my ($self) = @_;      my ($self, $loaded_files) = @_;
129    
130      #my $time_base = time();      #my $time_base = time();
131    
132          foreach my $addr ( sort keys %$loaded_files ) {          foreach my $addr ( sort keys %$loaded_files ) {
133                  my $path = $loaded_files->{$addr};                  my $path = $loaded_files->{$addr};
                 warn sprintf "loading '%s' at %04x\n", $path, $addr;  
134                  $self->load_oraoemu( $path, $addr );                  $self->load_oraoemu( $path, $addr );
135          }          }
136  }  }
# Line 83  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 93  sub load_oraoemu { Line 171  sub load_oraoemu {
171    
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, $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, $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, $size;          printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
184          return $self->write_chunk( $addr, $buff );          return $self->_write_chunk( $addr, $buff );
185    
186          my $chunk;          my $chunk;
187    
# Line 120  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 159  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 172  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 179  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 191  L<Acme::6502> was just too slow to handl Line 270  L<Acme::6502> was just too slow to handl
270    
271  =cut  =cut
272    
 my @mem = (0xff) x 0x100000; # 64Mb  
   
273  =head2 read  =head2 read
274    
275  Read from memory  Read from memory
# Line 202  Read from memory Line 279  Read from memory
279  =cut  =cut
280    
281  sub read {  sub read {
282          my $self = $orao;          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          mmap_pixel( $addr, 0, $byte, 0 );          $self->mmap_pixel( $addr, 0, $byte, 0 );
287          return $byte;          return $byte;
288  }  }
289    
# Line 219  Write into emory Line 296  Write into emory
296  =cut  =cut
297    
298  sub write {  sub write {
299          my $self = $orao;          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 235  sub write { Line 312  sub write {
312                  warn sprintf "sound ignored: %x\n", $byte;                  warn sprintf "sound ignored: %x\n", $byte;
313          }          }
314    
315          mmap_pixel( $addr, $byte, 0, 0 );          $self->mmap_pixel( $addr, $byte, 0, 0 );
316    
317          $mem[$addr] = $byte;          $mem[$addr] = $byte;
318            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.32  
changed lines
  Added in v.49
  ViewVC Help
Powered by ViewVC 1.1.26