/[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 29 by dpavlin, Mon Jul 30 17:32:41 2007 UTC revision 49 by dpavlin, Tue Jul 31 10:52:06 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);  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));
15    
16  =head1 NAME  =head1 NAME
# Line 29  Emulator or Orao 8-bit 6502 machine popu Line 31  Emulator or Orao 8-bit 6502 machine popu
31    
32  =cut  =cut
33    
34  my $loaded_files = {  =head2 init
35          0xC000 => 'rom/BAS12.ROM',  
36          0xE000 => 'rom/CRT12.ROM',  Start emulator
37  };  
38    =cut
39    
40    our $orao;
41    
42    select(STDERR); $| = 1;
43    
44    sub init {
45            my $self = shift;
46            warn "Orao calling upstream init\n";
47            $self->SUPER::init( $self, @_ );
48    
49            warn "staring Orao $Orao::VERSION emulation\n";
50    
51            $self->open_screen;
52            $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    }
118    
119  =head2 load_rom  =head2 load_rom
120    
# Line 43  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 59  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 96  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 119  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 135  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  }  }
# Line 148  sub hexdump { Line 249  sub hexdump {
249    
250  sub prompt {  sub prompt {
251          my $self = shift;          my $self = shift;
252            $self->app->sync;
253          my $a = shift;          my $a = shift;
254          my $last = shift;          my $last = shift;
255          print $self->hexdump( $a ),          print STDERR $self->hexdump( $a ),
256                  $last ? "[$last] " : '',                  $last ? "[$last] " : '',
257                  "> ";                  "> ";
258          my $in = <STDIN>;          my $in = <STDIN>;
259          chomp($in);          chomp($in);
260            warn "## prompt got: $in\n" if $self->debug;
261          $in ||= $last;          $in ||= $last;
262          $last = $in;          $last = $in;
263          return split(/\s+/, $in) if $in;          return split(/\s+/, $in) if $in;
264  }  }
265    
266    =head1 Memory management
267    
268    Orao implements all I/O using mmap addresses. This was main reason why
269    L<Acme::6502> was just too slow to handle it.
270    
271    =cut
272    
273    =head2 read
274    
275    Read from memory
276    
277      $byte = read( $address );
278    
279    =cut
280    
281    sub read {
282            my $self = shift;
283            my ($addr) = @_;
284            my $byte = $mem[$addr];
285            warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
286            $self->mmap_pixel( $addr, 0, $byte, 0 );
287            return $byte;
288    }
289    
290    =head2 write
291    
292    Write into emory
293    
294      write( $address, $byte );
295    
296    =cut
297    
298    sub write {
299            my $self = shift;
300            my ($addr,$byte) = @_;
301            warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
302    
303            if ( $addr >= 0x6000 && $addr < 0x8000 ) {
304                    $self->vram( $addr - 0x6000 , $byte );
305            }
306    
307            if ( $addr > 0xafff ) {
308                    warn sprintf "access to %04x above affff aborting\n", $addr;
309                    return -1;
310            }
311            if ( $addr == 0x8800 ) {
312                    warn sprintf "sound ignored: %x\n", $byte;
313            }
314    
315            $self->mmap_pixel( $addr, $byte, 0, 0 );
316    
317            $mem[$addr] = $byte;
318            return;
319    }
320    
321    =head1 Command Line
322    
323    Command-line debugging intrerface is implemented for communication with
324    emulated device
325    
326    =head2 cli
327    
328      $orao->cli();
329    
330    =cut
331    
332    my $last = 'r 1';
333    
334    sub cli {
335            my $self = shift;
336            my $a = $PC || confess "no pc?";
337            while ( my @v = $self->prompt( $a, $last ) ) {
338                    my $c = shift @v;
339                    my $v = shift @v;
340                    $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
341                    @v = map { hex($_) } @v;
342                    printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
343                    if ( $c =~ m/^[qx]/i ) {
344                            exit;
345                    } elsif ( $c eq '?' ) {
346                            warn <<__USAGE__;
347    uage:
348    x|q\t\texit
349    e 6000 6010\tdump memory, +/- to walk forward/backward
350    m 1000 ff 00\tput ff 00 on 1000
351    j|u 1000\t\tjump (change pc)
352    r 42\t\trun 42 instruction opcodes
353    t\t\ttrace on/off
354    d\t\tdebug on/off
355    __USAGE__
356                    } elsif ( $c =~ m/^e/i ) {
357                            $a = $v if defined($v);
358                            my $to = shift @v;
359                            $to = $a + 32 if ( ! $to || $to <= $a );
360                            my $lines = int( ($to - $a - 8) / 8 );
361                            printf "## m %04x %04x lines: %d\n", $a, $to, $lines;
362                            while ( $lines ) {
363                                    print $self->hexdump( $a );
364                                    $a += 8;
365                                    $lines--;
366                            }
367                            $last = '+';
368                    } elsif ( $c =~ m/^\+/ ) {
369                            $a += 8;
370                    } elsif ( $c =~ m/^\-/ ) {
371                            $a -= 8;
372                    } elsif ( $c =~ m/^m/i ) {
373                            $a = $v;
374                            $self->poke_code( $a, @v );
375                            printf "poke %d bytes at %04x\n", $#v + 1, $a;
376                    } elsif ( $c =~ m/^l/i ) {
377                            my $to = shift @v || 0x1000;
378                            $a = $to;
379                            $self->load_oraoemu( $v, $a );
380                    } elsif ( $c =~ m/^s/i ) {
381                            $self->save_dump( $v || 'mem.dump', @v );
382                    } elsif ( $c =~ m/^r/i ) {
383                            $run_for = $v || 1;
384                            print "run_for $run_for instructions\n";
385                            last;
386                    } elsif ( $c =~ m/^(u|j)/ ) {
387                            my $to = $v || $a;
388                            printf "set pc to %04x\n", $to;
389                            $PC = $to;      # remember for restart
390                            $run_for = 1;
391                            last;
392                    } elsif ( $c =~ m/^t/ ) {
393                            $self->trace( not $self->trace );
394                            print "trace ", $self->trace ? 'on' : 'off', "\n";
395                    } elsif ( $c =~ m/^d/ ) {
396                            $self->debug( not $self->debug );
397                            print "debug ", $self->debug ? 'on' : 'off', "\n";
398                    } else {
399                            warn "# ignore $c\n";
400                            last;
401                    }
402            }
403    
404    
405    }
406    
407  =head1 AUTHOR  =head1 AUTHOR
408    
409  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.29  
changed lines
  Added in v.49
  ViewVC Help
Powered by ViewVC 1.1.26