/[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 36 by dpavlin, Mon Jul 30 22:06:13 2007 UTC revision 95 by dpavlin, Thu Aug 2 13:19:19 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;  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(booted run_for));
16    
17  =head1 NAME  =head1 NAME
18    
# Line 19  Orao - Orao emulator Line 20  Orao - Orao emulator
20    
21  =head1 VERSION  =head1 VERSION
22    
23  Version 0.02  Version 0.04
24    
25  =cut  =cut
26    
27  our $VERSION = '0.02';  our $VERSION = '0.04';
28    
29  =head1 SUMMARY  =head1 SUMMARY
30    
# Line 31  Emulator or Orao 8-bit 6502 machine popu Line 32  Emulator or Orao 8-bit 6502 machine popu
32    
33  =cut  =cut
34    
35  =head2 init  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  Start emulator  =head1 FUNCTIONS
43    
44    =head2 boot
45    
46    Start emulator, open L<Screen>, load initial ROM images, and render memory
47    
48      my $orao = Orao->new({});
49      $orao->boot;
50    
51  =cut  =cut
52    
53  our $orao;  our $orao;
54    
55  sub init {  select(STDERR); $| = 1;
56    
57    sub boot {
58          my $self = shift;          my $self = shift;
59          warn "Orao calling upstream init\n";          warn "Orao calling upstream init\n";
60          $self->SUPER::init( $self, @_ );          $self->SUPER::init(
61                    read => sub { $self->read( @_ ) },
62                    write => sub { $self->write( @_ ) },
63            );
64    
65            warn "Orao $Orao::VERSION emulation starting\n";
66    
67          warn "staring Orao $Orao::VERSION emulation\n";          warn "emulating ", $#mem, " bytes of memory\n";
68    
69          $self->open_screen;          $self->open_screen;
70          $self->load_rom({          $self->load_rom({
71                  0x1000 => 'dump/SCRINV.BIN',                  0x1000 => 'dump/SCRINV.BIN',
72                    # should be 0x6000, but oraoemu has 2 byte prefix
73                    0x5FFE => 'dump/screen.dmp',
74                  0xC000 => 'rom/BAS12.ROM',                  0xC000 => 'rom/BAS12.ROM',
75                  0xE000 => 'rom/CRT12.ROM',                  0xE000 => 'rom/CRT12.ROM',
76          });          });
77    
78          $self->load_oraoemu( 'dump/orao-1.2' );  #       $PC = 0xDD11;   # BC
79          $self->load_oraoemu( 'dump/SCRINV.BIN' );  #       $PC = 0xC274;   # MC
80          $PC = 0x1000;  
81            $PC = 0xff89;
82    
83          $orao = $self;          $orao = $self;
84    
85  #       $self->prompt( 0x1000 );  #       $self->prompt( 0x1000 );
86    
87          warn "rendering memory map\n";          my ( $trace, $debug ) = ( $self->trace, $self->debug );
88            $self->trace( 0 );
89            $self->debug( 0 );
90    
91            $self->render( @mem[ 0x6000 .. 0x7fff ] );
92    
93            if ( $self->show_mem ) {
94    
95                    warn "rendering memory map\n";
96    
97                    $self->render_mem( @mem );
98    
99                    my @mmap = (
100                            0x0000, 0x03FF, 'nulti blok',
101                            0x0400, 0x5FFF, 'korisnički RAM (23K)',
102                            0x6000, 0x7FFF, 'video RAM',
103                            0x8000, 0x9FFF, 'sistemske lokacije',
104                            0xA000, 0xAFFF, 'ekstenzija',
105                            0xB000, 0xBFFF, 'DOS',
106                            0xC000, 0xDFFF, 'BASIC ROM',
107                            0xE000, 0xFFFF, 'sistemski ROM',
108                    );
109    
110            } else {
111    
112                    warn "rendering video memory\n";
113                    $self->render( @mem[ 0x6000 .. 0x7fff ] );
114            
115            }
116            $self->sync;
117            $self->trace( $trace );
118            $self->debug( $debug );
119    
120          my @mmap = (          #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
                 0x0000, 0x03FF, 'nulti blok',  
                 0x0400, 0x5FFF, 'korisnički RAM (23K)',  
                 0x6000, 0x7FFF, 'video RAM',  
                 0x8000, 0x9FFF, 'sistemske lokacije',  
                 0xA000, 0xAFFF, 'ekstenzija',  
                 0xB000, 0xBFFF, 'DOS',  
                 0xC000, 0xDFFF, 'BASIC ROM',  
                 0xE000, 0xFFFF, 'sistemski ROM',  
         );  
121    
122          foreach my $i ( 0 .. $#mmap / 3 ) {          warn "Orao boot finished",
123                  my $o = $i * 3;                  $self->trace ? ' trace' : '',
124                  my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];                  $self->debug ? ' debug' : '',
125                  printf "%04x - %04x - %s\n", $from, $to, $desc;                  "\n";
                 for my $a ( $from .. $to ) {  
                         if ( $a >= 0x6000 && $a < 0x8000 ) {  
                                 my $b = $orao->read( $a );  
                                 $orao->vram( $a - 0x6000, $b );  
                         } else {  
                                 $orao->read( $a );  
                         }  
                 }  
                 $self->sync;  
         }  
126    
127          warn "Orao init finished\n";          M6502::reset();
128    
129            $self->booted( 1 );
130  }  }
131    
132    =head2 run
133    
134    Run interactive emulation loop
135    
136      $orao->run;
137    
138    =cut
139    
140    sub run {
141            my $self = shift;
142    
143            $self->boot if ( ! $self->booted );
144    
145            while ( 1 ) {
146                    $self->cli;
147                    M6502::exec($run_for);
148            }
149    };
150    
151    =head1 Helper functions
152    
153  =head2 load_rom  =head2 load_rom
154    
155  called to init memory and load initial rom images  called to init memory and load initial rom images
# Line 108  sub load_rom { Line 165  sub load_rom {
165    
166          foreach my $addr ( sort keys %$loaded_files ) {          foreach my $addr ( sort keys %$loaded_files ) {
167                  my $path = $loaded_files->{$addr};                  my $path = $loaded_files->{$addr};
168                  $self->load_oraoemu( $path, $addr );                  $self->load_image( $path, $addr );
169          }          }
170  }  }
171    
172    # write chunk directly into memory, updateing vram if needed
173    sub _write_chunk {
174            my $self = shift;
175            my ( $addr, $chunk ) = @_;
176            $self->write_chunk( $addr, $chunk );
177            my $end = $addr + length($chunk);
178            my ( $f, $t ) = ( 0x6000, 0x7fff );
179    
180            if ( $end < $f || $addr >= $t ) {
181                    warn "skip vram update\n";
182                    return;
183            };
184    
185            $f = $addr if ( $addr > $f );
186            $t = $end if ( $end < $t );
187    
188            warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
189    #       foreach my $a ( $f .. $t ) {
190    #               $self->vram( $a - 0x6000 , $mem[ $a ] );
191    #       }
192            $self->render( @mem[ 0x6000 .. 0x7fff ] );
193            $self->render_mem( @mem ) if $self->show_mem;
194    }
195    
196  =head2 load_oraoemu  =head2 load_image
197    
198    Load binary files, ROM images and Orao Emulator files
199    
200      $orao->load_image( '/path/to/file', 0x1000 );
201    
202    Returns true on success.
203    
204  =cut  =cut
205    
206  sub load_oraoemu {  sub load_image {
207          my $self = shift;          my $self = shift;
208          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
209    
210            if ( ! -e $path ) {
211                    warn "ERROR: file $path doesn't exist\n";
212                    return;
213            }
214    
215          my $size = -s $path || confess "no size for $path: $!";          my $size = -s $path || confess "no size for $path: $!";
216    
217          my $buff = read_file( $path );          my $buff = read_file( $path );
# Line 128  sub load_oraoemu { Line 219  sub load_oraoemu {
219          if ( $size == 65538 ) {          if ( $size == 65538 ) {
220                  $addr = 0;                  $addr = 0;
221                  warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;                  warn sprintf "loading oraoemu 64k dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
222                  $self->write_chunk( $addr, substr($buff,2) );                  $self->_write_chunk( $addr, substr($buff,2) );
223                  return;                  return 1;
224          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
225                  $addr = 0;                  $addr = 0;
226                  warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;                  warn sprintf "loading oraoemu 1.3 dump %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
227                  #$self->write_chunk( $addr, substr($buff,0x20) );                  $self->_write_chunk( $addr, substr($buff,0x20) );
228                  $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );                  return 1;
                 return;  
229          }          }
230          printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;          printf "loading %s at %04x - %04x %02x\n", $path, $addr, $addr+$size-1, $size;
231          return $self->poke_code( $addr, map { ord($_) } split(//,$buff) );          $self->_write_chunk( $addr, $buff );
232          return $self->write_chunk( $addr, $buff );          return 1;
233    
234          my $chunk;          my $chunk;
235    
# Line 155  sub load_oraoemu { Line 245  sub load_oraoemu {
245                  $pos += 4;                  $pos += 4;
246          }          }
247    
248          $self->write_chunk( $addr, $chunk );          $self->_write_chunk( $addr, $chunk );
249    
250            return 1;
251  };  };
252    
253  =head2 save_dump  =head2 save_dump
# Line 193  sub hexdump { Line 284  sub hexdump {
284          return sprintf(" %04x %s\n", $a,          return sprintf(" %04x %s\n", $a,
285                  join(" ",                  join(" ",
286                          map {                          map {
287                                  sprintf( "%02x", $_ )                                  if ( defined($_) ) {
288                          } $self->ram( $a, $a+8 )                                          sprintf( "%02x", $_ )
289                                    } else {
290                                            '  '
291                                    }
292                            } @mem[ $a .. $a+8 ]
293                  )                  )
294          );          );
295  }  }
296    
 =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;  
 }  
   
297  =head1 Memory management  =head1 Memory management
298    
299  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 238  sub read { Line 313  sub read {
313          my $self = shift;          my $self = shift;
314          my ($addr) = @_;          my ($addr) = @_;
315          my $byte = $mem[$addr];          my $byte = $mem[$addr];
316          warn "# Orao::read(",dump(@_),") = ",dump( $byte ),"\n" if $self->debug;          confess sprintf("can't find memory at address %04x",$addr) unless defined($byte);
317            warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
318    
319            # keyboard
320    
321            if ( first { $addr == $_ } @kbd_ports ) {
322                    warn sprintf("keyboard port: %04x\n",$addr);
323            } elsif ( $addr == 0x87fc ) {
324                    warn "0x87fc - arrows/back\n";
325    =for pascal
326                    if VKey=VK_RIGHT then Result:=16;
327                    if VKey=VK_DOWN then Result:=128;
328                    if VKey=VK_UP then Result:=192;
329                    if VKey=VK_LEFT then Result:=224;
330                    if Ord(KeyPressed)=VK_BACK then Result:=224;
331    =cut
332            } elsif ( $addr == 0x87fd ) {
333                    warn "0x87fd - enter\n";
334    =for pascal
335        if KeyPressed=Chr(13) then begin
336          Mem[$FC]:=13;
337          Result:=0;
338        end;
339    =cut
340            } elsif ( $addr == 0x87fa ) {
341                    warn "0x87fa = F1 - F4\n";
342    =for pascal
343        if VKey=VK_F4 then Result:=16;
344        if VKey=VK_F3 then Result:=128;
345        if VKey=VK_F2 then Result:=192;
346        if VKey=VK_F1 then Result:=224;
347    =cut
348            } elsif ( $addr == 0x87fb ) {
349                    warn "0x87fb\n";
350    =for pascal
351        if KeyPressed=Chr(32) then Result:=32;
352        if KeyPressed='"' then Result:=16;
353        if KeyPressed='!' then Result:=16;
354        if KeyPressed='$' then Result:=16;
355        if KeyPressed='%' then Result:=16;
356        if KeyPressed='&' then Result:=16;
357        if KeyPressed='(' then Result:=16;
358        if KeyPressed=')' then Result:=16;
359        if KeyPressed='=' then Result:=16;
360        if KeyPressed='#' then Result:=16;
361        if KeyPressed='+' then Result:=16;
362        if KeyPressed='*' then Result:=16;
363        if KeyPressed='?' then Result:=16;
364        if KeyPressed='<' then Result:=16;
365        if KeyPressed='>' then Result:=16;
366        if VKey=191 then Result:=16;
367    =cut
368            }
369    
370          $self->mmap_pixel( $addr, 0, $byte, 0 );          $self->mmap_pixel( $addr, 0, $byte, 0 );
371          return $byte;          return $byte;
372  }  }
# Line 253  Write into emory Line 381  Write into emory
381    
382  sub write {  sub write {
383          my $self = shift;          my $self = shift;
         warn "# Orao::write(",dump(@_),")\n" if $self->debug;  
384          my ($addr,$byte) = @_;          my ($addr,$byte) = @_;
385            warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
386    
387          if ( $addr >= 0x6000 && $addr < 0x8000 ) {          if ( $addr >= 0x6000 && $addr < 0x8000 ) {
388                  $self->vram( $addr - 0x6000 , $byte );                  $self->vram( $addr - 0x6000 , $byte );
389          }          }
390    
         if ( $addr > 0xafff ) {  
                 warn sprintf "access to %04x above affff aborting\n", $addr;  
                 return -1;  
         }  
391          if ( $addr == 0x8800 ) {          if ( $addr == 0x8800 ) {
392                  warn sprintf "sound ignored: %x\n", $byte;                  warn sprintf "sound ignored: %x\n", $byte;
393          }          }
394    
395            if ( $addr > 0xafff ) {
396                    confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
397            }
398    
399          $self->mmap_pixel( $addr, $byte, 0, 0 );          $self->mmap_pixel( $addr, $byte, 0, 0 );
400    
401          $mem[$addr] = $byte;          $mem[$addr] = $byte;
402          return;          return;
403  }  }
404    
405    =head1 Command Line
406    
407    Command-line debugging intrerface is implemented for communication with
408    emulated device
409    
410    =head2 prompt
411    
412      my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
413    
414    =cut
415    
416    my $last = 'r 1';
417    
418    sub prompt {
419            my $self = shift;
420            $self->app->sync;
421            my $a = shift;
422            print STDERR $self->hexdump( $a ),
423                    $last ? "[$last] " : '',
424                    "> ";
425            my $in = <STDIN>;
426            chomp($in);
427            warn "## prompt got: $in\n" if $self->debug;
428            $in ||= $last;
429            $last = $in;
430            return ( $in, split(/\s+/, $in) ) if $in;
431    }
432    
433    =head2 cli
434    
435      $orao->cli();
436    
437    =cut
438    
439    my $show_R = 0;
440    
441    sub cli {
442            my $self = shift;
443            my $a = $PC || confess "no pc?";
444            warn $self->dump_R() if $show_R;
445            while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
446                    my $c = shift @v;
447                    next unless defined($c);
448                    my $v = shift @v;
449                    $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
450                    @v = map { hex($_) } @v;
451                    printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
452                    if ( $c =~ m/^[qx]/i ) {
453                            exit;
454                    } elsif ( $c eq '?' ) {
455                            my $t = $self->trace ? 'on' : 'off' ;
456                            my $d = $self->debug ? 'on' : 'off' ;
457                            warn <<__USAGE__;
458    Usage:
459    
460    x|q\t\texit
461    e 6000 6010\tdump memory, +/- to walk forward/backward
462    m 1000 ff 00\tput ff 00 on 1000
463    j|u 1000\t\tjump (change pc)
464    r 42\t\trun 42 instruction opcodes
465    t\t\ttrace [$t]
466    d\t\tdebug [$d]
467    
468    __USAGE__
469                            warn $self->dump_R;
470                    } elsif ( $c =~ m/^e/i ) {
471                            $a = $v if defined($v);
472                            my $to = shift @v;
473                            $to = $a + 32 if ( ! $to || $to <= $a );
474                            $to = 0xffff if ( $to > 0xffff );
475                            my $lines = int( ($to - $a + 8) / 8 );
476                            printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
477                            while ( --$lines ) {
478                                    print $self->hexdump( $a );
479                                    $a += 8;
480                            }
481                            $last = '+';
482                            $show_R = 0;
483                    } elsif ( $c =~ m/^\+/ ) {
484                            $a += 8;
485                            $show_R = 0;
486                    } elsif ( $c =~ m/^\-/ ) {
487                            $a -= 8;
488                            $show_R = 0;
489                    } elsif ( $c =~ m/^m/i ) {
490                            $a = $v if defined($v);
491                            $self->poke_code( $a, @v );
492                            printf "poke %d bytes at %04x\n", $#v + 1, $a;
493                            $last = '+';
494                            $show_R = 0;
495                    } elsif ( $c =~ m/^l/i ) {
496                            my $to = shift @v || 0x1000;
497                            $a = $to;
498                            $self->load_image( $v, $a );
499                            $last = '';
500                    } elsif ( $c =~ m/^s/i ) {
501                            $self->save_dump( $v || 'mem.dump', @v );
502                            $last = '';
503                    } elsif ( $c =~ m/^r/i ) {
504                            $run_for = $v || 1;
505                            print "run_for $run_for instructions\n";
506                            $show_R = 1;
507                            last;
508                    } elsif ( $c =~ m/^(u|j)/ ) {
509                            my $to = $v || $a;
510                            printf "set pc to %04x\n", $to;
511                            $PC = $to;      # remember for restart
512                            $run_for = 1;
513                            $last = "r $run_for";
514                            $show_R = 1;
515                            last;
516                    } elsif ( $c =~ m/^t/ ) {
517                            $self->trace( not $self->trace );
518                            print "trace ", $self->trace ? 'on' : 'off', "\n";
519                            $last = '';
520                    } elsif ( $c =~ m/^d/ ) {
521                            $self->debug( not $self->debug );
522                            print "debug ", $self->debug ? 'on' : 'off', "\n";
523                            $last = '';
524                    } else {
525                            warn "# ignored $line\n" if ($line);
526                            $last = '';
527                    }
528            }
529    
530    }
531    
532  =head1 AUTHOR  =head1 AUTHOR
533    
Legend:
Removed from v.36  
changed lines
  Added in v.95
  ViewVC Help
Powered by ViewVC 1.1.26