/[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 65 by dpavlin, Tue Jul 31 16:41:46 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                    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  my $loaded_files = {  }
         0xC000 => 'rom/BAS12.ROM',  
         0xE000 => 'rom/CRT12.ROM',  
 };  
118    
119  =head2 load_rom  =head2 load_rom
120    
# Line 60  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  }  }
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          my $size = -s $path || die "no size for $path: $!";          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: $!";
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                  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;
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                  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;
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 113  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 136  sub save_dump { Line 233  sub save_dump {
233          close($fh);          close($fh);
234    
235          my $size = -s $path;          my $size = -s $path;
236          printf "saved %s %d %x bytes\n", $path, $size, $size;          warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
237  }  }
238    
239  =head2 hexdump  =head2 hexdump
# Line 152  sub hexdump { Line 249  sub hexdump {
249                  join(" ",                  join(" ",
250                          map {                          map {
251                                  sprintf( "%02x", $_ )                                  sprintf( "%02x", $_ )
252                          } $self->ram( $a, $a+8 )                          } @mem[ $a .. $a+8 ]
253                  )                  )
254          );          );
255  }  }
256    
257    =head1 Memory management
258    
259    Orao implements all I/O using mmap addresses. This was main reason why
260    L<Acme::6502> was just too slow to handle it.
261    
262    =cut
263    
264    =head2 read
265    
266    Read from memory
267    
268      $byte = read( $address );
269    
270    =cut
271    
272    sub read {
273            my $self = shift;
274            my ($addr) = @_;
275            my $byte = $mem[$addr];
276            warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
277            $self->mmap_pixel( $addr, 0, $byte, 0 );
278            return $byte;
279    }
280    
281    =head2 write
282    
283    Write into emory
284    
285      write( $address, $byte );
286    
287    =cut
288    
289    sub write {
290            my $self = shift;
291            my ($addr,$byte) = @_;
292            warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
293    
294            if ( $addr >= 0x6000 && $addr < 0x8000 ) {
295                    $self->vram( $addr - 0x6000 , $byte );
296            }
297    
298            if ( $addr == 0x8800 ) {
299                    warn sprintf "sound ignored: %x\n", $byte;
300            }
301    
302            if ( $addr > 0xafff ) {
303                    warn sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
304                    return;
305            }
306    
307            $self->mmap_pixel( $addr, $byte, 0, 0 );
308    
309            $mem[$addr] = $byte;
310            return;
311    }
312    
313    =head1 Command Line
314    
315    Command-line debugging intrerface is implemented for communication with
316    emulated device
317    
318  =head2 prompt  =head2 prompt
319    
320    $orao->prompt( $address, $last_command );    my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
321    
322  =cut  =cut
323    
324    my $last = 'r 1';
325    
326  sub prompt {  sub prompt {
327          my $self = shift;          my $self = shift;
328            $self->app->sync;
329          my $a = shift;          my $a = shift;
330          my $last = shift;          print STDERR $self->hexdump( $a ),
         print $self->hexdump( $a ),  
331                  $last ? "[$last] " : '',                  $last ? "[$last] " : '',
332                  "> ";                  "> ";
333          my $in = <STDIN>;          my $in = <STDIN>;
334          chomp($in);          chomp($in);
335            warn "## prompt got: $in\n" if $self->debug;
336          $in ||= $last;          $in ||= $last;
337          $last = $in;          $last = $in;
338          return split(/\s+/, $in) if $in;          return ( $in, split(/\s+/, $in) ) if $in;
339  }  }
340    
341    =head2 cli
342    
343      $orao->cli();
344    
345    =cut
346    
347    sub cli {
348            my $self = shift;
349            my $a = $PC || confess "no pc?";
350            while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
351                    my $c = shift @v;
352                    next unless defined($c);
353                    my $v = shift @v;
354                    $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
355                    @v = map { hex($_) } @v;
356                    printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
357                    if ( $c =~ m/^[qx]/i ) {
358                            exit;
359                    } elsif ( $c eq '?' ) {
360                            my $t = $self->trace ? 'on' : 'off' ;
361                            my $d = $self->debug ? 'on' : 'off' ;
362                            warn <<__USAGE__;
363    Usage:
364    
365    x|q\t\texit
366    e 6000 6010\tdump memory, +/- to walk forward/backward
367    m 1000 ff 00\tput ff 00 on 1000
368    j|u 1000\t\tjump (change pc)
369    r 42\t\trun 42 instruction opcodes
370    t\t\ttrace [$t]
371    d\t\tdebug [$d]
372    
373    __USAGE__
374                            warn sprintf(" PC: %04x A:%02x P:%02x X:%02x Y:%02x S:%02x\n", $PC, $A, $P, $X, $Y, $S);
375                    } elsif ( $c =~ m/^e/i ) {
376                            $a = $v if defined($v);
377                            my $to = shift @v;
378                            $to = $a + 32 if ( ! $to || $to <= $a );
379                            my $lines = int( ($to - $a + 8) / 8 );
380                            printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
381                            while ( --$lines ) {
382                                    print $self->hexdump( $a );
383                                    $a += 8;
384                            }
385                            $last = '+';
386                    } elsif ( $c =~ m/^\+/ ) {
387                            $a += 8;
388                    } elsif ( $c =~ m/^\-/ ) {
389                            $a -= 8;
390                    } elsif ( $c =~ m/^m/i ) {
391                            $a = $v;
392                            $self->poke_code( $a, @v );
393                            printf "poke %d bytes at %04x\n", $#v + 1, $a;
394                            $last = '+';
395                    } elsif ( $c =~ m/^l/i ) {
396                            my $to = shift @v || 0x1000;
397                            $a = $to;
398                            $self->load_oraoemu( $v, $a );
399                            $last = '';
400                    } elsif ( $c =~ m/^s/i ) {
401                            $self->save_dump( $v || 'mem.dump', @v );
402                            $last = '';
403                    } elsif ( $c =~ m/^r/i ) {
404                            $run_for = $v || 1;
405                            print "run_for $run_for instructions\n";
406                            last;
407                    } elsif ( $c =~ m/^(u|j)/ ) {
408                            my $to = $v || $a;
409                            printf "set pc to %04x\n", $to;
410                            $PC = $to;      # remember for restart
411                            $run_for = 1;
412                            $last = "r $run_for";
413                            last;
414                    } elsif ( $c =~ m/^t/ ) {
415                            $self->trace( not $self->trace );
416                            print "trace ", $self->trace ? 'on' : 'off', "\n";
417                            $last = '';
418                    } elsif ( $c =~ m/^d/ ) {
419                            $self->debug( not $self->debug );
420                            print "debug ", $self->debug ? 'on' : 'off', "\n";
421                            $last = '';
422                    } else {
423                            warn "# ignored $line\n" if ($line);
424                            $last = '';
425                    }
426            }
427    
428    }
429    
430  =head1 AUTHOR  =head1 AUTHOR
431    
Legend:
Removed from v.30  
changed lines
  Added in v.65
  ViewVC Help
Powered by ViewVC 1.1.26