/[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 47 by dpavlin, Tue Jul 31 10:16:36 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 = $self->trace;
66          0xC000 => 'rom/BAS12.ROM',          $self->trace( 0 );
67          0xE000 => 'rom/CRT12.ROM',  
68  };          if ( $self->show_mem ) {
69    
70                    warn "rendering memory map\n";
71    
72                    my @mmap = (
73                            0x0000, 0x03FF, 'nulti blok',
74                            0x0400, 0x5FFF, 'korisnički RAM (23K)',
75                            0x6000, 0x7FFF, 'video RAM',
76                            0x8000, 0x9FFF, 'sistemske lokacije',
77                            0xA000, 0xAFFF, 'ekstenzija',
78                            0xB000, 0xBFFF, 'DOS',
79                            0xC000, 0xDFFF, 'BASIC ROM',
80                            0xE000, 0xFFFF, 'sistemski ROM',
81                    );
82    
83                    foreach my $i ( 0 .. $#mmap / 3 ) {
84                            my $o = $i * 3;
85                            my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];
86                            printf "%04x - %04x - %s\n", $from, $to, $desc;
87                            for my $a ( $from .. $to ) {
88                                    if ( $a >= 0x6000 && $a < 0x8000 ) {
89                                            my $b = $self->read( $a );
90                                            $self->vram( $a - 0x6000, $b );
91                                    } else {
92                                            $self->read( $a );
93                                    }
94                            }
95                    }
96    
97            } else {
98    
99                    warn "rendering video memory\n";
100                    for my $a ( 0x6000 .. 0x7fff ) {
101                            $self->vram( $a - 0x6000, $mem[$a] );
102                    }
103            
104            }
105            $self->sync;
106            $self->trace( $trace );
107    
108            #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
109    
110            warn "Orao init finished", $self->trace ? ' trace on' : '', "\n";
111    
112    }
113    
114  =head2 load_rom  =head2 load_rom
115    
# Line 67  called to init memory and load initial r Line 120  called to init memory and load initial r
120  =cut  =cut
121    
122  sub load_rom {  sub load_rom {
123      my ($self) = @_;      my ($self, $loaded_files) = @_;
124    
125      #my $time_base = time();      #my $time_base = time();
126    
127          foreach my $addr ( sort keys %$loaded_files ) {          foreach my $addr ( sort keys %$loaded_files ) {
128                  my $path = $loaded_files->{$addr};                  my $path = $loaded_files->{$addr};
                 warn sprintf "loading '%s' at %04x\n", $path, $addr;  
129                  $self->load_oraoemu( $path, $addr );                  $self->load_oraoemu( $path, $addr );
130          }          }
131  }  }
# Line 83  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 93  sub load_oraoemu { Line 166  sub load_oraoemu {
166    
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, $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, $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, $size;          printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
179          return $self->write_chunk( $addr, $buff );          return $self->_write_chunk( $addr, $buff );
180    
181          my $chunk;          my $chunk;
182    
# Line 120  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 159  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 172  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 191  L<Acme::6502> was just too slow to handl Line 264  L<Acme::6502> was just too slow to handl
264    
265  =cut  =cut
266    
 my @mem = (0xff) x 0x100000; # 64Mb  
   
267  =head2 read  =head2 read
268    
269  Read from memory  Read from memory
# Line 202  Read from memory Line 273  Read from memory
273  =cut  =cut
274    
275  sub read {  sub read {
276          my $self = $orao;          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          mmap_pixel( $addr, 0, $byte, 0 );          $self->mmap_pixel( $addr, 0, $byte, 0 );
281          return $byte;          return $byte;
282  }  }
283    
# Line 219  Write into emory Line 290  Write into emory
290  =cut  =cut
291    
292  sub write {  sub write {
293          my $self = $orao;          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 235  sub write { Line 306  sub write {
306                  warn sprintf "sound ignored: %x\n", $byte;                  warn sprintf "sound ignored: %x\n", $byte;
307          }          }
308    
309          mmap_pixel( $addr, $byte, 0, 0 );          $self->mmap_pixel( $addr, $byte, 0, 0 );
310    
311          $mem[$addr] = $byte;          $mem[$addr] = $byte;
312            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.32  
changed lines
  Added in v.47
  ViewVC Help
Powered by ViewVC 1.1.26