/[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 59 by dpavlin, Tue Jul 31 16:06:27 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({
# Line 53  sub init { Line 55  sub init {
55                  0xE000 => 'rom/CRT12.ROM',                  0xE000 => 'rom/CRT12.ROM',
56          });          });
57    
58          $self->load_oraoemu( 'dump/orao-1.2' );          $PC = 0xDD11;   # BC
59          $self->load_oraoemu( 'dump/SCRINV.BIN' );  #       $PC = 0xC274;   # MC
         $PC = 0x1000;  
60    
61          $orao = $self;          $orao = $self;
62    
63  #       $self->prompt( 0x1000 );  #       $self->prompt( 0x1000 );
64    
65          warn "rendering memory map\n";          my ( $trace, $debug ) = ( $self->trace, $self->debug );
66            $self->trace( 0 );
67            $self->debug( 0 );
68    
69            if ( $self->show_mem ) {
70    
71                    warn "rendering memory map\n";
72    
73                    my @mmap = (
74                            0x0000, 0x03FF, 'nulti blok',
75                            0x0400, 0x5FFF, 'korisnički RAM (23K)',
76                            0x6000, 0x7FFF, 'video RAM',
77                            0x8000, 0x9FFF, 'sistemske lokacije',
78                            0xA000, 0xAFFF, 'ekstenzija',
79                            0xB000, 0xBFFF, 'DOS',
80                            0xC000, 0xDFFF, 'BASIC ROM',
81                            0xE000, 0xFFFF, 'sistemski ROM',
82                    );
83    
84                    foreach my $i ( 0 .. $#mmap / 3 ) {
85                            my $o = $i * 3;
86                            my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];
87                            printf "%04x - %04x - %s\n", $from, $to, $desc;
88                            for my $a ( $from .. $to ) {
89                                    if ( $a >= 0x6000 && $a < 0x8000 ) {
90                                            my $b = $self->read( $a );
91                                            $self->vram( $a - 0x6000, $b );
92                                    } else {
93                                            $self->read( $a );
94                                    }
95                            }
96                    }
97    
98          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',  
         );  
99    
100          foreach my $i ( 0 .. $#mmap / 3 ) {                  warn "rendering video memory\n";
101                  my $o = $i * 3;                  for my $a ( 0x6000 .. 0x7fff ) {
102                  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 );  
103                  }                  }
104                  $self->sync;          
105          }          }
106            $self->sync;
107          warn "Orao init finished\n";          $self->trace( $trace );
108            $self->debug( $debug );
109    
110            #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
111    
112            warn "Orao init finished",
113                    $self->trace ? ' trace' : '',
114                    $self->debug ? ' debug' : '',
115                    "\n";
116    
117  }  }
118    
# Line 112  sub load_rom { Line 140  sub load_rom {
140    
141  =cut  =cut
142    
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    }
163    
164  sub load_oraoemu {  sub load_oraoemu {
165          my $self = shift;          my $self = shift;
166          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
# Line 123  sub load_oraoemu { Line 172  sub load_oraoemu {
172          if ( $size == 65538 ) {          if ( $size == 65538 ) {
173                  $addr = 0;                  $addr = 0;
174                  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;
175                  $self->write_chunk( $addr, substr($buff,2) );                  $self->_write_chunk( $addr, substr($buff,2) );
176                  return;                  return;
177          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
178                  $addr = 0;                  $addr = 0;
179                  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;
180                  #$self->write_chunk( $addr, substr($buff,0x20) );                  $self->_write_chunk( $addr, substr($buff,0x20) );
                 $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );  
181                  return;                  return;
182          }          }
183          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;
184          return $self->poke_code( $addr, map { ord($_) } split(//,$buff) );          return $self->_write_chunk( $addr, $buff );
         return $self->write_chunk( $addr, $buff );  
185    
186          my $chunk;          my $chunk;
187    
# Line 150  sub load_oraoemu { Line 197  sub load_oraoemu {
197                  $pos += 4;                  $pos += 4;
198          }          }
199    
200          $self->write_chunk( $addr, $chunk );          $self->_write_chunk( $addr, $chunk );
201    
202  };  };
203    
# Line 189  sub hexdump { Line 236  sub hexdump {
236                  join(" ",                  join(" ",
237                          map {                          map {
238                                  sprintf( "%02x", $_ )                                  sprintf( "%02x", $_ )
239                          } $self->ram( $a, $a+8 )                          } @mem[ $a .. $a+8 ]
240                  )                  )
241          );          );
242  }  }
243    
 =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;  
 }  
   
244  =head1 Memory management  =head1 Memory management
245    
246  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 260  sub read {
260          my $self = shift;          my $self = shift;
261          my ($addr) = @_;          my ($addr) = @_;
262          my $byte = $mem[$addr];          my $byte = $mem[$addr];
263          warn "# Orao::read(",dump(@_),") = ",dump( $byte ),"\n" if $self->debug;          warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
264          $self->mmap_pixel( $addr, 0, $byte, 0 );          $self->mmap_pixel( $addr, 0, $byte, 0 );
265          return $byte;          return $byte;
266  }  }
# Line 248  Write into emory Line 275  Write into emory
275    
276  sub write {  sub write {
277          my $self = shift;          my $self = shift;
         warn "# Orao::write(",dump(@_),")\n" if $self->debug;  
278          my ($addr,$byte) = @_;          my ($addr,$byte) = @_;
279            warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
280    
281          if ( $addr >= 0x6000 && $addr < 0x8000 ) {          if ( $addr >= 0x6000 && $addr < 0x8000 ) {
282                  $self->vram( $addr - 0x6000 , $byte );                  $self->vram( $addr - 0x6000 , $byte );
283          }          }
284    
         if ( $addr > 0xafff ) {  
                 warn sprintf "access to %04x above affff aborting\n", $addr;  
                 return -1;  
         }  
285          if ( $addr == 0x8800 ) {          if ( $addr == 0x8800 ) {
286                  warn sprintf "sound ignored: %x\n", $byte;                  warn sprintf "sound ignored: %x\n", $byte;
287          }          }
288    
289            if ( $addr > 0xafff ) {
290                    confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
291            }
292    
293          $self->mmap_pixel( $addr, $byte, 0, 0 );          $self->mmap_pixel( $addr, $byte, 0, 0 );
294    
295          $mem[$addr] = $byte;          $mem[$addr] = $byte;
296            return;
297  }  }
298    
299    =head1 Command Line
300    
301    Command-line debugging intrerface is implemented for communication with
302    emulated device
303    
304    =head2 prompt
305    
306      $orao->prompt( $address, $last_command );
307    
308    =cut
309    
310    my $last = 'r 1';
311    
312    sub prompt {
313            my $self = shift;
314            $self->app->sync;
315            my $a = shift;
316            print STDERR $self->hexdump( $a ),
317                    $last ? "[$last] " : '',
318                    "> ";
319            my $in = <STDIN>;
320            chomp($in);
321            warn "## prompt got: $in\n" if $self->debug;
322            $in ||= $last;
323            $last = $in;
324            return split(/\s+/, $in) if $in;
325    }
326    
327    =head2 cli
328    
329      $orao->cli();
330    
331    =cut
332    
333    sub cli {
334            my $self = shift;
335            my $a = $PC || confess "no pc?";
336            while ( my @v = $self->prompt( $a, $last ) ) {
337                    my $c = shift @v;
338                    my $v = shift @v;
339                    $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
340                    @v = map { hex($_) } @v;
341                    printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
342                    if ( $c =~ m/^[qx]/i ) {
343                            exit;
344                    } elsif ( $c eq '?' ) {
345                            my $t = $self->trace ? 'on' : 'off' ;
346                            my $d = $self->debug ? 'on' : 'off' ;
347                            warn <<__USAGE__;
348    Usage:
349    
350    x|q\t\texit
351    e 6000 6010\tdump memory, +/- to walk forward/backward
352    m 1000 ff 00\tput ff 00 on 1000
353    j|u 1000\t\tjump (change pc)
354    r 42\t\trun 42 instruction opcodes
355    t\t\ttrace [$t]
356    d\t\tdebug [$d]
357    
358    __USAGE__
359                            warn sprintf(" PC: %04x A:%02x P:%02x X:%02x Y:%02x S:%02x\n", $PC, $A, $P, $X, $Y, $S);
360                    } elsif ( $c =~ m/^e/i ) {
361                            $a = $v if defined($v);
362                            my $to = shift @v;
363                            $to = $a + 32 if ( ! $to || $to <= $a );
364                            my $lines = int( ($to - $a + 8) / 8 );
365                            printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
366                            while ( --$lines ) {
367                                    print $self->hexdump( $a );
368                                    $a += 8;
369                            }
370                            $last = '+';
371                    } elsif ( $c =~ m/^\+/ ) {
372                            $a += 8;
373                    } elsif ( $c =~ m/^\-/ ) {
374                            $a -= 8;
375                    } elsif ( $c =~ m/^m/i ) {
376                            $a = $v;
377                            $self->poke_code( $a, @v );
378                            printf "poke %d bytes at %04x\n", $#v + 1, $a;
379                            $last = '+';
380                    } elsif ( $c =~ m/^l/i ) {
381                            my $to = shift @v || 0x1000;
382                            $a = $to;
383                            $self->load_oraoemu( $v, $a );
384                            $last = '';
385                    } elsif ( $c =~ m/^s/i ) {
386                            $self->save_dump( $v || 'mem.dump', @v );
387                            $last = '';
388                    } elsif ( $c =~ m/^r/i ) {
389                            $run_for = $v || 1;
390                            print "run_for $run_for instructions\n";
391                            last;
392                    } elsif ( $c =~ m/^(u|j)/ ) {
393                            my $to = $v || $a;
394                            printf "set pc to %04x\n", $to;
395                            $PC = $to;      # remember for restart
396                            $run_for = 1;
397                            $last = sprintf('m %04x', $to);
398                            last;
399                    } elsif ( $c =~ m/^t/ ) {
400                            $self->trace( not $self->trace );
401                            print "trace ", $self->trace ? 'on' : 'off', "\n";
402                    } elsif ( $c =~ m/^d/ ) {
403                            $self->debug( not $self->debug );
404                            print "debug ", $self->debug ? 'on' : 'off', "\n";
405                    } else {
406                            warn "# ignore $c\n";
407                            last;
408                    }
409            }
410    
411    
412    }
413    
414  =head1 AUTHOR  =head1 AUTHOR
415    
Legend:
Removed from v.35  
changed lines
  Added in v.59
  ViewVC Help
Powered by ViewVC 1.1.26