/[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 68 by dpavlin, Tue Jul 31 17:15:54 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 107  sub load_rom { Line 135  sub load_rom {
135          }          }
136  }  }
137    
138    # write chunk directly into memory, updateing vram if needed
139    sub _write_chunk {
140            my $self = shift;
141            my ( $addr, $chunk ) = @_;
142            $self->write_chunk( $addr, $chunk );
143            my $end = $addr + length($chunk);
144            my ( $f, $t ) = ( 0x6000, 0x7fff );
145    
146            if ( $end < $f || $addr >= $t ) {
147                    warn "skip vram update\n";
148                    return;
149            };
150    
151            $f = $addr if ( $addr > $f );
152            $t = $end if ( $end < $t );
153    
154            warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
155            foreach my $a ( $f .. $t ) {
156                    $self->vram( $a - 0x6000 , $mem[ $a ] );
157            }
158    }
159    
160  =head2 load_oraoemu  =head2 load_oraoemu
161    
162    Load binary files, ROM images and Orao Emulator files
163    
164      $orao->load_oraoemu( '/path/to/file', 0x1000 );
165    
166    Returns true on success.
167    
168  =cut  =cut
169    
170  sub load_oraoemu {  sub load_oraoemu {
171          my $self = shift;          my $self = shift;
172          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
173    
174            if ( ! -e $path ) {
175                    warn "ERROR: file $path doesn't exist\n";
176                    return;
177            }
178    
179          my $size = -s $path || confess "no size for $path: $!";          my $size = -s $path || confess "no size for $path: $!";
180    
181          my $buff = read_file( $path );          my $buff = read_file( $path );
# Line 123  sub load_oraoemu { Line 183  sub load_oraoemu {
183          if ( $size == 65538 ) {          if ( $size == 65538 ) {
184                  $addr = 0;                  $addr = 0;
185                  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;
186                  $self->write_chunk( $addr, substr($buff,2) );                  $self->_write_chunk( $addr, substr($buff,2) );
187                  return;                  return 1;
188          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
189                  $addr = 0;                  $addr = 0;
190                  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;
191                  #$self->write_chunk( $addr, substr($buff,0x20) );                  $self->_write_chunk( $addr, substr($buff,0x20) );
192                  $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );                  return 1;
                 return;  
193          }          }
194          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;
195          return $self->poke_code( $addr, map { ord($_) } split(//,$buff) );          $self->_write_chunk( $addr, $buff );
196          return $self->write_chunk( $addr, $buff );          return 1;
197    
198          my $chunk;          my $chunk;
199    
# Line 150  sub load_oraoemu { Line 209  sub load_oraoemu {
209                  $pos += 4;                  $pos += 4;
210          }          }
211    
212          $self->write_chunk( $addr, $chunk );          $self->_write_chunk( $addr, $chunk );
213    
214            return 1;
215  };  };
216    
217  =head2 save_dump  =head2 save_dump
# Line 189  sub hexdump { Line 249  sub hexdump {
249                  join(" ",                  join(" ",
250                          map {                          map {
251                                  sprintf( "%02x", $_ )                                  sprintf( "%02x", $_ )
252                          } $self->ram( $a, $a+8 )                          } @mem[ $a .. $a+8 ]
253                  )                  )
254          );          );
255  }  }
256    
 =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;  
 }  
   
257  =head1 Memory management  =head1 Memory management
258    
259  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 273  sub read {
273          my $self = shift;          my $self = shift;
274          my ($addr) = @_;          my ($addr) = @_;
275          my $byte = $mem[$addr];          my $byte = $mem[$addr];
276          warn "# Orao::read(",dump(@_),") = ",dump( $byte ),"\n" if $self->debug;          warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
277          $self->mmap_pixel( $addr, 0, $byte, 0 );          $self->mmap_pixel( $addr, 0, $byte, 0 );
278          return $byte;          return $byte;
279  }  }
# Line 248  Write into emory Line 288  Write into emory
288    
289  sub write {  sub write {
290          my $self = shift;          my $self = shift;
         warn "# Orao::write(",dump(@_),")\n" if $self->debug;  
291          my ($addr,$byte) = @_;          my ($addr,$byte) = @_;
292            warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
293    
294          if ( $addr >= 0x6000 && $addr < 0x8000 ) {          if ( $addr >= 0x6000 && $addr < 0x8000 ) {
295                  $self->vram( $addr - 0x6000 , $byte );                  $self->vram( $addr - 0x6000 , $byte );
296          }          }
297    
         if ( $addr > 0xafff ) {  
                 warn sprintf "access to %04x above affff aborting\n", $addr;  
                 return -1;  
         }  
298          if ( $addr == 0x8800 ) {          if ( $addr == 0x8800 ) {
299                  warn sprintf "sound ignored: %x\n", $byte;                  warn sprintf "sound ignored: %x\n", $byte;
300          }          }
301    
302            if ( $addr > 0xafff ) {
303                    warn sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
304                    return;
305            }
306    
307          $self->mmap_pixel( $addr, $byte, 0, 0 );          $self->mmap_pixel( $addr, $byte, 0, 0 );
308    
309          $mem[$addr] = $byte;          $mem[$addr] = $byte;
310            return;
311  }  }
312    
313    =head1 Command Line
314    
315    Command-line debugging intrerface is implemented for communication with
316    emulated device
317    
318    =head2 prompt
319    
320      my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
321    
322    =cut
323    
324    my $last = 'r 1';
325    
326    sub prompt {
327            my $self = shift;
328            $self->app->sync;
329            my $a = shift;
330            print STDERR $self->hexdump( $a ),
331                    $last ? "[$last] " : '',
332                    "> ";
333            my $in = <STDIN>;
334            chomp($in);
335            warn "## prompt got: $in\n" if $self->debug;
336            $in ||= $last;
337            $last = $in;
338            return ( $in, split(/\s+/, $in) ) if $in;
339    }
340    
341    =head2 cli
342    
343      $orao->cli();
344    
345    =cut
346    
347    my $show_R = 0;
348    
349    sub cli {
350            my $self = shift;
351            my $a = $PC || confess "no pc?";
352            warn $self->dump_R() if $show_R;
353            while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
354                    my $c = shift @v;
355                    next unless defined($c);
356                    my $v = shift @v;
357                    $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
358                    @v = map { hex($_) } @v;
359                    printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
360                    if ( $c =~ m/^[qx]/i ) {
361                            exit;
362                    } elsif ( $c eq '?' ) {
363                            my $t = $self->trace ? 'on' : 'off' ;
364                            my $d = $self->debug ? 'on' : 'off' ;
365                            warn <<__USAGE__;
366    Usage:
367    
368    x|q\t\texit
369    e 6000 6010\tdump memory, +/- to walk forward/backward
370    m 1000 ff 00\tput ff 00 on 1000
371    j|u 1000\t\tjump (change pc)
372    r 42\t\trun 42 instruction opcodes
373    t\t\ttrace [$t]
374    d\t\tdebug [$d]
375    
376    __USAGE__
377                            warn $self->dump_R;
378                    } elsif ( $c =~ m/^e/i ) {
379                            $a = $v if defined($v);
380                            my $to = shift @v;
381                            $to = $a + 32 if ( ! $to || $to <= $a );
382                            my $lines = int( ($to - $a + 8) / 8 );
383                            printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
384                            while ( --$lines ) {
385                                    print $self->hexdump( $a );
386                                    $a += 8;
387                            }
388                            $last = '+';
389                            $show_R = 0;
390                    } elsif ( $c =~ m/^\+/ ) {
391                            $a += 8;
392                            $show_R = 0;
393                    } elsif ( $c =~ m/^\-/ ) {
394                            $a -= 8;
395                            $show_R = 0;
396                    } elsif ( $c =~ m/^m/i ) {
397                            $a = $v;
398                            $self->poke_code( $a, @v );
399                            printf "poke %d bytes at %04x\n", $#v + 1, $a;
400                            $last = '+';
401                            $show_R = 0;
402                    } elsif ( $c =~ m/^l/i ) {
403                            my $to = shift @v || 0x1000;
404                            $a = $to;
405                            $self->load_oraoemu( $v, $a );
406                            $last = '';
407                    } elsif ( $c =~ m/^s/i ) {
408                            $self->save_dump( $v || 'mem.dump', @v );
409                            $last = '';
410                    } elsif ( $c =~ m/^r/i ) {
411                            $run_for = $v || 1;
412                            print "run_for $run_for instructions\n";
413                            $show_R = 1;
414                            last;
415                    } elsif ( $c =~ m/^(u|j)/ ) {
416                            my $to = $v || $a;
417                            printf "set pc to %04x\n", $to;
418                            $PC = $to;      # remember for restart
419                            $run_for = 1;
420                            $last = "r $run_for";
421                            $show_R = 1;
422                            last;
423                    } elsif ( $c =~ m/^t/ ) {
424                            $self->trace( not $self->trace );
425                            print "trace ", $self->trace ? 'on' : 'off', "\n";
426                            $last = '';
427                    } elsif ( $c =~ m/^d/ ) {
428                            $self->debug( not $self->debug );
429                            print "debug ", $self->debug ? 'on' : 'off', "\n";
430                            $last = '';
431                    } else {
432                            warn "# ignored $line\n" if ($line);
433                            $last = '';
434                    }
435            }
436    
437    }
438    
439  =head1 AUTHOR  =head1 AUTHOR
440    
Legend:
Removed from v.35  
changed lines
  Added in v.68
  ViewVC Help
Powered by ViewVC 1.1.26