/[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 73 by dpavlin, Tue Jul 31 21:43:57 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);  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 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, open L<Screen>, load initial ROM images, and render memory
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 "Orao $Orao::VERSION emulation starting\n";
50    
51            $self->open_screen;
52            $self->load_rom({
53                    0x1000 => 'dump/SCRINV.BIN',
54    #               0x6000 => 'dump/screen.dmp',
55                    0xC000 => 'rom/BAS12.ROM',
56                    0xE000 => 'rom/CRT12.ROM',
57            });
58    
59    #       $PC = 0xDD11;   # BC
60    #       $PC = 0xC274;   # MC
61    
62            $orao = $self;
63    
64    #       $self->prompt( 0x1000 );
65    
66            my ( $trace, $debug ) = ( $self->trace, $self->debug );
67            $self->trace( 0 );
68            $self->debug( 0 );
69    
70            $self->render( @mem[ 0x6000 .. 0x7fff ] );
71    
72            if ( $self->show_mem ) {
73    
74                    warn "rendering memory map\n";
75    
76                    my @mmap = (
77                            0x0000, 0x03FF, 'nulti blok',
78                            0x0400, 0x5FFF, 'korisnički RAM (23K)',
79                            0x6000, 0x7FFF, 'video RAM',
80                            0x8000, 0x9FFF, 'sistemske lokacije',
81                            0xA000, 0xAFFF, 'ekstenzija',
82                            0xB000, 0xBFFF, 'DOS',
83                            0xC000, 0xDFFF, 'BASIC ROM',
84                            0xE000, 0xFFFF, 'sistemski ROM',
85                    );
86    
87                    foreach my $i ( 0 .. $#mmap / 3 ) {
88                            my $o = $i * 3;
89                            my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];
90                            printf "%04x - %04x - %s\n", $from, $to, $desc;
91                            for my $a ( $from .. $to ) {
92                                    if ( $a >= 0x6000 && $a < 0x8000 ) {
93                                            my $b = $self->read( $a );
94                                            $self->vram( $a - 0x6000, $b );
95                                    } else {
96                                            $self->read( $a );
97                                    }
98                            }
99                    }
100    
101            } else {
102    
103                    warn "rendering video memory\n";
104    #               for my $a ( 0x6000 .. 0x7fff ) {
105    #                       $self->vram( $a - 0x6000, $mem[$a] );
106    #               }
107                    $self->render( @mem[ 0x6000 .. 0x7fff ] );
108            
109            }
110            $self->sync;
111            $self->trace( $trace );
112            $self->debug( $debug );
113    
114            #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
115    
116            warn "Orao init finished",
117                    $self->trace ? ' trace' : '',
118                    $self->debug ? ' debug' : '',
119                    "\n";
120    
121    }
122    
123  =head2 load_rom  =head2 load_rom
124    
# Line 43  called to init memory and load initial r Line 129  called to init memory and load initial r
129  =cut  =cut
130    
131  sub load_rom {  sub load_rom {
132      my ($self) = @_;      my ($self, $loaded_files) = @_;
133    
134      #my $time_base = time();      #my $time_base = time();
135    
136          foreach my $addr ( sort keys %$loaded_files ) {          foreach my $addr ( sort keys %$loaded_files ) {
137                  my $path = $loaded_files->{$addr};                  my $path = $loaded_files->{$addr};
                 printf "loading '%s' at %04x\n", $path, $addr;  
138                  $self->load_oraoemu( $path, $addr );                  $self->load_oraoemu( $path, $addr );
139          }          }
140  }  }
141    
142    # write chunk directly into memory, updateing vram if needed
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            $self->render( @mem[ 0x6000 .. 0x7fff ] );
163    }
164    
165  =head2 load_oraoemu  =head2 load_oraoemu
166    
167    Load binary files, ROM images and Orao Emulator files
168    
169      $orao->load_oraoemu( '/path/to/file', 0x1000 );
170    
171    Returns true on success.
172    
173  =cut  =cut
174    
175  sub load_oraoemu {  sub load_oraoemu {
176          my $self = shift;          my $self = shift;
177          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
178    
179          my $size = -s $path || die "no size for $path: $!";          if ( ! -e $path ) {
180                    warn "ERROR: file $path doesn't exist\n";
181                    return;
182            }
183    
184            my $size = -s $path || confess "no size for $path: $!";
185    
186          my $buff = read_file( $path );          my $buff = read_file( $path );
187    
188          if ( $size == 65538 ) {          if ( $size == 65538 ) {
189                  $addr = 0;                  $addr = 0;
190                  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;
191                  $self->write_chunk( $addr, substr($buff,2) );                  $self->_write_chunk( $addr, substr($buff,2) );
192                  return;                  return 1;
193          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
194                  $addr = 0;                  $addr = 0;
195                  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;
196                  #$self->write_chunk( $addr, substr($buff,0x20) );                  $self->_write_chunk( $addr, substr($buff,0x20) );
197                  $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );                  return 1;
                 return;  
198          }          }
199          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;
200          return $self->write_chunk( $addr, $buff );          $self->_write_chunk( $addr, $buff );
201            return 1;
202    
203          my $chunk;          my $chunk;
204    
# Line 96  sub load_oraoemu { Line 214  sub load_oraoemu {
214                  $pos += 4;                  $pos += 4;
215          }          }
216    
217          $self->write_chunk( $addr, $chunk );          $self->_write_chunk( $addr, $chunk );
218    
219            return 1;
220  };  };
221    
222  =head2 save_dump  =head2 save_dump
# Line 119  sub save_dump { Line 238  sub save_dump {
238          close($fh);          close($fh);
239    
240          my $size = -s $path;          my $size = -s $path;
241          printf "saved %s %d %x bytes\n", $path, $size, $size;          warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
242  }  }
243    
244  =head2 hexdump  =head2 hexdump
# Line 134  sub hexdump { Line 253  sub hexdump {
253          return sprintf(" %04x %s\n", $a,          return sprintf(" %04x %s\n", $a,
254                  join(" ",                  join(" ",
255                          map {                          map {
256                                  sprintf( "%02x", $_ )                                  if ( defined($_) ) {
257                          } $self->ram( $a, $a+8 )                                          sprintf( "%02x", $_ )
258                                    } else {
259                                            '  '
260                                    }
261                            } @mem[ $a .. $a+8 ]
262                  )                  )
263          );          );
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 == 0x8800 ) {
308                    warn sprintf "sound ignored: %x\n", $byte;
309            }
310    
311            if ( $addr > 0xafff ) {
312                    warn sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
313                    return;
314            }
315    
316            $self->mmap_pixel( $addr, $byte, 0, 0 );
317    
318            $mem[$addr] = $byte;
319            return;
320    }
321    
322    =head1 Command Line
323    
324    Command-line debugging intrerface is implemented for communication with
325    emulated device
326    
327  =head2 prompt  =head2 prompt
328    
329    $orao->prompt( $address, $last_command );    my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
330    
331  =cut  =cut
332    
333    my $last = 'r 1';
334    
335  sub prompt {  sub prompt {
336          my $self = shift;          my $self = shift;
337            $self->app->sync;
338          my $a = shift;          my $a = shift;
339          my $last = shift;          print STDERR $self->hexdump( $a ),
         print $self->hexdump( $a ),  
340                  $last ? "[$last] " : '',                  $last ? "[$last] " : '',
341                  "> ";                  "> ";
342          my $in = <STDIN>;          my $in = <STDIN>;
343          chomp($in);          chomp($in);
344            warn "## prompt got: $in\n" if $self->debug;
345          $in ||= $last;          $in ||= $last;
346          $last = $in;          $last = $in;
347          return split(/\s+/, $in) if $in;          return ( $in, split(/\s+/, $in) ) if $in;
348    }
349    
350    =head2 cli
351    
352      $orao->cli();
353    
354    =cut
355    
356    my $show_R = 0;
357    
358    sub cli {
359            my $self = shift;
360            my $a = $PC || confess "no pc?";
361            warn $self->dump_R() if $show_R;
362            while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
363                    my $c = shift @v;
364                    next unless defined($c);
365                    my $v = shift @v;
366                    $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
367                    @v = map { hex($_) } @v;
368                    printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
369                    if ( $c =~ m/^[qx]/i ) {
370                            exit;
371                    } elsif ( $c eq '?' ) {
372                            my $t = $self->trace ? 'on' : 'off' ;
373                            my $d = $self->debug ? 'on' : 'off' ;
374                            warn <<__USAGE__;
375    Usage:
376    
377    x|q\t\texit
378    e 6000 6010\tdump memory, +/- to walk forward/backward
379    m 1000 ff 00\tput ff 00 on 1000
380    j|u 1000\t\tjump (change pc)
381    r 42\t\trun 42 instruction opcodes
382    t\t\ttrace [$t]
383    d\t\tdebug [$d]
384    
385    __USAGE__
386                            warn $self->dump_R;
387                    } elsif ( $c =~ m/^e/i ) {
388                            $a = $v if defined($v);
389                            my $to = shift @v;
390                            $to = $a + 32 if ( ! $to || $to <= $a );
391                            $to = 0xffff if ( $to > 0xffff );
392                            my $lines = int( ($to - $a + 8) / 8 );
393                            printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
394                            while ( --$lines ) {
395                                    print $self->hexdump( $a );
396                                    $a += 8;
397                            }
398                            $last = '+';
399                            $show_R = 0;
400                    } elsif ( $c =~ m/^\+/ ) {
401                            $a += 8;
402                            $show_R = 0;
403                    } elsif ( $c =~ m/^\-/ ) {
404                            $a -= 8;
405                            $show_R = 0;
406                    } elsif ( $c =~ m/^m/i ) {
407                            $a = $v if defined($v);
408                            $self->poke_code( $a, @v );
409                            printf "poke %d bytes at %04x\n", $#v + 1, $a;
410                            $last = '+';
411                            $show_R = 0;
412                    } elsif ( $c =~ m/^l/i ) {
413                            my $to = shift @v || 0x1000;
414                            $a = $to;
415                            $self->load_oraoemu( $v, $a );
416                            $last = '';
417                    } elsif ( $c =~ m/^s/i ) {
418                            $self->save_dump( $v || 'mem.dump', @v );
419                            $last = '';
420                    } elsif ( $c =~ m/^r/i ) {
421                            $run_for = $v || 1;
422                            print "run_for $run_for instructions\n";
423                            $show_R = 1;
424                            last;
425                    } elsif ( $c =~ m/^(u|j)/ ) {
426                            my $to = $v || $a;
427                            printf "set pc to %04x\n", $to;
428                            $PC = $to;      # remember for restart
429                            $run_for = 1;
430                            $last = "r $run_for";
431                            $show_R = 1;
432                            last;
433                    } elsif ( $c =~ m/^t/ ) {
434                            $self->trace( not $self->trace );
435                            print "trace ", $self->trace ? 'on' : 'off', "\n";
436                            $last = '';
437                    } elsif ( $c =~ m/^d/ ) {
438                            $self->debug( not $self->debug );
439                            print "debug ", $self->debug ? 'on' : 'off', "\n";
440                            $last = '';
441                    } else {
442                            warn "# ignored $line\n" if ($line);
443                            $last = '';
444                    }
445            }
446    
447  }  }
448    
449  =head1 AUTHOR  =head1 AUTHOR
Legend:
Removed from v.29  
changed lines
  Added in v.73
  ViewVC Help
Powered by ViewVC 1.1.26