/[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 31 by dpavlin, Mon Jul 30 18:07:29 2007 UTC revision 47 by dpavlin, Tue Jul 31 10:16:36 2007 UTC
# Line 7  use Carp; Line 7  use Carp;
7  use lib './lib';  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/;
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 35  Start emulator Line 37  Start emulator
37    
38  =cut  =cut
39    
40    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;
62    
63    #       $self->prompt( 0x1000 );
64    
65            my $trace = $self->trace;
66            $self->trace( 0 );
67    
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  my $loaded_files = {          #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
109          0xC000 => 'rom/BAS12.ROM',  
110          0xE000 => 'rom/CRT12.ROM',          warn "Orao init finished", $self->trace ? ' trace on' : '', "\n";
111  };  
112    }
113    
114  =head2 load_rom  =head2 load_rom
115    
# Line 60  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};
                 printf "loading '%s' at %04x\n", $path, $addr;  
129                  $self->load_oraoemu( $path, $addr );                  $self->load_oraoemu( $path, $addr );
130          }          }
131  }  }
# Line 76  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 86  sub load_oraoemu { Line 166  sub load_oraoemu {
166    
167          if ( $size == 65538 ) {          if ( $size == 65538 ) {
168                  $addr = 0;                  $addr = 0;
169                  printf "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                  printf "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 113  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 136  sub save_dump { Line 215  sub save_dump {
215          close($fh);          close($fh);
216    
217          my $size = -s $path;          my $size = -s $path;
218          printf "saved %s %d %x bytes\n", $path, $size, $size;          warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
219  }  }
220    
221  =head2 hexdump  =head2 hexdump
# Line 152  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 165  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 $self->hexdump( $a ),          print STDERR $self->hexdump( $a ),
251                  $last ? "[$last] " : '',                  $last ? "[$last] " : '',
252                  "> ";                  "> ";
253          my $in = <STDIN>;          my $in = <STDIN>;
# Line 177  sub prompt { Line 257  sub prompt {
257          return split(/\s+/, $in) if $in;          return split(/\s+/, $in) if $in;
258  }  }
259    
260    =head1 Memory management
261    
262    Orao implements all I/O using mmap addresses. This was main reason why
263    L<Acme::6502> was just too slow to handle it.
264    
265    =cut
266    
267    =head2 read
268    
269    Read from memory
270    
271      $byte = read( $address );
272    
273    =cut
274    
275    sub read {
276            my $self = shift;
277            my ($addr) = @_;
278            my $byte = $mem[$addr];
279            warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
280            $self->mmap_pixel( $addr, 0, $byte, 0 );
281            return $byte;
282    }
283    
284    =head2 write
285    
286    Write into emory
287    
288      write( $address, $byte );
289    
290    =cut
291    
292    sub write {
293            my $self = shift;
294            my ($addr,$byte) = @_;
295            warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
296    
297            if ( $addr >= 0x6000 && $addr < 0x8000 ) {
298                    $self->vram( $addr - 0x6000 , $byte );
299            }
300    
301            if ( $addr > 0xafff ) {
302                    warn sprintf "access to %04x above affff aborting\n", $addr;
303                    return -1;
304            }
305            if ( $addr == 0x8800 ) {
306                    warn sprintf "sound ignored: %x\n", $byte;
307            }
308    
309            $self->mmap_pixel( $addr, $byte, 0, 0 );
310    
311            $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.31  
changed lines
  Added in v.47
  ViewVC Help
Powered by ViewVC 1.1.26