/[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 76 by dpavlin, Wed Aug 1 12:57:15 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                    # should be 0x6000, but oraoemu has 2 byte prefix
55                    0x5FFE => 'dump/screen.dmp',
56                    0xC000 => 'rom/BAS12.ROM',
57                    0xE000 => 'rom/CRT12.ROM',
58            });
59    
60    #       $PC = 0xDD11;   # BC
61    #       $PC = 0xC274;   # MC
62    
63            $orao = $self;
64    
65    #       $self->prompt( 0x1000 );
66    
67            my ( $trace, $debug ) = ( $self->trace, $self->debug );
68            $self->trace( 0 );
69            $self->debug( 0 );
70    
71            $self->render( @mem[ 0x6000 .. 0x7fff ] );
72    
73            if ( $self->show_mem ) {
74    
75                    warn "rendering memory map\n";
76    
77                    $self->render_mem( @mem );
78    
79                    my @mmap = (
80                            0x0000, 0x03FF, 'nulti blok',
81                            0x0400, 0x5FFF, 'korisnički RAM (23K)',
82                            0x6000, 0x7FFF, 'video RAM',
83                            0x8000, 0x9FFF, 'sistemske lokacije',
84                            0xA000, 0xAFFF, 'ekstenzija',
85                            0xB000, 0xBFFF, 'DOS',
86                            0xC000, 0xDFFF, 'BASIC ROM',
87                            0xE000, 0xFFFF, 'sistemski ROM',
88                    );
89    
90    if(0){
91                    foreach my $i ( 0 .. $#mmap / 3 ) {
92                            my $o = $i * 3;
93                            my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];
94                            printf "%04x - %04x - %s\n", $from, $to, $desc;
95                            for my $a ( $from .. $to ) {
96                                    if ( $a >= 0x6000 && $a < 0x8000 ) {
97                                            my $b = $self->read( $a );
98                                            $self->vram( $a - 0x6000, $b );
99                                    } else {
100                                            $self->read( $a );
101                                    }
102                            }
103                    }
104  }  }
105    
106  my $loaded_files = {          } else {
107          0xC000 => 'rom/BAS12.ROM',  
108          0xE000 => 'rom/CRT12.ROM',                  warn "rendering video memory\n";
109  };  #               for my $a ( 0x6000 .. 0x7fff ) {
110    #                       $self->vram( $a - 0x6000, $mem[$a] );
111    #               }
112                    $self->render( @mem[ 0x6000 .. 0x7fff ] );
113            
114            }
115            $self->sync;
116            $self->trace( $trace );
117            $self->debug( $debug );
118    
119            #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
120    
121            warn "Orao init finished",
122                    $self->trace ? ' trace' : '',
123                    $self->debug ? ' debug' : '',
124                    "\n";
125    
126    }
127    
128  =head2 load_rom  =head2 load_rom
129    
# Line 60  called to init memory and load initial r Line 134  called to init memory and load initial r
134  =cut  =cut
135    
136  sub load_rom {  sub load_rom {
137      my ($self) = @_;      my ($self, $loaded_files) = @_;
138    
139      #my $time_base = time();      #my $time_base = time();
140    
141          foreach my $addr ( sort keys %$loaded_files ) {          foreach my $addr ( sort keys %$loaded_files ) {
142                  my $path = $loaded_files->{$addr};                  my $path = $loaded_files->{$addr};
                 printf "loading '%s' at %04x\n", $path, $addr;  
143                  $self->load_oraoemu( $path, $addr );                  $self->load_oraoemu( $path, $addr );
144          }          }
145  }  }
146    
147    # write chunk directly into memory, updateing vram if needed
148    sub _write_chunk {
149            my $self = shift;
150            my ( $addr, $chunk ) = @_;
151            $self->write_chunk( $addr, $chunk );
152            my $end = $addr + length($chunk);
153            my ( $f, $t ) = ( 0x6000, 0x7fff );
154    
155            if ( $end < $f || $addr >= $t ) {
156                    warn "skip vram update\n";
157                    return;
158            };
159    
160            $f = $addr if ( $addr > $f );
161            $t = $end if ( $end < $t );
162    
163            warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
164    #       foreach my $a ( $f .. $t ) {
165    #               $self->vram( $a - 0x6000 , $mem[ $a ] );
166    #       }
167            $self->render( @mem[ 0x6000 .. 0x7fff ] );
168    }
169    
170  =head2 load_oraoemu  =head2 load_oraoemu
171    
172    Load binary files, ROM images and Orao Emulator files
173    
174      $orao->load_oraoemu( '/path/to/file', 0x1000 );
175    
176    Returns true on success.
177    
178  =cut  =cut
179    
180  sub load_oraoemu {  sub load_oraoemu {
181          my $self = shift;          my $self = shift;
182          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
183    
184          my $size = -s $path || die "no size for $path: $!";          if ( ! -e $path ) {
185                    warn "ERROR: file $path doesn't exist\n";
186                    return;
187            }
188    
189            my $size = -s $path || confess "no size for $path: $!";
190    
191          my $buff = read_file( $path );          my $buff = read_file( $path );
192    
193          if ( $size == 65538 ) {          if ( $size == 65538 ) {
194                  $addr = 0;                  $addr = 0;
195                  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;
196                  $self->write_chunk( $addr, substr($buff,2) );                  $self->_write_chunk( $addr, substr($buff,2) );
197                  return;                  return 1;
198          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
199                  $addr = 0;                  $addr = 0;
200                  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;
201                  #$self->write_chunk( $addr, substr($buff,0x20) );                  $self->_write_chunk( $addr, substr($buff,0x20) );
202                  $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );                  return 1;
                 return;  
203          }          }
204          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;
205          return $self->write_chunk( $addr, $buff );          $self->_write_chunk( $addr, $buff );
206            return 1;
207    
208          my $chunk;          my $chunk;
209    
# Line 113  sub load_oraoemu { Line 219  sub load_oraoemu {
219                  $pos += 4;                  $pos += 4;
220          }          }
221    
222          $self->write_chunk( $addr, $chunk );          $self->_write_chunk( $addr, $chunk );
223    
224            return 1;
225  };  };
226    
227  =head2 save_dump  =head2 save_dump
# Line 136  sub save_dump { Line 243  sub save_dump {
243          close($fh);          close($fh);
244    
245          my $size = -s $path;          my $size = -s $path;
246          printf "saved %s %d %x bytes\n", $path, $size, $size;          warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
247  }  }
248    
249  =head2 hexdump  =head2 hexdump
# Line 151  sub hexdump { Line 258  sub hexdump {
258          return sprintf(" %04x %s\n", $a,          return sprintf(" %04x %s\n", $a,
259                  join(" ",                  join(" ",
260                          map {                          map {
261                                  sprintf( "%02x", $_ )                                  if ( defined($_) ) {
262                          } $self->ram( $a, $a+8 )                                          sprintf( "%02x", $_ )
263                                    } else {
264                                            '  '
265                                    }
266                            } @mem[ $a .. $a+8 ]
267                  )                  )
268          );          );
269  }  }
270    
271    =head1 Memory management
272    
273    Orao implements all I/O using mmap addresses. This was main reason why
274    L<Acme::6502> was just too slow to handle it.
275    
276    =cut
277    
278    =head2 read
279    
280    Read from memory
281    
282      $byte = read( $address );
283    
284    =cut
285    
286    sub read {
287            my $self = shift;
288            my ($addr) = @_;
289            my $byte = $mem[$addr];
290            warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
291            $self->mmap_pixel( $addr, 0, $byte, 0 );
292            return $byte;
293    }
294    
295    =head2 write
296    
297    Write into emory
298    
299      write( $address, $byte );
300    
301    =cut
302    
303    sub write {
304            my $self = shift;
305            my ($addr,$byte) = @_;
306            warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
307    
308            if ( $addr >= 0x6000 && $addr < 0x8000 ) {
309                    $self->vram( $addr - 0x6000 , $byte );
310            }
311    
312            if ( $addr == 0x8800 ) {
313                    warn sprintf "sound ignored: %x\n", $byte;
314            }
315    
316            if ( $addr > 0xafff ) {
317                    warn sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
318                    return;
319            }
320    
321            $self->mmap_pixel( $addr, $byte, 0, 0 );
322    
323            $mem[$addr] = $byte;
324            return;
325    }
326    
327    =head1 Command Line
328    
329    Command-line debugging intrerface is implemented for communication with
330    emulated device
331    
332  =head2 prompt  =head2 prompt
333    
334    $orao->prompt( $address, $last_command );    my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
335    
336  =cut  =cut
337    
338    my $last = 'r 1';
339    
340  sub prompt {  sub prompt {
341          my $self = shift;          my $self = shift;
342            $self->app->sync;
343          my $a = shift;          my $a = shift;
344          my $last = shift;          print STDERR $self->hexdump( $a ),
         print $self->hexdump( $a ),  
345                  $last ? "[$last] " : '',                  $last ? "[$last] " : '',
346                  "> ";                  "> ";
347          my $in = <STDIN>;          my $in = <STDIN>;
348          chomp($in);          chomp($in);
349            warn "## prompt got: $in\n" if $self->debug;
350          $in ||= $last;          $in ||= $last;
351          $last = $in;          $last = $in;
352          return split(/\s+/, $in) if $in;          return ( $in, split(/\s+/, $in) ) if $in;
353  }  }
354    
355    =head2 cli
356    
357      $orao->cli();
358    
359    =cut
360    
361    my $show_R = 0;
362    
363    sub cli {
364            my $self = shift;
365            my $a = $PC || confess "no pc?";
366            warn $self->dump_R() if $show_R;
367            while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
368                    my $c = shift @v;
369                    next unless defined($c);
370                    my $v = shift @v;
371                    $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
372                    @v = map { hex($_) } @v;
373                    printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
374                    if ( $c =~ m/^[qx]/i ) {
375                            exit;
376                    } elsif ( $c eq '?' ) {
377                            my $t = $self->trace ? 'on' : 'off' ;
378                            my $d = $self->debug ? 'on' : 'off' ;
379                            warn <<__USAGE__;
380    Usage:
381    
382    x|q\t\texit
383    e 6000 6010\tdump memory, +/- to walk forward/backward
384    m 1000 ff 00\tput ff 00 on 1000
385    j|u 1000\t\tjump (change pc)
386    r 42\t\trun 42 instruction opcodes
387    t\t\ttrace [$t]
388    d\t\tdebug [$d]
389    
390    __USAGE__
391                            warn $self->dump_R;
392                    } elsif ( $c =~ m/^e/i ) {
393                            $a = $v if defined($v);
394                            my $to = shift @v;
395                            $to = $a + 32 if ( ! $to || $to <= $a );
396                            $to = 0xffff if ( $to > 0xffff );
397                            my $lines = int( ($to - $a + 8) / 8 );
398                            printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
399                            while ( --$lines ) {
400                                    print $self->hexdump( $a );
401                                    $a += 8;
402                            }
403                            $last = '+';
404                            $show_R = 0;
405                    } elsif ( $c =~ m/^\+/ ) {
406                            $a += 8;
407                            $show_R = 0;
408                    } elsif ( $c =~ m/^\-/ ) {
409                            $a -= 8;
410                            $show_R = 0;
411                    } elsif ( $c =~ m/^m/i ) {
412                            $a = $v if defined($v);
413                            $self->poke_code( $a, @v );
414                            printf "poke %d bytes at %04x\n", $#v + 1, $a;
415                            $last = '+';
416                            $show_R = 0;
417                    } elsif ( $c =~ m/^l/i ) {
418                            my $to = shift @v || 0x1000;
419                            $a = $to;
420                            $self->load_oraoemu( $v, $a );
421                            $last = '';
422                    } elsif ( $c =~ m/^s/i ) {
423                            $self->save_dump( $v || 'mem.dump', @v );
424                            $last = '';
425                    } elsif ( $c =~ m/^r/i ) {
426                            $run_for = $v || 1;
427                            print "run_for $run_for instructions\n";
428                            $show_R = 1;
429                            last;
430                    } elsif ( $c =~ m/^(u|j)/ ) {
431                            my $to = $v || $a;
432                            printf "set pc to %04x\n", $to;
433                            $PC = $to;      # remember for restart
434                            $run_for = 1;
435                            $last = "r $run_for";
436                            $show_R = 1;
437                            last;
438                    } elsif ( $c =~ m/^t/ ) {
439                            $self->trace( not $self->trace );
440                            print "trace ", $self->trace ? 'on' : 'off', "\n";
441                            $last = '';
442                    } elsif ( $c =~ m/^d/ ) {
443                            $self->debug( not $self->debug );
444                            print "debug ", $self->debug ? 'on' : 'off', "\n";
445                            $last = '';
446                    } else {
447                            warn "# ignored $line\n" if ($line);
448                            $last = '';
449                    }
450            }
451    
452    }
453    
454  =head1 AUTHOR  =head1 AUTHOR
455    
Legend:
Removed from v.30  
changed lines
  Added in v.76
  ViewVC Help
Powered by ViewVC 1.1.26