/[VRac]/M6502/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 /M6502/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 78 by dpavlin, Wed Aug 1 13:52:39 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 List::Util qw/first/;
12    use M6502;
13    
14  use base qw(Class::Accessor M6502 Screen);  use base qw(Class::Accessor M6502 Screen Prefs);
15  __PACKAGE__->mk_accessors(qw(debug trace run_for mem_dump trace));  __PACKAGE__->mk_accessors(qw(run_for));
16    
17  =head1 NAME  =head1 NAME
18    
# Line 30  Emulator or Orao 8-bit 6502 machine popu Line 32  Emulator or Orao 8-bit 6502 machine popu
32    
33  =cut  =cut
34    
35    my @kbd_ports = (
36        0x87FC,0x87FD,0x87FA,0x87FB,0x87F6,0x87F7,
37        0x87EE,0x87EF,0x87DE,0x87DF,0x87BE,0x87BF,
38        0x877E,0x877F,0x86FE,0x86FF,0x85FE,0x85FF,
39        0x83FE,0x83FF,
40    );
41    
42  =head2 init  =head2 init
43    
44  Start emulator  Start emulator, open L<Screen>, load initial ROM images, and render memory
45    
46  =cut  =cut
47    
48  our $orao;  our $orao;
49    
50    select(STDERR); $| = 1;
51    
52  sub init {  sub init {
53          my $self = shift;          my $self = shift;
54          warn "call upstream init\n";          warn "Orao calling upstream init\n";
55          $self->SUPER::init( @_ );          $self->SUPER::init( $self, @_ );
56    
57          warn "staring Orao $Orao::VERSION emulation\n";          warn "Orao $Orao::VERSION emulation starting\n";
58    
59          $self->open_screen;          $self->open_screen;
60          $self->load_rom;          $self->load_rom({
61                    0x1000 => 'dump/SCRINV.BIN',
62                    # should be 0x6000, but oraoemu has 2 byte prefix
63                    0x5FFE => 'dump/screen.dmp',
64                    0xC000 => 'rom/BAS12.ROM',
65                    0xE000 => 'rom/CRT12.ROM',
66            });
67    
68    #       $PC = 0xDD11;   # BC
69    #       $PC = 0xC274;   # MC
70    
71            $PC = 0xff89;
72    
73          $orao = $self;          $orao = $self;
74    
75          $self->prompt( 0x1000 );  #       $self->prompt( 0x1000 );
 }  
76    
77  my $loaded_files = {          my ( $trace, $debug ) = ( $self->trace, $self->debug );
78          0xC000 => 'rom/BAS12.ROM',          $self->trace( 0 );
79          0xE000 => 'rom/CRT12.ROM',          $self->debug( 0 );
80  };  
81            $self->render( @mem[ 0x6000 .. 0x7fff ] );
82    
83            if ( $self->show_mem ) {
84    
85                    warn "rendering memory map\n";
86    
87                    $self->render_mem( @mem );
88    
89                    my @mmap = (
90                            0x0000, 0x03FF, 'nulti blok',
91                            0x0400, 0x5FFF, 'korisnički RAM (23K)',
92                            0x6000, 0x7FFF, 'video RAM',
93                            0x8000, 0x9FFF, 'sistemske lokacije',
94                            0xA000, 0xAFFF, 'ekstenzija',
95                            0xB000, 0xBFFF, 'DOS',
96                            0xC000, 0xDFFF, 'BASIC ROM',
97                            0xE000, 0xFFFF, 'sistemski ROM',
98                    );
99    
100            } else {
101    
102                    warn "rendering video memory\n";
103                    $self->render( @mem[ 0x6000 .. 0x7fff ] );
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            $self->render( @mem[ 0x6000 .. 0x7fff ] );
159            $self->render_mem( @mem ) if $self->show_mem;
160    }
161    
162  =head2 load_oraoemu  =head2 load_oraoemu
163    
164    Load binary files, ROM images and Orao Emulator files
165    
166      $orao->load_oraoemu( '/path/to/file', 0x1000 );
167    
168    Returns true on success.
169    
170  =cut  =cut
171    
172  sub load_oraoemu {  sub load_oraoemu {
173          my $self = shift;          my $self = shift;
174          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
175    
176            if ( ! -e $path ) {
177                    warn "ERROR: file $path doesn't exist\n";
178                    return;
179            }
180    
181          my $size = -s $path || confess "no size for $path: $!";          my $size = -s $path || confess "no size for $path: $!";
182    
183          my $buff = read_file( $path );          my $buff = read_file( $path );
184    
185          if ( $size == 65538 ) {          if ( $size == 65538 ) {
186                  $addr = 0;                  $addr = 0;
187                  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;
188                  $self->write_chunk( $addr, substr($buff,2) );                  $self->_write_chunk( $addr, substr($buff,2) );
189                  return;                  return 1;
190          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
191                  $addr = 0;                  $addr = 0;
192                  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;
193                  #$self->write_chunk( $addr, substr($buff,0x20) );                  $self->_write_chunk( $addr, substr($buff,0x20) );
194                  $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );                  return 1;
                 return;  
195          }          }
196          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;
197          return $self->write_chunk( $addr, $buff );          $self->_write_chunk( $addr, $buff );
198            return 1;
199    
200          my $chunk;          my $chunk;
201    
# Line 120  sub load_oraoemu { Line 211  sub load_oraoemu {
211                  $pos += 4;                  $pos += 4;
212          }          }
213    
214          $self->write_chunk( $addr, $chunk );          $self->_write_chunk( $addr, $chunk );
215    
216            return 1;
217  };  };
218    
219  =head2 save_dump  =head2 save_dump
# Line 158  sub hexdump { Line 250  sub hexdump {
250          return sprintf(" %04x %s\n", $a,          return sprintf(" %04x %s\n", $a,
251                  join(" ",                  join(" ",
252                          map {                          map {
253                                  sprintf( "%02x", $_ )                                  if ( defined($_) ) {
254                          } $self->ram( $a, $a+8 )                                          sprintf( "%02x", $_ )
255                                    } else {
256                                            '  '
257                                    }
258                            } @mem[ $a .. $a+8 ]
259                  )                  )
260          );          );
261  }  }
262    
 =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;  
 }  
   
263  =head1 Memory management  =head1 Memory management
264    
265  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 267  L<Acme::6502> was just too slow to handl
267    
268  =cut  =cut
269    
 my @mem = (0xff) x 0x100000; # 64Mb  
   
270  =head2 read  =head2 read
271    
272  Read from memory  Read from memory
# Line 202  Read from memory Line 276  Read from memory
276  =cut  =cut
277    
278  sub read {  sub read {
279          my $self = $orao;          my $self = shift;
280          my ($addr) = @_;          my ($addr) = @_;
281          my $byte = $mem[$addr];          my $byte = $mem[$addr];
282          warn "# Orao::read(",dump(@_),") = ",dump( $byte ),"\n" if $self->debug;          warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
283          mmap_pixel( $addr, 0, $byte, 0 );  
284            # keyboard
285    
286            if ( first { $addr == $_ } @kbd_ports ) {
287                    warn sprintf("keyboard port: %04x\n",$addr);
288            } elsif ( $addr == 0x87fc ) {
289                    warn "0x87fc - arrows/back\n";
290    =for pascal
291                    if VKey=VK_RIGHT then Result:=16;
292                    if VKey=VK_DOWN then Result:=128;
293                    if VKey=VK_UP then Result:=192;
294                    if VKey=VK_LEFT then Result:=224;
295                    if Ord(KeyPressed)=VK_BACK then Result:=224;
296    =cut
297            } elsif ( $addr == 0x87fd ) {
298                    warn "0x87fd - enter\n";
299    =for pascal
300        if KeyPressed=Chr(13) then begin
301          Mem[$FC]:=13;
302          Result:=0;
303        end;
304    =cut
305            } elsif ( $addr == 0x87fa ) {
306                    warn "0x87fa = F1 - F4\n";
307    =for pascal
308        if VKey=VK_F4 then Result:=16;
309        if VKey=VK_F3 then Result:=128;
310        if VKey=VK_F2 then Result:=192;
311        if VKey=VK_F1 then Result:=224;
312    =cut
313            } elsif ( $addr == 0x87fb ) {
314                    warn "0x87fb\n";
315    =for pascal
316        if KeyPressed=Chr(32) then Result:=32;
317        if KeyPressed='"' then Result:=16;
318        if KeyPressed='!' then Result:=16;
319        if KeyPressed='$' then Result:=16;
320        if KeyPressed='%' then Result:=16;
321        if KeyPressed='&' then Result:=16;
322        if KeyPressed='(' then Result:=16;
323        if KeyPressed=')' then Result:=16;
324        if KeyPressed='=' then Result:=16;
325        if KeyPressed='#' then Result:=16;
326        if KeyPressed='+' then Result:=16;
327        if KeyPressed='*' then Result:=16;
328        if KeyPressed='?' then Result:=16;
329        if KeyPressed='<' then Result:=16;
330        if KeyPressed='>' then Result:=16;
331        if VKey=191 then Result:=16;
332    =cut
333            }
334    
335            $self->mmap_pixel( $addr, 0, $byte, 0 );
336          return $byte;          return $byte;
337  }  }
338    
# Line 219  Write into emory Line 345  Write into emory
345  =cut  =cut
346    
347  sub write {  sub write {
348          my $self = $orao;          my $self = shift;
         warn "# Orao::write(",dump(@_),")\n" if $self->debug;  
349          my ($addr,$byte) = @_;          my ($addr,$byte) = @_;
350            warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
351    
352          if ( $addr >= 0x6000 && $addr < 0x8000 ) {          if ( $addr >= 0x6000 && $addr < 0x8000 ) {
353                  $self->vram( $addr - 0x6000 , $byte );                  $self->vram( $addr - 0x6000 , $byte );
354          }          }
355    
         if ( $addr > 0xafff ) {  
                 warn sprintf "access to %04x above affff aborting\n", $addr;  
                 return -1;  
         }  
356          if ( $addr == 0x8800 ) {          if ( $addr == 0x8800 ) {
357                  warn sprintf "sound ignored: %x\n", $byte;                  warn sprintf "sound ignored: %x\n", $byte;
358          }          }
359    
360          mmap_pixel( $addr, $byte, 0, 0 );          if ( $addr > 0xafff ) {
361                    warn sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
362                    return;
363            }
364    
365            $self->mmap_pixel( $addr, $byte, 0, 0 );
366    
367          $mem[$addr] = $byte;          $mem[$addr] = $byte;
368            return;
369    }
370    
371    =head1 Command Line
372    
373    Command-line debugging intrerface is implemented for communication with
374    emulated device
375    
376    =head2 prompt
377    
378      my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
379    
380    =cut
381    
382    my $last = 'r 1';
383    
384    sub prompt {
385            my $self = shift;
386            $self->app->sync;
387            my $a = shift;
388            print STDERR $self->hexdump( $a ),
389                    $last ? "[$last] " : '',
390                    "> ";
391            my $in = <STDIN>;
392            chomp($in);
393            warn "## prompt got: $in\n" if $self->debug;
394            $in ||= $last;
395            $last = $in;
396            return ( $in, split(/\s+/, $in) ) if $in;
397  }  }
398    
399    =head2 cli
400    
401      $orao->cli();
402    
403    =cut
404    
405    my $show_R = 0;
406    
407    sub cli {
408            my $self = shift;
409            my $a = $PC || confess "no pc?";
410            warn $self->dump_R() if $show_R;
411            while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
412                    my $c = shift @v;
413                    next unless defined($c);
414                    my $v = shift @v;
415                    $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
416                    @v = map { hex($_) } @v;
417                    printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
418                    if ( $c =~ m/^[qx]/i ) {
419                            exit;
420                    } elsif ( $c eq '?' ) {
421                            my $t = $self->trace ? 'on' : 'off' ;
422                            my $d = $self->debug ? 'on' : 'off' ;
423                            warn <<__USAGE__;
424    Usage:
425    
426    x|q\t\texit
427    e 6000 6010\tdump memory, +/- to walk forward/backward
428    m 1000 ff 00\tput ff 00 on 1000
429    j|u 1000\t\tjump (change pc)
430    r 42\t\trun 42 instruction opcodes
431    t\t\ttrace [$t]
432    d\t\tdebug [$d]
433    
434    __USAGE__
435                            warn $self->dump_R;
436                    } elsif ( $c =~ m/^e/i ) {
437                            $a = $v if defined($v);
438                            my $to = shift @v;
439                            $to = $a + 32 if ( ! $to || $to <= $a );
440                            $to = 0xffff if ( $to > 0xffff );
441                            my $lines = int( ($to - $a + 8) / 8 );
442                            printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
443                            while ( --$lines ) {
444                                    print $self->hexdump( $a );
445                                    $a += 8;
446                            }
447                            $last = '+';
448                            $show_R = 0;
449                    } elsif ( $c =~ m/^\+/ ) {
450                            $a += 8;
451                            $show_R = 0;
452                    } elsif ( $c =~ m/^\-/ ) {
453                            $a -= 8;
454                            $show_R = 0;
455                    } elsif ( $c =~ m/^m/i ) {
456                            $a = $v if defined($v);
457                            $self->poke_code( $a, @v );
458                            printf "poke %d bytes at %04x\n", $#v + 1, $a;
459                            $last = '+';
460                            $show_R = 0;
461                    } elsif ( $c =~ m/^l/i ) {
462                            my $to = shift @v || 0x1000;
463                            $a = $to;
464                            $self->load_oraoemu( $v, $a );
465                            $last = '';
466                    } elsif ( $c =~ m/^s/i ) {
467                            $self->save_dump( $v || 'mem.dump', @v );
468                            $last = '';
469                    } elsif ( $c =~ m/^r/i ) {
470                            $run_for = $v || 1;
471                            print "run_for $run_for instructions\n";
472                            $show_R = 1;
473                            last;
474                    } elsif ( $c =~ m/^(u|j)/ ) {
475                            my $to = $v || $a;
476                            printf "set pc to %04x\n", $to;
477                            $PC = $to;      # remember for restart
478                            $run_for = 1;
479                            $last = "r $run_for";
480                            $show_R = 1;
481                            last;
482                    } elsif ( $c =~ m/^t/ ) {
483                            $self->trace( not $self->trace );
484                            print "trace ", $self->trace ? 'on' : 'off', "\n";
485                            $last = '';
486                    } elsif ( $c =~ m/^d/ ) {
487                            $self->debug( not $self->debug );
488                            print "debug ", $self->debug ? 'on' : 'off', "\n";
489                            $last = '';
490                    } else {
491                            warn "# ignored $line\n" if ($line);
492                            $last = '';
493                    }
494            }
495    
496    }
497    
498  =head1 AUTHOR  =head1 AUTHOR
499    
Legend:
Removed from v.32  
changed lines
  Added in v.78
  ViewVC Help
Powered by ViewVC 1.1.26