/[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 30 by dpavlin, Mon Jul 30 17:56:13 2007 UTC revision 56 by dpavlin, Tue Jul 31 15:03:23 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/;
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 31  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;
41    
42    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->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',
54                    0xC000 => 'rom/BAS12.ROM',
55                    0xE000 => 'rom/CRT12.ROM',
56            });
57    
58            $PC = 0xDD11;   # BC
59    #       $PC = 0xC274;   # MC
60    
61            $orao = $self;
62    
63    #       $self->prompt( 0x1000 );
64    
65            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            } else {
99    
100                    warn "rendering video memory\n";
101                    for my $a ( 0x6000 .. 0x7fff ) {
102                            $self->vram( $a - 0x6000, $mem[$a] );
103                    }
104            
105            }
106            $self->sync;
107            $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  my $loaded_files = {  }
         0xC000 => 'rom/BAS12.ROM',  
         0xE000 => 'rom/CRT12.ROM',  
 };  
118    
119  =head2 load_rom  =head2 load_rom
120    
# Line 60  called to init memory and load initial r Line 125  called to init memory and load initial r
125  =cut  =cut
126    
127  sub load_rom {  sub load_rom {
128      my ($self) = @_;      my ($self, $loaded_files) = @_;
129    
130      #my $time_base = time();      #my $time_base = time();
131    
132          foreach my $addr ( sort keys %$loaded_files ) {          foreach my $addr ( sort keys %$loaded_files ) {
133                  my $path = $loaded_files->{$addr};                  my $path = $loaded_files->{$addr};
                 printf "loading '%s' at %04x\n", $path, $addr;  
134                  $self->load_oraoemu( $path, $addr );                  $self->load_oraoemu( $path, $addr );
135          }          }
136  }  }
# Line 76  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 ) = @_;
167    
168          my $size = -s $path || die "no size for $path: $!";          my $size = -s $path || confess "no size for $path: $!";
169    
170          my $buff = read_file( $path );          my $buff = read_file( $path );
171    
172          if ( $size == 65538 ) {          if ( $size == 65538 ) {
173                  $addr = 0;                  $addr = 0;
174                  printf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $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                  printf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size, $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, $size;          printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
184          return $self->write_chunk( $addr, $buff );          return $self->_write_chunk( $addr, $buff );
185    
186          my $chunk;          my $chunk;
187    
# Line 113  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 136  sub save_dump { Line 220  sub save_dump {
220          close($fh);          close($fh);
221    
222          my $size = -s $path;          my $size = -s $path;
223          printf "saved %s %d %x bytes\n", $path, $size, $size;          warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
224  }  }
225    
226  =head2 hexdump  =head2 hexdump
# Line 152  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    
244    =head1 Memory management
245    
246    Orao implements all I/O using mmap addresses. This was main reason why
247    L<Acme::6502> was just too slow to handle it.
248    
249    =cut
250    
251    =head2 read
252    
253    Read from memory
254    
255      $byte = read( $address );
256    
257    =cut
258    
259    sub read {
260            my $self = shift;
261            my ($addr) = @_;
262            my $byte = $mem[$addr];
263            warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
264            $self->mmap_pixel( $addr, 0, $byte, 0 );
265            return $byte;
266    }
267    
268    =head2 write
269    
270    Write into emory
271    
272      write( $address, $byte );
273    
274    =cut
275    
276    sub write {
277            my $self = shift;
278            my ($addr,$byte) = @_;
279            warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
280    
281            if ( $addr >= 0x6000 && $addr < 0x8000 ) {
282                    $self->vram( $addr - 0x6000 , $byte );
283            }
284    
285            if ( $addr == 0x8800 ) {
286                    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 );
294    
295            $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  =head2 prompt
305    
306    $orao->prompt( $address, $last_command );    $orao->prompt( $address, $last_command );
307    
308  =cut  =cut
309    
310    my $last = 'r 1';
311    
312  sub prompt {  sub prompt {
313          my $self = shift;          my $self = shift;
314            $self->app->sync;
315          my $a = shift;          my $a = shift;
316          my $last = shift;          print STDERR $self->hexdump( $a ),
         print $self->hexdump( $a ),  
317                  $last ? "[$last] " : '',                  $last ? "[$last] " : '',
318                  "> ";                  "> ";
319          my $in = <STDIN>;          my $in = <STDIN>;
320          chomp($in);          chomp($in);
321            warn "## prompt got: $in\n" if $self->debug;
322          $in ||= $last;          $in ||= $last;
323          $last = $in;          $last = $in;
324          return split(/\s+/, $in) if $in;          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 "## m %04x %04x lines: %d\n", $a, $to, $lines;
366                            while ( $lines ) {
367                                    print $self->hexdump( $a );
368                                    $a += 8;
369                                    $lines--;
370                            }
371                            $last = '+';
372                    } elsif ( $c =~ m/^\+/ ) {
373                            $a += 8;
374                    } elsif ( $c =~ m/^\-/ ) {
375                            $a -= 8;
376                    } elsif ( $c =~ m/^m/i ) {
377                            $a = $v;
378                            $self->poke_code( $a, @v );
379                            printf "poke %d bytes at %04x\n", $#v + 1, $a;
380                            $last = '+';
381                    } elsif ( $c =~ m/^l/i ) {
382                            my $to = shift @v || 0x1000;
383                            $a = $to;
384                            $self->load_oraoemu( $v, $a );
385                            $last = '';
386                    } elsif ( $c =~ m/^s/i ) {
387                            $self->save_dump( $v || 'mem.dump', @v );
388                            $last = '';
389                    } elsif ( $c =~ m/^r/i ) {
390                            $run_for = $v || 1;
391                            print "run_for $run_for instructions\n";
392                            last;
393                    } elsif ( $c =~ m/^(u|j)/ ) {
394                            my $to = $v || $a;
395                            printf "set pc to %04x\n", $to;
396                            $PC = $to;      # remember for restart
397                            $run_for = 1;
398                            $last = sprintf('m %04x', $to);
399                            last;
400                    } elsif ( $c =~ m/^t/ ) {
401                            $self->trace( not $self->trace );
402                            print "trace ", $self->trace ? 'on' : 'off', "\n";
403                    } elsif ( $c =~ m/^d/ ) {
404                            $self->debug( not $self->debug );
405                            print "debug ", $self->debug ? 'on' : 'off', "\n";
406                    } else {
407                            warn "# ignore $c\n";
408                            last;
409                    }
410            }
411    
412    
413    }
414    
415  =head1 AUTHOR  =head1 AUTHOR
416    
Legend:
Removed from v.30  
changed lines
  Added in v.56
  ViewVC Help
Powered by ViewVC 1.1.26