/[VRac]/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 /Orao.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 35 by dpavlin, Mon Jul 30 21:53:04 2007 UTC revision 73 by dpavlin, Tue Jul 31 21:43:57 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;  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 33  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    select(STDERR); $| = 1;
43    
44  sub init {  sub init {
45          my $self = shift;          my $self = shift;
46          warn "Orao calling 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    #               0x6000 => 'dump/screen.dmp',
55                  0xC000 => 'rom/BAS12.ROM',                  0xC000 => 'rom/BAS12.ROM',
56                  0xE000 => 'rom/CRT12.ROM',                  0xE000 => 'rom/CRT12.ROM',
57          });          });
58    
59          $self->load_oraoemu( 'dump/orao-1.2' );  #       $PC = 0xDD11;   # BC
60          $self->load_oraoemu( 'dump/SCRINV.BIN' );  #       $PC = 0xC274;   # MC
         $PC = 0x1000;  
61    
62          $orao = $self;          $orao = $self;
63    
64  #       $self->prompt( 0x1000 );  #       $self->prompt( 0x1000 );
65    
66          warn "rendering memory map\n";          my ( $trace, $debug ) = ( $self->trace, $self->debug );
67            $self->trace( 0 );
68            $self->debug( 0 );
69    
70            $self->render( @mem[ 0x6000 .. 0x7fff ] );
71    
72            if ( $self->show_mem ) {
73    
74                    warn "rendering memory map\n";
75    
76                    my @mmap = (
77                            0x0000, 0x03FF, 'nulti blok',
78                            0x0400, 0x5FFF, 'korisnički RAM (23K)',
79                            0x6000, 0x7FFF, 'video RAM',
80                            0x8000, 0x9FFF, 'sistemske lokacije',
81                            0xA000, 0xAFFF, 'ekstenzija',
82                            0xB000, 0xBFFF, 'DOS',
83                            0xC000, 0xDFFF, 'BASIC ROM',
84                            0xE000, 0xFFFF, 'sistemski ROM',
85                    );
86    
87                    foreach my $i ( 0 .. $#mmap / 3 ) {
88                            my $o = $i * 3;
89                            my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];
90                            printf "%04x - %04x - %s\n", $from, $to, $desc;
91                            for my $a ( $from .. $to ) {
92                                    if ( $a >= 0x6000 && $a < 0x8000 ) {
93                                            my $b = $self->read( $a );
94                                            $self->vram( $a - 0x6000, $b );
95                                    } else {
96                                            $self->read( $a );
97                                    }
98                            }
99                    }
100    
101          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',  
         );  
102    
103          foreach my $i ( 0 .. $#mmap / 3 ) {                  warn "rendering video memory\n";
104                  my $o = $i * 3;  #               for my $a ( 0x6000 .. 0x7fff ) {
105                  my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];  #                       $self->vram( $a - 0x6000, $mem[$a] );
106                  printf "%04x - %04x - %s\n", $from, $to, $desc;  #               }
107                  for my $a ( $from .. $to ) {                  $self->render( @mem[ 0x6000 .. 0x7fff ] );
108                          $orao->read( $a );          
                 }  
                 $self->sync;  
109          }          }
110            $self->sync;
111          warn "Orao init finished\n";          $self->trace( $trace );
112            $self->debug( $debug );
113    
114            #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
115    
116            warn "Orao init finished",
117                    $self->trace ? ' trace' : '',
118                    $self->debug ? ' debug' : '',
119                    "\n";
120    
121  }  }
122    
# Line 107  sub load_rom { Line 139  sub load_rom {
139          }          }
140  }  }
141    
142    # write chunk directly into memory, updateing vram if needed
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            $self->render( @mem[ 0x6000 .. 0x7fff ] );
163    }
164    
165  =head2 load_oraoemu  =head2 load_oraoemu
166    
167    Load binary files, ROM images and Orao Emulator files
168    
169      $orao->load_oraoemu( '/path/to/file', 0x1000 );
170    
171    Returns true on success.
172    
173  =cut  =cut
174    
175  sub load_oraoemu {  sub load_oraoemu {
176          my $self = shift;          my $self = shift;
177          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
178    
179            if ( ! -e $path ) {
180                    warn "ERROR: file $path doesn't exist\n";
181                    return;
182            }
183    
184          my $size = -s $path || confess "no size for $path: $!";          my $size = -s $path || confess "no size for $path: $!";
185    
186          my $buff = read_file( $path );          my $buff = read_file( $path );
# Line 123  sub load_oraoemu { Line 188  sub load_oraoemu {
188          if ( $size == 65538 ) {          if ( $size == 65538 ) {
189                  $addr = 0;                  $addr = 0;
190                  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;
191                  $self->write_chunk( $addr, substr($buff,2) );                  $self->_write_chunk( $addr, substr($buff,2) );
192                  return;                  return 1;
193          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
194                  $addr = 0;                  $addr = 0;
195                  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;
196                  #$self->write_chunk( $addr, substr($buff,0x20) );                  $self->_write_chunk( $addr, substr($buff,0x20) );
197                  $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );                  return 1;
                 return;  
198          }          }
199          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;
200          return $self->poke_code( $addr, map { ord($_) } split(//,$buff) );          $self->_write_chunk( $addr, $buff );
201          return $self->write_chunk( $addr, $buff );          return 1;
202    
203          my $chunk;          my $chunk;
204    
# Line 150  sub load_oraoemu { Line 214  sub load_oraoemu {
214                  $pos += 4;                  $pos += 4;
215          }          }
216    
217          $self->write_chunk( $addr, $chunk );          $self->_write_chunk( $addr, $chunk );
218    
219            return 1;
220  };  };
221    
222  =head2 save_dump  =head2 save_dump
# Line 188  sub hexdump { Line 253  sub hexdump {
253          return sprintf(" %04x %s\n", $a,          return sprintf(" %04x %s\n", $a,
254                  join(" ",                  join(" ",
255                          map {                          map {
256                                  sprintf( "%02x", $_ )                                  if ( defined($_) ) {
257                          } $self->ram( $a, $a+8 )                                          sprintf( "%02x", $_ )
258                                    } else {
259                                            '  '
260                                    }
261                            } @mem[ $a .. $a+8 ]
262                  )                  )
263          );          );
264  }  }
265    
 =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;  
 }  
   
266  =head1 Memory management  =head1 Memory management
267    
268  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 233  sub read { Line 282  sub read {
282          my $self = shift;          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          $self->mmap_pixel( $addr, 0, $byte, 0 );          $self->mmap_pixel( $addr, 0, $byte, 0 );
287          return $byte;          return $byte;
288  }  }
# Line 248  Write into emory Line 297  Write into emory
297    
298  sub write {  sub write {
299          my $self = shift;          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 );
305          }          }
306    
         if ( $addr > 0xafff ) {  
                 warn sprintf "access to %04x above affff aborting\n", $addr;  
                 return -1;  
         }  
307          if ( $addr == 0x8800 ) {          if ( $addr == 0x8800 ) {
308                  warn sprintf "sound ignored: %x\n", $byte;                  warn sprintf "sound ignored: %x\n", $byte;
309          }          }
310    
311            if ( $addr > 0xafff ) {
312                    warn sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
313                    return;
314            }
315    
316          $self->mmap_pixel( $addr, $byte, 0, 0 );          $self->mmap_pixel( $addr, $byte, 0, 0 );
317    
318          $mem[$addr] = $byte;          $mem[$addr] = $byte;
319            return;
320  }  }
321    
322    =head1 Command Line
323    
324    Command-line debugging intrerface is implemented for communication with
325    emulated device
326    
327    =head2 prompt
328    
329      my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
330    
331    =cut
332    
333    my $last = 'r 1';
334    
335    sub prompt {
336            my $self = shift;
337            $self->app->sync;
338            my $a = shift;
339            print STDERR $self->hexdump( $a ),
340                    $last ? "[$last] " : '',
341                    "> ";
342            my $in = <STDIN>;
343            chomp($in);
344            warn "## prompt got: $in\n" if $self->debug;
345            $in ||= $last;
346            $last = $in;
347            return ( $in, split(/\s+/, $in) ) if $in;
348    }
349    
350    =head2 cli
351    
352      $orao->cli();
353    
354    =cut
355    
356    my $show_R = 0;
357    
358    sub cli {
359            my $self = shift;
360            my $a = $PC || confess "no pc?";
361            warn $self->dump_R() if $show_R;
362            while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
363                    my $c = shift @v;
364                    next unless defined($c);
365                    my $v = shift @v;
366                    $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
367                    @v = map { hex($_) } @v;
368                    printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
369                    if ( $c =~ m/^[qx]/i ) {
370                            exit;
371                    } elsif ( $c eq '?' ) {
372                            my $t = $self->trace ? 'on' : 'off' ;
373                            my $d = $self->debug ? 'on' : 'off' ;
374                            warn <<__USAGE__;
375    Usage:
376    
377    x|q\t\texit
378    e 6000 6010\tdump memory, +/- to walk forward/backward
379    m 1000 ff 00\tput ff 00 on 1000
380    j|u 1000\t\tjump (change pc)
381    r 42\t\trun 42 instruction opcodes
382    t\t\ttrace [$t]
383    d\t\tdebug [$d]
384    
385    __USAGE__
386                            warn $self->dump_R;
387                    } elsif ( $c =~ m/^e/i ) {
388                            $a = $v if defined($v);
389                            my $to = shift @v;
390                            $to = $a + 32 if ( ! $to || $to <= $a );
391                            $to = 0xffff if ( $to > 0xffff );
392                            my $lines = int( ($to - $a + 8) / 8 );
393                            printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
394                            while ( --$lines ) {
395                                    print $self->hexdump( $a );
396                                    $a += 8;
397                            }
398                            $last = '+';
399                            $show_R = 0;
400                    } elsif ( $c =~ m/^\+/ ) {
401                            $a += 8;
402                            $show_R = 0;
403                    } elsif ( $c =~ m/^\-/ ) {
404                            $a -= 8;
405                            $show_R = 0;
406                    } elsif ( $c =~ m/^m/i ) {
407                            $a = $v if defined($v);
408                            $self->poke_code( $a, @v );
409                            printf "poke %d bytes at %04x\n", $#v + 1, $a;
410                            $last = '+';
411                            $show_R = 0;
412                    } elsif ( $c =~ m/^l/i ) {
413                            my $to = shift @v || 0x1000;
414                            $a = $to;
415                            $self->load_oraoemu( $v, $a );
416                            $last = '';
417                    } elsif ( $c =~ m/^s/i ) {
418                            $self->save_dump( $v || 'mem.dump', @v );
419                            $last = '';
420                    } elsif ( $c =~ m/^r/i ) {
421                            $run_for = $v || 1;
422                            print "run_for $run_for instructions\n";
423                            $show_R = 1;
424                            last;
425                    } elsif ( $c =~ m/^(u|j)/ ) {
426                            my $to = $v || $a;
427                            printf "set pc to %04x\n", $to;
428                            $PC = $to;      # remember for restart
429                            $run_for = 1;
430                            $last = "r $run_for";
431                            $show_R = 1;
432                            last;
433                    } elsif ( $c =~ m/^t/ ) {
434                            $self->trace( not $self->trace );
435                            print "trace ", $self->trace ? 'on' : 'off', "\n";
436                            $last = '';
437                    } elsif ( $c =~ m/^d/ ) {
438                            $self->debug( not $self->debug );
439                            print "debug ", $self->debug ? 'on' : 'off', "\n";
440                            $last = '';
441                    } else {
442                            warn "# ignored $line\n" if ($line);
443                            $last = '';
444                    }
445            }
446    
447    }
448    
449  =head1 AUTHOR  =head1 AUTHOR
450    
Legend:
Removed from v.35  
changed lines
  Added in v.73
  ViewVC Help
Powered by ViewVC 1.1.26