/[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 32 by dpavlin, Mon Jul 30 18:37:37 2007 UTC revision 71 by dpavlin, Tue Jul 31 17:42:03 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/;  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 32  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;  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;          $orao = $self;
62    
63          $self->prompt( 0x1000 );  #       $self->prompt( 0x1000 );
 }  
64    
65  my $loaded_files = {          my ( $trace, $debug ) = ( $self->trace, $self->debug );
66          0xC000 => 'rom/BAS12.ROM',          $self->trace( 0 );
67          0xE000 => 'rom/CRT12.ROM',          $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 67  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};
                 warn sprintf "loading '%s' at %04x\n", $path, $addr;  
134                  $self->load_oraoemu( $path, $addr );                  $self->load_oraoemu( $path, $addr );
135          }          }
136  }  }
137    
138    # write chunk directly into memory, updateing vram if needed
139    sub _write_chunk {
140            my $self = shift;
141            my ( $addr, $chunk ) = @_;
142            $self->write_chunk( $addr, $chunk );
143            my $end = $addr + length($chunk);
144            my ( $f, $t ) = ( 0x6000, 0x7fff );
145    
146            if ( $end < $f || $addr >= $t ) {
147                    warn "skip vram update\n";
148                    return;
149            };
150    
151            $f = $addr if ( $addr > $f );
152            $t = $end if ( $end < $t );
153    
154            warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
155            foreach my $a ( $f .. $t ) {
156                    $self->vram( $a - 0x6000 , $mem[ $a ] );
157            }
158    }
159    
160  =head2 load_oraoemu  =head2 load_oraoemu
161    
162    Load binary files, ROM images and Orao Emulator files
163    
164      $orao->load_oraoemu( '/path/to/file', 0x1000 );
165    
166    Returns true on success.
167    
168  =cut  =cut
169    
170  sub load_oraoemu {  sub load_oraoemu {
171          my $self = shift;          my $self = shift;
172          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
173    
174            if ( ! -e $path ) {
175                    warn "ERROR: file $path doesn't exist\n";
176                    return;
177            }
178    
179          my $size = -s $path || confess "no size for $path: $!";          my $size = -s $path || confess "no size for $path: $!";
180    
181          my $buff = read_file( $path );          my $buff = read_file( $path );
182    
183          if ( $size == 65538 ) {          if ( $size == 65538 ) {
184                  $addr = 0;                  $addr = 0;
185                  warn sprintf "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;
186                  $self->write_chunk( $addr, substr($buff,2) );                  $self->_write_chunk( $addr, substr($buff,2) );
187                  return;                  return 1;
188          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
189                  $addr = 0;                  $addr = 0;
190                  warn sprintf "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;
191                  #$self->write_chunk( $addr, substr($buff,0x20) );                  $self->_write_chunk( $addr, substr($buff,0x20) );
192                  $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );                  return 1;
                 return;  
193          }          }
194          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;
195          return $self->write_chunk( $addr, $buff );          $self->_write_chunk( $addr, $buff );
196            return 1;
197    
198          my $chunk;          my $chunk;
199    
# Line 120  sub load_oraoemu { Line 209  sub load_oraoemu {
209                  $pos += 4;                  $pos += 4;
210          }          }
211    
212          $self->write_chunk( $addr, $chunk );          $self->_write_chunk( $addr, $chunk );
213    
214            return 1;
215  };  };
216    
217  =head2 save_dump  =head2 save_dump
# Line 158  sub hexdump { Line 248  sub hexdump {
248          return sprintf(" %04x %s\n", $a,          return sprintf(" %04x %s\n", $a,
249                  join(" ",                  join(" ",
250                          map {                          map {
251                                  sprintf( "%02x", $_ )                                  if ( defined($_) ) {
252                          } $self->ram( $a, $a+8 )                                          sprintf( "%02x", $_ )
253                                    } else {
254                                            '  '
255                                    }
256                            } @mem[ $a .. $a+8 ]
257                  )                  )
258          );          );
259  }  }
260    
 =head2 prompt  
   
   $orao->prompt( $address, $last_command );  
   
 =cut  
   
 sub prompt {  
         my $self = shift;  
         my $a = shift;  
         my $last = shift;  
         print STDERR $self->hexdump( $a ),  
                 $last ? "[$last] " : '',  
                 "> ";  
         my $in = <STDIN>;  
         chomp($in);  
         $in ||= $last;  
         $last = $in;  
         return split(/\s+/, $in) if $in;  
 }  
   
261  =head1 Memory management  =head1 Memory management
262    
263  Orao implements all I/O using mmap addresses. This was main reason why  Orao implements all I/O using mmap addresses. This was main reason why
# Line 191  L<Acme::6502> was just too slow to handl Line 265  L<Acme::6502> was just too slow to handl
265    
266  =cut  =cut
267    
 my @mem = (0xff) x 0x100000; # 64Mb  
   
268  =head2 read  =head2 read
269    
270  Read from memory  Read from memory
# Line 202  Read from memory Line 274  Read from memory
274  =cut  =cut
275    
276  sub read {  sub read {
277          my $self = $orao;          my $self = shift;
278          my ($addr) = @_;          my ($addr) = @_;
279          my $byte = $mem[$addr];          my $byte = $mem[$addr];
280          warn "# Orao::read(",dump(@_),") = ",dump( $byte ),"\n" if $self->debug;          warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
281          mmap_pixel( $addr, 0, $byte, 0 );          $self->mmap_pixel( $addr, 0, $byte, 0 );
282          return $byte;          return $byte;
283  }  }
284    
# Line 219  Write into emory Line 291  Write into emory
291  =cut  =cut
292    
293  sub write {  sub write {
294          my $self = $orao;          my $self = shift;
         warn "# Orao::write(",dump(@_),")\n" if $self->debug;  
295          my ($addr,$byte) = @_;          my ($addr,$byte) = @_;
296            warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
297    
298          if ( $addr >= 0x6000 && $addr < 0x8000 ) {          if ( $addr >= 0x6000 && $addr < 0x8000 ) {
299                  $self->vram( $addr - 0x6000 , $byte );                  $self->vram( $addr - 0x6000 , $byte );
300          }          }
301    
         if ( $addr > 0xafff ) {  
                 warn sprintf "access to %04x above affff aborting\n", $addr;  
                 return -1;  
         }  
302          if ( $addr == 0x8800 ) {          if ( $addr == 0x8800 ) {
303                  warn sprintf "sound ignored: %x\n", $byte;                  warn sprintf "sound ignored: %x\n", $byte;
304          }          }
305    
306          mmap_pixel( $addr, $byte, 0, 0 );          if ( $addr > 0xafff ) {
307                    warn sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
308                    return;
309            }
310    
311            $self->mmap_pixel( $addr, $byte, 0, 0 );
312    
313          $mem[$addr] = $byte;          $mem[$addr] = $byte;
314            return;
315  }  }
316    
317    =head1 Command Line
318    
319    Command-line debugging intrerface is implemented for communication with
320    emulated device
321    
322    =head2 prompt
323    
324      my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
325    
326    =cut
327    
328    my $last = 'r 1';
329    
330    sub prompt {
331            my $self = shift;
332            $self->app->sync;
333            my $a = shift;
334            print STDERR $self->hexdump( $a ),
335                    $last ? "[$last] " : '',
336                    "> ";
337            my $in = <STDIN>;
338            chomp($in);
339            warn "## prompt got: $in\n" if $self->debug;
340            $in ||= $last;
341            $last = $in;
342            return ( $in, split(/\s+/, $in) ) if $in;
343    }
344    
345    =head2 cli
346    
347      $orao->cli();
348    
349    =cut
350    
351    my $show_R = 0;
352    
353    sub cli {
354            my $self = shift;
355            my $a = $PC || confess "no pc?";
356            warn $self->dump_R() if $show_R;
357            while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
358                    my $c = shift @v;
359                    next unless defined($c);
360                    my $v = shift @v;
361                    $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
362                    @v = map { hex($_) } @v;
363                    printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
364                    if ( $c =~ m/^[qx]/i ) {
365                            exit;
366                    } elsif ( $c eq '?' ) {
367                            my $t = $self->trace ? 'on' : 'off' ;
368                            my $d = $self->debug ? 'on' : 'off' ;
369                            warn <<__USAGE__;
370    Usage:
371    
372    x|q\t\texit
373    e 6000 6010\tdump memory, +/- to walk forward/backward
374    m 1000 ff 00\tput ff 00 on 1000
375    j|u 1000\t\tjump (change pc)
376    r 42\t\trun 42 instruction opcodes
377    t\t\ttrace [$t]
378    d\t\tdebug [$d]
379    
380    __USAGE__
381                            warn $self->dump_R;
382                    } elsif ( $c =~ m/^e/i ) {
383                            $a = $v if defined($v);
384                            my $to = shift @v;
385                            $to = $a + 32 if ( ! $to || $to <= $a );
386                            $to = 0xffff if ( $to > 0xffff );
387                            my $lines = int( ($to - $a + 8) / 8 );
388                            printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
389                            while ( --$lines ) {
390                                    print $self->hexdump( $a );
391                                    $a += 8;
392                            }
393                            $last = '+';
394                            $show_R = 0;
395                    } elsif ( $c =~ m/^\+/ ) {
396                            $a += 8;
397                            $show_R = 0;
398                    } elsif ( $c =~ m/^\-/ ) {
399                            $a -= 8;
400                            $show_R = 0;
401                    } elsif ( $c =~ m/^m/i ) {
402                            $a = $v if defined($v);
403                            $self->poke_code( $a, @v );
404                            printf "poke %d bytes at %04x\n", $#v + 1, $a;
405                            $last = '+';
406                            $show_R = 0;
407                    } elsif ( $c =~ m/^l/i ) {
408                            my $to = shift @v || 0x1000;
409                            $a = $to;
410                            $self->load_oraoemu( $v, $a );
411                            $last = '';
412                    } elsif ( $c =~ m/^s/i ) {
413                            $self->save_dump( $v || 'mem.dump', @v );
414                            $last = '';
415                    } elsif ( $c =~ m/^r/i ) {
416                            $run_for = $v || 1;
417                            print "run_for $run_for instructions\n";
418                            $show_R = 1;
419                            last;
420                    } elsif ( $c =~ m/^(u|j)/ ) {
421                            my $to = $v || $a;
422                            printf "set pc to %04x\n", $to;
423                            $PC = $to;      # remember for restart
424                            $run_for = 1;
425                            $last = "r $run_for";
426                            $show_R = 1;
427                            last;
428                    } elsif ( $c =~ m/^t/ ) {
429                            $self->trace( not $self->trace );
430                            print "trace ", $self->trace ? 'on' : 'off', "\n";
431                            $last = '';
432                    } elsif ( $c =~ m/^d/ ) {
433                            $self->debug( not $self->debug );
434                            print "debug ", $self->debug ? 'on' : 'off', "\n";
435                            $last = '';
436                    } else {
437                            warn "# ignored $line\n" if ($line);
438                            $last = '';
439                    }
440            }
441    
442    }
443    
444  =head1 AUTHOR  =head1 AUTHOR
445    
Legend:
Removed from v.32  
changed lines
  Added in v.71
  ViewVC Help
Powered by ViewVC 1.1.26