/[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 87 by dpavlin, Thu Aug 2 11:08:10 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 List::Util qw/first/;
12    use M6502;
13    
14  use base qw(Class::Accessor M6502 Screen);  use base qw(Class::Accessor M6502 Screen Prefs);
15  __PACKAGE__->mk_accessors(qw(debug trace run_for mem_dump trace));  __PACKAGE__->mk_accessors(qw(run_for));
16    
17  =head1 NAME  =head1 NAME
18    
# Line 30  Emulator or Orao 8-bit 6502 machine popu Line 32  Emulator or Orao 8-bit 6502 machine popu
32    
33  =cut  =cut
34    
35  =head2 init  my @kbd_ports = (
36        0x87FC,0x87FD,0x87FA,0x87FB,0x87F6,0x87F7,
37        0x87EE,0x87EF,0x87DE,0x87DF,0x87BE,0x87BF,
38        0x877E,0x877F,0x86FE,0x86FF,0x85FE,0x85FF,
39        0x83FE,0x83FF,
40    );
41    
42  Start emulator  =head2 boot
43    
44    Start emulator, open L<Screen>, load initial ROM images, and render memory
45    
46      my $orao = Orao->new({});
47      $orao->boot;
48    
49  =cut  =cut
50    
51  our $orao;  our $orao;
52    
53  our $PC = 0x1000;  select(STDERR); $| = 1;
54    
55  sub init {  sub boot {
56          my $self = shift;          my $self = shift;
57          warn "call upstream init\n";          warn "Orao calling upstream init\n";
58          $self->SUPER::init( $self, @_ );          $self->SUPER::init( $self, @_ );
59    
60          warn "staring Orao $Orao::VERSION emulation\n";          warn "Orao $Orao::VERSION emulation starting\n";
61    
62          $self->open_screen;          $self->open_screen;
63          $self->load_rom({          $self->load_rom({
64                  0x1000 => 'dump/SCRINV.BIN',                  0x1000 => 'dump/SCRINV.BIN',
65                    # should be 0x6000, but oraoemu has 2 byte prefix
66                    0x5FFE => 'dump/screen.dmp',
67                  0xC000 => 'rom/BAS12.ROM',                  0xC000 => 'rom/BAS12.ROM',
68                  0xE000 => 'rom/CRT12.ROM',                  0xE000 => 'rom/CRT12.ROM',
69          });          });
70    
71          $orao = $self;  #       $PC = 0xDD11;   # BC
72    #       $PC = 0xC274;   # MC
73    
74  #       $self->prompt( 0x1000 );          $PC = 0xff89;
75    
76          warn "rendering memory map\n";          $orao = $self;
77    
78          my @mmap = (  #       $self->prompt( 0x1000 );
                 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',  
         );  
79    
80          foreach my $i ( 0 .. $#mmap / 3 ) {          my ( $trace, $debug ) = ( $self->trace, $self->debug );
81                  my $o = $i * 3;          $self->trace( 0 );
82                  my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];          $self->debug( 0 );
83                  printf "%04x - %04x - %s\n", $from, $to, $desc;  
84  #               for my $a ( $from .. $to ) {          $self->render( @mem[ 0x6000 .. 0x7fff ] );
85  #                       $orao->read( $a );  
86  #               }          if ( $self->show_mem ) {
87  #               $self->sync;  
88                    warn "rendering memory map\n";
89    
90                    $self->render_mem( @mem );
91    
92                    my @mmap = (
93                            0x0000, 0x03FF, 'nulti blok',
94                            0x0400, 0x5FFF, 'korisnički RAM (23K)',
95                            0x6000, 0x7FFF, 'video RAM',
96                            0x8000, 0x9FFF, 'sistemske lokacije',
97                            0xA000, 0xAFFF, 'ekstenzija',
98                            0xB000, 0xBFFF, 'DOS',
99                            0xC000, 0xDFFF, 'BASIC ROM',
100                            0xE000, 0xFFFF, 'sistemski ROM',
101                    );
102    
103            } else {
104    
105                    warn "rendering video memory\n";
106                    $self->render( @mem[ 0x6000 .. 0x7fff ] );
107            
108          }          }
109            $self->sync;
110            $self->trace( $trace );
111            $self->debug( $debug );
112    
113            #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
114    
115            warn "Orao boot finished",
116                    $self->trace ? ' trace' : '',
117                    $self->debug ? ' debug' : '',
118                    "\n";
119    
120            M6502::reset();
121    
122  }  }
123    
# Line 102  sub load_rom { Line 140  sub load_rom {
140          }          }
141  }  }
142    
143    # write chunk directly into memory, updateing vram if needed
144    sub _write_chunk {
145            my $self = shift;
146            my ( $addr, $chunk ) = @_;
147            $self->write_chunk( $addr, $chunk );
148            my $end = $addr + length($chunk);
149            my ( $f, $t ) = ( 0x6000, 0x7fff );
150    
151            if ( $end < $f || $addr >= $t ) {
152                    warn "skip vram update\n";
153                    return;
154            };
155    
156            $f = $addr if ( $addr > $f );
157            $t = $end if ( $end < $t );
158    
159            warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
160    #       foreach my $a ( $f .. $t ) {
161    #               $self->vram( $a - 0x6000 , $mem[ $a ] );
162    #       }
163            $self->render( @mem[ 0x6000 .. 0x7fff ] );
164            $self->render_mem( @mem ) if $self->show_mem;
165    }
166    
167  =head2 load_oraoemu  =head2 load_oraoemu
168    
169    Load binary files, ROM images and Orao Emulator files
170    
171      $orao->load_oraoemu( '/path/to/file', 0x1000 );
172    
173    Returns true on success.
174    
175  =cut  =cut
176    
177  sub load_oraoemu {  sub load_oraoemu {
178          my $self = shift;          my $self = shift;
179          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
180    
181            if ( ! -e $path ) {
182                    warn "ERROR: file $path doesn't exist\n";
183                    return;
184            }
185    
186          my $size = -s $path || confess "no size for $path: $!";          my $size = -s $path || confess "no size for $path: $!";
187    
188          my $buff = read_file( $path );          my $buff = read_file( $path );
# Line 118  sub load_oraoemu { Line 190  sub load_oraoemu {
190          if ( $size == 65538 ) {          if ( $size == 65538 ) {
191                  $addr = 0;                  $addr = 0;
192                  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;
193                  $self->write_chunk( $addr, substr($buff,2) );                  $self->_write_chunk( $addr, substr($buff,2) );
194                  return;                  return 1;
195          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
196                  $addr = 0;                  $addr = 0;
197                  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;
198                  #$self->write_chunk( $addr, substr($buff,0x20) );                  $self->_write_chunk( $addr, substr($buff,0x20) );
199                  $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );                  return 1;
                 return;  
200          }          }
201          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;
202          return $self->write_chunk( $addr, $buff );          $self->_write_chunk( $addr, $buff );
203            return 1;
204    
205          my $chunk;          my $chunk;
206    
# Line 144  sub load_oraoemu { Line 216  sub load_oraoemu {
216                  $pos += 4;                  $pos += 4;
217          }          }
218    
219          $self->write_chunk( $addr, $chunk );          $self->_write_chunk( $addr, $chunk );
220    
221            return 1;
222  };  };
223    
224  =head2 save_dump  =head2 save_dump
# Line 182  sub hexdump { Line 255  sub hexdump {
255          return sprintf(" %04x %s\n", $a,          return sprintf(" %04x %s\n", $a,
256                  join(" ",                  join(" ",
257                          map {                          map {
258                                  sprintf( "%02x", $_ )                                  if ( defined($_) ) {
259                          } $self->ram( $a, $a+8 )                                          sprintf( "%02x", $_ )
260                                    } else {
261                                            '  '
262                                    }
263                            } @mem[ $a .. $a+8 ]
264                  )                  )
265          );          );
266  }  }
267    
 =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;  
 }  
   
268  =head1 Memory management  =head1 Memory management
269    
270  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 272  L<Acme::6502> was just too slow to handl
272    
273  =cut  =cut
274    
 my @mem = (0xff) x 0x100000; # 64Mb  
   
275  =head2 read  =head2 read
276    
277  Read from memory  Read from memory
# Line 229  sub read { Line 284  sub read {
284          my $self = shift;          my $self = shift;
285          my ($addr) = @_;          my ($addr) = @_;
286          my $byte = $mem[$addr];          my $byte = $mem[$addr];
287          warn "# Orao::read(",dump(@_),") = ",dump( $byte ),"\n" if $self->debug;          warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
288    
289            # keyboard
290    
291            if ( first { $addr == $_ } @kbd_ports ) {
292                    warn sprintf("keyboard port: %04x\n",$addr);
293            } elsif ( $addr == 0x87fc ) {
294                    warn "0x87fc - arrows/back\n";
295    =for pascal
296                    if VKey=VK_RIGHT then Result:=16;
297                    if VKey=VK_DOWN then Result:=128;
298                    if VKey=VK_UP then Result:=192;
299                    if VKey=VK_LEFT then Result:=224;
300                    if Ord(KeyPressed)=VK_BACK then Result:=224;
301    =cut
302            } elsif ( $addr == 0x87fd ) {
303                    warn "0x87fd - enter\n";
304    =for pascal
305        if KeyPressed=Chr(13) then begin
306          Mem[$FC]:=13;
307          Result:=0;
308        end;
309    =cut
310            } elsif ( $addr == 0x87fa ) {
311                    warn "0x87fa = F1 - F4\n";
312    =for pascal
313        if VKey=VK_F4 then Result:=16;
314        if VKey=VK_F3 then Result:=128;
315        if VKey=VK_F2 then Result:=192;
316        if VKey=VK_F1 then Result:=224;
317    =cut
318            } elsif ( $addr == 0x87fb ) {
319                    warn "0x87fb\n";
320    =for pascal
321        if KeyPressed=Chr(32) then Result:=32;
322        if KeyPressed='"' then Result:=16;
323        if KeyPressed='!' then Result:=16;
324        if KeyPressed='$' then Result:=16;
325        if KeyPressed='%' then Result:=16;
326        if KeyPressed='&' then Result:=16;
327        if KeyPressed='(' then Result:=16;
328        if KeyPressed=')' then Result:=16;
329        if KeyPressed='=' then Result:=16;
330        if KeyPressed='#' then Result:=16;
331        if KeyPressed='+' then Result:=16;
332        if KeyPressed='*' then Result:=16;
333        if KeyPressed='?' then Result:=16;
334        if KeyPressed='<' then Result:=16;
335        if KeyPressed='>' then Result:=16;
336        if VKey=191 then Result:=16;
337    =cut
338            }
339    
340          $self->mmap_pixel( $addr, 0, $byte, 0 );          $self->mmap_pixel( $addr, 0, $byte, 0 );
341          return $byte;          return $byte;
342  }  }
# Line 244  Write into emory Line 351  Write into emory
351    
352  sub write {  sub write {
353          my $self = shift;          my $self = shift;
         warn "# Orao::write(",dump(@_),")\n" if $self->debug;  
354          my ($addr,$byte) = @_;          my ($addr,$byte) = @_;
355            warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
356    
357          if ( $addr >= 0x6000 && $addr < 0x8000 ) {          if ( $addr >= 0x6000 && $addr < 0x8000 ) {
358                  $self->vram( $addr - 0x6000 , $byte );                  $self->vram( $addr - 0x6000 , $byte );
359          }          }
360    
         if ( $addr > 0xafff ) {  
                 warn sprintf "access to %04x above affff aborting\n", $addr;  
                 return -1;  
         }  
361          if ( $addr == 0x8800 ) {          if ( $addr == 0x8800 ) {
362                  warn sprintf "sound ignored: %x\n", $byte;                  warn sprintf "sound ignored: %x\n", $byte;
363          }          }
364    
365            if ( $addr > 0xafff ) {
366                    warn sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
367                    return;
368            }
369    
370          $self->mmap_pixel( $addr, $byte, 0, 0 );          $self->mmap_pixel( $addr, $byte, 0, 0 );
371    
372          $mem[$addr] = $byte;          $mem[$addr] = $byte;
373            return;
374  }  }
375    
376    =head1 Command Line
377    
378    Command-line debugging intrerface is implemented for communication with
379    emulated device
380    
381    =head2 prompt
382    
383      my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
384    
385    =cut
386    
387    my $last = 'r 1';
388    
389    sub prompt {
390            my $self = shift;
391            $self->app->sync;
392            my $a = shift;
393            print STDERR $self->hexdump( $a ),
394                    $last ? "[$last] " : '',
395                    "> ";
396            my $in = <STDIN>;
397            chomp($in);
398            warn "## prompt got: $in\n" if $self->debug;
399            $in ||= $last;
400            $last = $in;
401            return ( $in, split(/\s+/, $in) ) if $in;
402    }
403    
404    =head2 cli
405    
406      $orao->cli();
407    
408    =cut
409    
410    my $show_R = 0;
411    
412    sub cli {
413            my $self = shift;
414            my $a = $PC || confess "no pc?";
415            warn $self->dump_R() if $show_R;
416            while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
417                    my $c = shift @v;
418                    next unless defined($c);
419                    my $v = shift @v;
420                    $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
421                    @v = map { hex($_) } @v;
422                    printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
423                    if ( $c =~ m/^[qx]/i ) {
424                            exit;
425                    } elsif ( $c eq '?' ) {
426                            my $t = $self->trace ? 'on' : 'off' ;
427                            my $d = $self->debug ? 'on' : 'off' ;
428                            warn <<__USAGE__;
429    Usage:
430    
431    x|q\t\texit
432    e 6000 6010\tdump memory, +/- to walk forward/backward
433    m 1000 ff 00\tput ff 00 on 1000
434    j|u 1000\t\tjump (change pc)
435    r 42\t\trun 42 instruction opcodes
436    t\t\ttrace [$t]
437    d\t\tdebug [$d]
438    
439    __USAGE__
440                            warn $self->dump_R;
441                    } elsif ( $c =~ m/^e/i ) {
442                            $a = $v if defined($v);
443                            my $to = shift @v;
444                            $to = $a + 32 if ( ! $to || $to <= $a );
445                            $to = 0xffff if ( $to > 0xffff );
446                            my $lines = int( ($to - $a + 8) / 8 );
447                            printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
448                            while ( --$lines ) {
449                                    print $self->hexdump( $a );
450                                    $a += 8;
451                            }
452                            $last = '+';
453                            $show_R = 0;
454                    } elsif ( $c =~ m/^\+/ ) {
455                            $a += 8;
456                            $show_R = 0;
457                    } elsif ( $c =~ m/^\-/ ) {
458                            $a -= 8;
459                            $show_R = 0;
460                    } elsif ( $c =~ m/^m/i ) {
461                            $a = $v if defined($v);
462                            $self->poke_code( $a, @v );
463                            printf "poke %d bytes at %04x\n", $#v + 1, $a;
464                            $last = '+';
465                            $show_R = 0;
466                    } elsif ( $c =~ m/^l/i ) {
467                            my $to = shift @v || 0x1000;
468                            $a = $to;
469                            $self->load_oraoemu( $v, $a );
470                            $last = '';
471                    } elsif ( $c =~ m/^s/i ) {
472                            $self->save_dump( $v || 'mem.dump', @v );
473                            $last = '';
474                    } elsif ( $c =~ m/^r/i ) {
475                            $run_for = $v || 1;
476                            print "run_for $run_for instructions\n";
477                            $show_R = 1;
478                            last;
479                    } elsif ( $c =~ m/^(u|j)/ ) {
480                            my $to = $v || $a;
481                            printf "set pc to %04x\n", $to;
482                            $PC = $to;      # remember for restart
483                            $run_for = 1;
484                            $last = "r $run_for";
485                            $show_R = 1;
486                            last;
487                    } elsif ( $c =~ m/^t/ ) {
488                            $self->trace( not $self->trace );
489                            print "trace ", $self->trace ? 'on' : 'off', "\n";
490                            $last = '';
491                    } elsif ( $c =~ m/^d/ ) {
492                            $self->debug( not $self->debug );
493                            print "debug ", $self->debug ? 'on' : 'off', "\n";
494                            $last = '';
495                    } else {
496                            warn "# ignored $line\n" if ($line);
497                            $last = '';
498                    }
499            }
500    
501    }
502    
503  =head1 AUTHOR  =head1 AUTHOR
504    
Legend:
Removed from v.33  
changed lines
  Added in v.87
  ViewVC Help
Powered by ViewVC 1.1.26