/[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 33 by dpavlin, Mon Jul 30 21:00:36 2007 UTC revision 76 by dpavlin, Wed Aug 1 12:57:15 2007 UTC
# Line 3  package Orao; Line 3  package Orao;
3  use warnings;  use warnings;
4  use strict;  use strict;
5    
6  use Carp;  use Carp qw/confess/;
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/;  use Data::Dump qw/dump/;
11    use M6502;
12    
13  use base qw(Class::Accessor M6502 Screen);  use base qw(Class::Accessor M6502 Screen Prefs);
14  __PACKAGE__->mk_accessors(qw(debug trace run_for mem_dump trace));  __PACKAGE__->mk_accessors(qw(run_for));
15    
16  =head1 NAME  =head1 NAME
17    
# Line 32  Emulator or Orao 8-bit 6502 machine popu Line 33  Emulator or Orao 8-bit 6502 machine popu
33    
34  =head2 init  =head2 init
35    
36  Start emulator  Start emulator, open L<Screen>, load initial ROM images, and render memory
37    
38  =cut  =cut
39    
40  our $orao;  our $orao;
41    
42  our $PC = 0x1000;  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, @_ );          $self->SUPER::init( $self, @_ );
48    
49          warn "staring Orao $Orao::VERSION emulation\n";          warn "Orao $Orao::VERSION emulation starting\n";
50    
51          $self->open_screen;          $self->open_screen;
52          $self->load_rom({          $self->load_rom({
53                  0x1000 => 'dump/SCRINV.BIN',                  0x1000 => 'dump/SCRINV.BIN',
54                    # should be 0x6000, but oraoemu has 2 byte prefix
55                    0x5FFE => 'dump/screen.dmp',
56                  0xC000 => 'rom/BAS12.ROM',                  0xC000 => 'rom/BAS12.ROM',
57                  0xE000 => 'rom/CRT12.ROM',                  0xE000 => 'rom/CRT12.ROM',
58          });          });
59    
60    #       $PC = 0xDD11;   # BC
61    #       $PC = 0xC274;   # MC
62    
63          $orao = $self;          $orao = $self;
64    
65  #       $self->prompt( 0x1000 );  #       $self->prompt( 0x1000 );
66    
67          warn "rendering memory map\n";          my ( $trace, $debug ) = ( $self->trace, $self->debug );
68            $self->trace( 0 );
69            $self->debug( 0 );
70    
71            $self->render( @mem[ 0x6000 .. 0x7fff ] );
72    
73            if ( $self->show_mem ) {
74    
75                    warn "rendering memory map\n";
76    
77                    $self->render_mem( @mem );
78    
79                    my @mmap = (
80                            0x0000, 0x03FF, 'nulti blok',
81                            0x0400, 0x5FFF, 'korisnički RAM (23K)',
82                            0x6000, 0x7FFF, 'video RAM',
83                            0x8000, 0x9FFF, 'sistemske lokacije',
84                            0xA000, 0xAFFF, 'ekstenzija',
85                            0xB000, 0xBFFF, 'DOS',
86                            0xC000, 0xDFFF, 'BASIC ROM',
87                            0xE000, 0xFFFF, 'sistemski ROM',
88                    );
89    
90    if(0){
91                    foreach my $i ( 0 .. $#mmap / 3 ) {
92                            my $o = $i * 3;
93                            my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];
94                            printf "%04x - %04x - %s\n", $from, $to, $desc;
95                            for my $a ( $from .. $to ) {
96                                    if ( $a >= 0x6000 && $a < 0x8000 ) {
97                                            my $b = $self->read( $a );
98                                            $self->vram( $a - 0x6000, $b );
99                                    } else {
100                                            $self->read( $a );
101                                    }
102                            }
103                    }
104    }
105    
106          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',  
         );  
107    
108          foreach my $i ( 0 .. $#mmap / 3 ) {                  warn "rendering video memory\n";
109                  my $o = $i * 3;  #               for my $a ( 0x6000 .. 0x7fff ) {
110                  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 ) {  
 #                       $orao->read( $a );  
111  #               }  #               }
112  #               $self->sync;                  $self->render( @mem[ 0x6000 .. 0x7fff ] );
113            
114          }          }
115            $self->sync;
116            $self->trace( $trace );
117            $self->debug( $debug );
118    
119            #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
120    
121            warn "Orao init finished",
122                    $self->trace ? ' trace' : '',
123                    $self->debug ? ' debug' : '',
124                    "\n";
125    
126  }  }
127    
# Line 102  sub load_rom { Line 144  sub load_rom {
144          }          }
145  }  }
146    
147    # write chunk directly into memory, updateing vram if needed
148    sub _write_chunk {
149            my $self = shift;
150            my ( $addr, $chunk ) = @_;
151            $self->write_chunk( $addr, $chunk );
152            my $end = $addr + length($chunk);
153            my ( $f, $t ) = ( 0x6000, 0x7fff );
154    
155            if ( $end < $f || $addr >= $t ) {
156                    warn "skip vram update\n";
157                    return;
158            };
159    
160            $f = $addr if ( $addr > $f );
161            $t = $end if ( $end < $t );
162    
163            warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
164    #       foreach my $a ( $f .. $t ) {
165    #               $self->vram( $a - 0x6000 , $mem[ $a ] );
166    #       }
167            $self->render( @mem[ 0x6000 .. 0x7fff ] );
168    }
169    
170  =head2 load_oraoemu  =head2 load_oraoemu
171    
172    Load binary files, ROM images and Orao Emulator files
173    
174      $orao->load_oraoemu( '/path/to/file', 0x1000 );
175    
176    Returns true on success.
177    
178  =cut  =cut
179    
180  sub load_oraoemu {  sub load_oraoemu {
181          my $self = shift;          my $self = shift;
182          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
183    
184            if ( ! -e $path ) {
185                    warn "ERROR: file $path doesn't exist\n";
186                    return;
187            }
188    
189          my $size = -s $path || confess "no size for $path: $!";          my $size = -s $path || confess "no size for $path: $!";
190    
191          my $buff = read_file( $path );          my $buff = read_file( $path );
# Line 118  sub load_oraoemu { Line 193  sub load_oraoemu {
193          if ( $size == 65538 ) {          if ( $size == 65538 ) {
194                  $addr = 0;                  $addr = 0;
195                  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;
196                  $self->write_chunk( $addr, substr($buff,2) );                  $self->_write_chunk( $addr, substr($buff,2) );
197                  return;                  return 1;
198          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
199                  $addr = 0;                  $addr = 0;
200                  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;
201                  #$self->write_chunk( $addr, substr($buff,0x20) );                  $self->_write_chunk( $addr, substr($buff,0x20) );
202                  $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );                  return 1;
                 return;  
203          }          }
204          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;
205          return $self->write_chunk( $addr, $buff );          $self->_write_chunk( $addr, $buff );
206            return 1;
207    
208          my $chunk;          my $chunk;
209    
# Line 144  sub load_oraoemu { Line 219  sub load_oraoemu {
219                  $pos += 4;                  $pos += 4;
220          }          }
221    
222          $self->write_chunk( $addr, $chunk );          $self->_write_chunk( $addr, $chunk );
223    
224            return 1;
225  };  };
226    
227  =head2 save_dump  =head2 save_dump
# Line 182  sub hexdump { Line 258  sub hexdump {
258          return sprintf(" %04x %s\n", $a,          return sprintf(" %04x %s\n", $a,
259                  join(" ",                  join(" ",
260                          map {                          map {
261                                  sprintf( "%02x", $_ )                                  if ( defined($_) ) {
262                          } $self->ram( $a, $a+8 )                                          sprintf( "%02x", $_ )
263                                    } else {
264                                            '  '
265                                    }
266                            } @mem[ $a .. $a+8 ]
267                  )                  )
268          );          );
269  }  }
270    
 =head2 prompt  
   
   $orao->prompt( $address, $last_command );  
   
 =cut  
   
 sub prompt {  
         my $self = shift;  
         my $a = shift;  
         my $last = shift;  
         print STDERR $self->hexdump( $a ),  
                 $last ? "[$last] " : '',  
                 "> ";  
         my $in = <STDIN>;  
         chomp($in);  
         $in ||= $last;  
         $last = $in;  
         return split(/\s+/, $in) if $in;  
 }  
   
271  =head1 Memory management  =head1 Memory management
272    
273  Orao implements all I/O using mmap addresses. This was main reason why  Orao implements all I/O using mmap addresses. This was main reason why
# Line 215  L<Acme::6502> was just too slow to handl Line 275  L<Acme::6502> was just too slow to handl
275    
276  =cut  =cut
277    
 my @mem = (0xff) x 0x100000; # 64Mb  
   
278  =head2 read  =head2 read
279    
280  Read from memory  Read from memory
# Line 229  sub read { Line 287  sub read {
287          my $self = shift;          my $self = shift;
288          my ($addr) = @_;          my ($addr) = @_;
289          my $byte = $mem[$addr];          my $byte = $mem[$addr];
290          warn "# Orao::read(",dump(@_),") = ",dump( $byte ),"\n" if $self->debug;          warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
291          $self->mmap_pixel( $addr, 0, $byte, 0 );          $self->mmap_pixel( $addr, 0, $byte, 0 );
292          return $byte;          return $byte;
293  }  }
# Line 244  Write into emory Line 302  Write into emory
302    
303  sub write {  sub write {
304          my $self = shift;          my $self = shift;
         warn "# Orao::write(",dump(@_),")\n" if $self->debug;  
305          my ($addr,$byte) = @_;          my ($addr,$byte) = @_;
306            warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
307    
308          if ( $addr >= 0x6000 && $addr < 0x8000 ) {          if ( $addr >= 0x6000 && $addr < 0x8000 ) {
309                  $self->vram( $addr - 0x6000 , $byte );                  $self->vram( $addr - 0x6000 , $byte );
310          }          }
311    
         if ( $addr > 0xafff ) {  
                 warn sprintf "access to %04x above affff aborting\n", $addr;  
                 return -1;  
         }  
312          if ( $addr == 0x8800 ) {          if ( $addr == 0x8800 ) {
313                  warn sprintf "sound ignored: %x\n", $byte;                  warn sprintf "sound ignored: %x\n", $byte;
314          }          }
315    
316            if ( $addr > 0xafff ) {
317                    warn sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
318                    return;
319            }
320    
321          $self->mmap_pixel( $addr, $byte, 0, 0 );          $self->mmap_pixel( $addr, $byte, 0, 0 );
322    
323          $mem[$addr] = $byte;          $mem[$addr] = $byte;
324            return;
325    }
326    
327    =head1 Command Line
328    
329    Command-line debugging intrerface is implemented for communication with
330    emulated device
331    
332    =head2 prompt
333    
334      my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
335    
336    =cut
337    
338    my $last = 'r 1';
339    
340    sub prompt {
341            my $self = shift;
342            $self->app->sync;
343            my $a = shift;
344            print STDERR $self->hexdump( $a ),
345                    $last ? "[$last] " : '',
346                    "> ";
347            my $in = <STDIN>;
348            chomp($in);
349            warn "## prompt got: $in\n" if $self->debug;
350            $in ||= $last;
351            $last = $in;
352            return ( $in, split(/\s+/, $in) ) if $in;
353  }  }
354    
355    =head2 cli
356    
357      $orao->cli();
358    
359    =cut
360    
361    my $show_R = 0;
362    
363    sub cli {
364            my $self = shift;
365            my $a = $PC || confess "no pc?";
366            warn $self->dump_R() if $show_R;
367            while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
368                    my $c = shift @v;
369                    next unless defined($c);
370                    my $v = shift @v;
371                    $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
372                    @v = map { hex($_) } @v;
373                    printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
374                    if ( $c =~ m/^[qx]/i ) {
375                            exit;
376                    } elsif ( $c eq '?' ) {
377                            my $t = $self->trace ? 'on' : 'off' ;
378                            my $d = $self->debug ? 'on' : 'off' ;
379                            warn <<__USAGE__;
380    Usage:
381    
382    x|q\t\texit
383    e 6000 6010\tdump memory, +/- to walk forward/backward
384    m 1000 ff 00\tput ff 00 on 1000
385    j|u 1000\t\tjump (change pc)
386    r 42\t\trun 42 instruction opcodes
387    t\t\ttrace [$t]
388    d\t\tdebug [$d]
389    
390    __USAGE__
391                            warn $self->dump_R;
392                    } elsif ( $c =~ m/^e/i ) {
393                            $a = $v if defined($v);
394                            my $to = shift @v;
395                            $to = $a + 32 if ( ! $to || $to <= $a );
396                            $to = 0xffff if ( $to > 0xffff );
397                            my $lines = int( ($to - $a + 8) / 8 );
398                            printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
399                            while ( --$lines ) {
400                                    print $self->hexdump( $a );
401                                    $a += 8;
402                            }
403                            $last = '+';
404                            $show_R = 0;
405                    } elsif ( $c =~ m/^\+/ ) {
406                            $a += 8;
407                            $show_R = 0;
408                    } elsif ( $c =~ m/^\-/ ) {
409                            $a -= 8;
410                            $show_R = 0;
411                    } elsif ( $c =~ m/^m/i ) {
412                            $a = $v if defined($v);
413                            $self->poke_code( $a, @v );
414                            printf "poke %d bytes at %04x\n", $#v + 1, $a;
415                            $last = '+';
416                            $show_R = 0;
417                    } elsif ( $c =~ m/^l/i ) {
418                            my $to = shift @v || 0x1000;
419                            $a = $to;
420                            $self->load_oraoemu( $v, $a );
421                            $last = '';
422                    } elsif ( $c =~ m/^s/i ) {
423                            $self->save_dump( $v || 'mem.dump', @v );
424                            $last = '';
425                    } elsif ( $c =~ m/^r/i ) {
426                            $run_for = $v || 1;
427                            print "run_for $run_for instructions\n";
428                            $show_R = 1;
429                            last;
430                    } elsif ( $c =~ m/^(u|j)/ ) {
431                            my $to = $v || $a;
432                            printf "set pc to %04x\n", $to;
433                            $PC = $to;      # remember for restart
434                            $run_for = 1;
435                            $last = "r $run_for";
436                            $show_R = 1;
437                            last;
438                    } elsif ( $c =~ m/^t/ ) {
439                            $self->trace( not $self->trace );
440                            print "trace ", $self->trace ? 'on' : 'off', "\n";
441                            $last = '';
442                    } elsif ( $c =~ m/^d/ ) {
443                            $self->debug( not $self->debug );
444                            print "debug ", $self->debug ? 'on' : 'off', "\n";
445                            $last = '';
446                    } else {
447                            warn "# ignored $line\n" if ($line);
448                            $last = '';
449                    }
450            }
451    
452    }
453    
454  =head1 AUTHOR  =head1 AUTHOR
455    
Legend:
Removed from v.33  
changed lines
  Added in v.76
  ViewVC Help
Powered by ViewVC 1.1.26