/[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 43 by dpavlin, Tue Jul 31 09:43:21 2007 UTC
# Line 7  use Carp; Line 7  use Carp;
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);
14  __PACKAGE__->mk_accessors(qw(debug trace run_for mem_dump trace));  __PACKAGE__->mk_accessors(qw(debug trace run_for mem_dump trace));
# Line 35  Start emulator Line 37  Start emulator
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 "staring Orao $Orao::VERSION emulation\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            $self->load_oraoemu( 'dump/orao-1.2' );
59            $self->load_oraoemu( 'dump/SCRINV.BIN', 0x1000 );
60            $PC = 0x1000;
61    
62            $orao = $self;
63    
64    #       $self->prompt( 0x1000 );
65    
66            my $trace = $self->trace;
67            $self->trace( 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    
109  my $loaded_files = {          #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
110          0xC000 => 'rom/BAS12.ROM',  
111          0xE000 => 'rom/CRT12.ROM',          warn "Orao init finished", $self->trace ? ' trace on' : '', "\n";
112  };  
113    }
114    
115  =head2 load_rom  =head2 load_rom
116    
# Line 60  called to init memory and load initial r Line 121  called to init memory and load initial r
121  =cut  =cut
122    
123  sub load_rom {  sub load_rom {
124      my ($self) = @_;      my ($self, $loaded_files) = @_;
125    
126      #my $time_base = time();      #my $time_base = time();
127    
128          foreach my $addr ( sort keys %$loaded_files ) {          foreach my $addr ( sort keys %$loaded_files ) {
129                  my $path = $loaded_files->{$addr};                  my $path = $loaded_files->{$addr};
                 printf "loading '%s' at %04x\n", $path, $addr;  
130                  $self->load_oraoemu( $path, $addr );                  $self->load_oraoemu( $path, $addr );
131          }          }
132  }  }
# Line 80  sub load_oraoemu { Line 140  sub load_oraoemu {
140          my $self = shift;          my $self = shift;
141          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
142    
143          my $size = -s $path || die "no size for $path: $!";          my $size = -s $path || confess "no size for $path: $!";
144    
145          my $buff = read_file( $path );          my $buff = read_file( $path );
146    
147          if ( $size == 65538 ) {          if ( $size == 65538 ) {
148                  $addr = 0;                  $addr = 0;
149                  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;
150                  $self->write_chunk( $addr, substr($buff,2) );                  $self->write_chunk( $addr, substr($buff,2) );
151                  return;                  return;
152          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
153                  $addr = 0;                  $addr = 0;
154                  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;
155                  #$self->write_chunk( $addr, substr($buff,0x20) );                  $self->write_chunk( $addr, substr($buff,0x20) );
                 $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );  
156                  return;                  return;
157          }          }
158          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;
159          return $self->write_chunk( $addr, $buff );          return $self->write_chunk( $addr, $buff );
160    
161          my $chunk;          my $chunk;
# Line 136  sub save_dump { Line 195  sub save_dump {
195          close($fh);          close($fh);
196    
197          my $size = -s $path;          my $size = -s $path;
198          printf "saved %s %d %x bytes\n", $path, $size, $size;          warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
199  }  }
200    
201  =head2 hexdump  =head2 hexdump
# Line 165  sub hexdump { Line 224  sub hexdump {
224    
225  sub prompt {  sub prompt {
226          my $self = shift;          my $self = shift;
227            $self->app->sync;
228          my $a = shift;          my $a = shift;
229          my $last = shift;          my $last = shift;
230          print $self->hexdump( $a ),          print STDERR $self->hexdump( $a ),
231                  $last ? "[$last] " : '',                  $last ? "[$last] " : '',
232                  "> ";                  "> ";
233          my $in = <STDIN>;          my $in = <STDIN>;
# Line 177  sub prompt { Line 237  sub prompt {
237          return split(/\s+/, $in) if $in;          return split(/\s+/, $in) if $in;
238  }  }
239    
240    =head1 Memory management
241    
242    Orao implements all I/O using mmap addresses. This was main reason why
243    L<Acme::6502> was just too slow to handle it.
244    
245    =cut
246    
247    =head2 read
248    
249    Read from memory
250    
251      $byte = read( $address );
252    
253    =cut
254    
255    sub read {
256            my $self = shift;
257            my ($addr) = @_;
258            my $byte = $mem[$addr];
259            warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
260            $self->mmap_pixel( $addr, 0, $byte, 0 );
261            return $byte;
262    }
263    
264    =head2 write
265    
266    Write into emory
267    
268      write( $address, $byte );
269    
270    =cut
271    
272    sub write {
273            my $self = shift;
274            my ($addr,$byte) = @_;
275            warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
276    
277            if ( $addr >= 0x6000 && $addr < 0x8000 ) {
278                    $self->vram( $addr - 0x6000 , $byte );
279            }
280    
281            if ( $addr > 0xafff ) {
282                    warn sprintf "access to %04x above affff aborting\n", $addr;
283                    return -1;
284            }
285            if ( $addr == 0x8800 ) {
286                    warn sprintf "sound ignored: %x\n", $byte;
287            }
288    
289            $self->mmap_pixel( $addr, $byte, 0, 0 );
290    
291            $mem[$addr] = $byte;
292            return;
293    }
294    
295    =head1 Command Line
296    
297    Command-line debugging intrerface is implemented for communication with
298    emulated device
299    
300    =head2 cli
301    
302      $orao->cli();
303    
304    =cut
305    
306    my $last = 'r 1';
307    
308    sub cli {
309            my $self = shift;
310            my $a = $PC || confess "no pc?";
311            while ( my @v = $self->prompt( $a, $last ) ) {
312                    my $c = shift @v;
313                    my $v = shift @v;
314                    $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
315                    printf "## [%s] %s\n", ($v || 'undef'), join(",",@v) if $self->debug;
316                    @v = map { hex($_) } @v;
317                    if ( $c =~ m/^[qx]/i ) {
318                            exit;
319                    } elsif ( $c eq '?' ) {
320                            warn <<__USAGE__;
321    uage:
322    x|q\t\texit
323    e 6000 6010\tdump memory, +/- to walk forward/backward
324    m 1000 ff 00\tput ff 00 on 1000
325    j|u 1000\t\tjump (change pc)
326    r 42\t\trun 42 instruction opcodes
327    __USAGE__
328                    } elsif ( $c =~ m/^e/i ) {
329                            $a ||= $v;
330                            my $to = shift @v;
331                            $to = $a + 32 if ( ! $to || $to <= $a );
332                            my $lines = int( ($to - $a - 8) / 8 );
333                            printf "## m %04x %04x lines: %d\n", $a, $to, $lines;
334                            while ( $lines ) {
335                                    print $self->hexdump( $a );
336                                    $a += 8;
337                                    $lines--;
338                            }
339                            $last = '+';
340                    } elsif ( $c =~ m/^\+/ ) {
341                            $a += 8;
342                    } elsif ( $c =~ m/^\-/ ) {
343                            $a -= 8;
344                    } elsif ( $c =~ m/^m/i ) {
345                            $a = $v;
346                            $self->poke_code( $a, @v );
347                            printf "poke %d bytes at %04x\n", $#v + 1, $a;
348                    } elsif ( $c =~ m/^l/i ) {
349                            my $to = shift @v || 0x1000;
350                            $a = $to;
351                            $self->load_oraoemu( $v, $a );
352                    } elsif ( $c =~ m/^s/i ) {
353                            $self->save_dump( $v || 'mem.dump', @v );
354                    } elsif ( $c =~ m/^r/i ) {
355                            $run_for = $v || 1;
356                            print "run_for $run_for instructions\n";
357                            last;
358                    } elsif ( $c =~ m/^(u|j)/ ) {
359                            my $to = $v || $a;
360                            printf "set pc to %04x\n", $to;
361                            $PC = $to;      # remember for restart
362                            $run_for = 1;
363                            last;
364                    } elsif ( $c =~ m/^t/ ) {
365                            $self->trace( not $self->trace );
366                            print "trace ", $self->trace ? 'on' : 'off', "\n";
367                    } else {
368                            warn "# ignore $c\n";
369                            last;
370                    }
371            }
372    
373    
374    }
375    
376  =head1 AUTHOR  =head1 AUTHOR
377    

Legend:
Removed from v.30  
changed lines
  Added in v.43

  ViewVC Help
Powered by ViewVC 1.1.26