/[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 35 by dpavlin, Mon Jul 30 21:53:04 2007 UTC revision 97 by dpavlin, Thu Aug 2 14:07:52 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));
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 ) {  
                         $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->show_mem( 1 );
144    
145            $self->boot if ( ! $self->booted );
146            $self->loop;
147    };
148    
149    =head1 Helper functions
150    
151  =head2 load_rom  =head2 load_rom
152    
153  called to init memory and load initial rom images  called to init memory and load initial rom images
# Line 103  sub load_rom { Line 163  sub load_rom {
163    
164          foreach my $addr ( sort keys %$loaded_files ) {          foreach my $addr ( sort keys %$loaded_files ) {
165                  my $path = $loaded_files->{$addr};                  my $path = $loaded_files->{$addr};
166                  $self->load_oraoemu( $path, $addr );                  $self->load_image( $path, $addr );
167          }          }
168  }  }
169    
170    # write chunk directly into memory, updateing vram if needed
171    sub _write_chunk {
172            my $self = shift;
173            my ( $addr, $chunk ) = @_;
174            $self->write_chunk( $addr, $chunk );
175            my $end = $addr + length($chunk);
176            my ( $f, $t ) = ( 0x6000, 0x7fff );
177    
178  =head2 load_oraoemu          if ( $end < $f || $addr >= $t ) {
179                    warn "skip vram update\n";
180                    return;
181            };
182    
183            $f = $addr if ( $addr > $f );
184            $t = $end if ( $end < $t );
185    
186            warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
187    #       foreach my $a ( $f .. $t ) {
188    #               $self->vram( $a - 0x6000 , $mem[ $a ] );
189    #       }
190            $self->render( @mem[ 0x6000 .. 0x7fff ] );
191            $self->render_mem( @mem ) if $self->show_mem;
192    }
193    
194    =head2 load_image
195    
196    Load binary files, ROM images and Orao Emulator files
197    
198      $orao->load_image( '/path/to/file', 0x1000 );
199    
200    Returns true on success.
201    
202  =cut  =cut
203    
204  sub load_oraoemu {  sub load_image {
205          my $self = shift;          my $self = shift;
206          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
207    
208            if ( ! -e $path ) {
209                    warn "ERROR: file $path doesn't exist\n";
210                    return;
211            }
212    
213          my $size = -s $path || confess "no size for $path: $!";          my $size = -s $path || confess "no size for $path: $!";
214    
215          my $buff = read_file( $path );          my $buff = read_file( $path );
# Line 123  sub load_oraoemu { Line 217  sub load_oraoemu {
217          if ( $size == 65538 ) {          if ( $size == 65538 ) {
218                  $addr = 0;                  $addr = 0;
219                  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;
220                  $self->write_chunk( $addr, substr($buff,2) );                  $self->_write_chunk( $addr, substr($buff,2) );
221                  return;                  return 1;
222          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
223                  $addr = 0;                  $addr = 0;
224                  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;
225                  #$self->write_chunk( $addr, substr($buff,0x20) );                  $self->_write_chunk( $addr, substr($buff,0x20) );
226                  $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );                  return 1;
                 return;  
227          }          }
228          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;
229          return $self->poke_code( $addr, map { ord($_) } split(//,$buff) );          $self->_write_chunk( $addr, $buff );
230          return $self->write_chunk( $addr, $buff );          return 1;
231    
232          my $chunk;          my $chunk;
233    
# Line 150  sub load_oraoemu { Line 243  sub load_oraoemu {
243                  $pos += 4;                  $pos += 4;
244          }          }
245    
246          $self->write_chunk( $addr, $chunk );          $self->_write_chunk( $addr, $chunk );
247    
248            return 1;
249  };  };
250    
251  =head2 save_dump  =head2 save_dump
# Line 188  sub hexdump { Line 282  sub hexdump {
282          return sprintf(" %04x %s\n", $a,          return sprintf(" %04x %s\n", $a,
283                  join(" ",                  join(" ",
284                          map {                          map {
285                                  sprintf( "%02x", $_ )                                  if ( defined($_) ) {
286                          } $self->ram( $a, $a+8 )                                          sprintf( "%02x", $_ )
287                                    } else {
288                                            '  '
289                                    }
290                            } @mem[ $a .. $a+8 ]
291                  )                  )
292          );          );
293  }  }
294    
 =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;  
 }  
   
295  =head1 Memory management  =head1 Memory management
296    
297  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 233  sub read { Line 311  sub read {
311          my $self = shift;          my $self = shift;
312          my ($addr) = @_;          my ($addr) = @_;
313          my $byte = $mem[$addr];          my $byte = $mem[$addr];
314          warn "# Orao::read(",dump(@_),") = ",dump( $byte ),"\n" if $self->debug;          confess sprintf("can't find memory at address %04x",$addr) unless defined($byte);
315            warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
316    
317            # keyboard
318    
319            if ( first { $addr == $_ } @kbd_ports ) {
320                    warn sprintf("keyboard port: %04x\n",$addr) if $self->trace;
321            } elsif ( $addr == 0x87fc ) {
322                    warn "0x87fc - arrows/back\n";
323    =for pascal
324                    if VKey=VK_RIGHT then Result:=16;
325                    if VKey=VK_DOWN then Result:=128;
326                    if VKey=VK_UP then Result:=192;
327                    if VKey=VK_LEFT then Result:=224;
328                    if Ord(KeyPressed)=VK_BACK then Result:=224;
329    =cut
330            } elsif ( $addr == 0x87fd ) {
331                    warn "0x87fd - enter\n";
332    =for pascal
333        if KeyPressed=Chr(13) then begin
334          Mem[$FC]:=13;
335          Result:=0;
336        end;
337    =cut
338            } elsif ( $addr == 0x87fa ) {
339                    warn "0x87fa = F1 - F4\n";
340    =for pascal
341        if VKey=VK_F4 then Result:=16;
342        if VKey=VK_F3 then Result:=128;
343        if VKey=VK_F2 then Result:=192;
344        if VKey=VK_F1 then Result:=224;
345    =cut
346            } elsif ( $addr == 0x87fb ) {
347                    warn "0x87fb\n";
348    =for pascal
349        if KeyPressed=Chr(32) then Result:=32;
350        if KeyPressed='"' then Result:=16;
351        if KeyPressed='!' then Result:=16;
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 VKey=191 then Result:=16;
365    =cut
366            }
367    
368          $self->mmap_pixel( $addr, 0, $byte, 0 );          $self->mmap_pixel( $addr, 0, $byte, 0 );
369          return $byte;          return $byte;
370  }  }
# Line 248  Write into emory Line 379  Write into emory
379    
380  sub write {  sub write {
381          my $self = shift;          my $self = shift;
         warn "# Orao::write(",dump(@_),")\n" if $self->debug;  
382          my ($addr,$byte) = @_;          my ($addr,$byte) = @_;
383            warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
384    
385          if ( $addr >= 0x6000 && $addr < 0x8000 ) {          if ( $addr >= 0x6000 && $addr < 0x8000 ) {
386                  $self->vram( $addr - 0x6000 , $byte );                  $self->vram( $addr - 0x6000 , $byte );
387          }          }
388    
         if ( $addr > 0xafff ) {  
                 warn sprintf "access to %04x above affff aborting\n", $addr;  
                 return -1;  
         }  
389          if ( $addr == 0x8800 ) {          if ( $addr == 0x8800 ) {
390                  warn sprintf "sound ignored: %x\n", $byte;                  warn sprintf "sound ignored: %x\n", $byte;
391          }          }
392    
393            if ( $addr > 0xafff ) {
394                    confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
395            }
396    
397          $self->mmap_pixel( $addr, $byte, 0, 0 );          $self->mmap_pixel( $addr, $byte, 0, 0 );
398    
399          $mem[$addr] = $byte;          $mem[$addr] = $byte;
400            return;
401    }
402    
403    =head1 Command Line
404    
405    Command-line debugging intrerface is implemented for communication with
406    emulated device
407    
408    =head2 prompt
409    
410      my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
411    
412    =cut
413    
414    my $last = 'r 1';
415    
416    sub prompt {
417            my $self = shift;
418            $self->app->sync;
419            my $a = shift;
420            print $self->hexdump( $a ),
421                    $last ? "[$last] " : '',
422                    "> ";
423            my $in = <STDIN>;
424            chomp($in);
425            warn "## prompt got: $in\n" if $self->debug;
426            $in ||= $last;
427            $last = $in;
428            return ( $in, split(/\s+/, $in) ) if $in;
429  }  }
430    
431    =head2 cli
432    
433      $orao->cli();
434    
435    =cut
436    
437    my $show_R = 0;
438    
439    sub cli {
440            my $self = shift;
441            my $a = $PC || confess "no pc?";
442            my $run_for = 0;
443            warn $self->dump_R() if $show_R;
444            while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
445                    my $c = shift @v;
446                    next unless defined($c);
447                    my $v = shift @v;
448                    $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
449                    @v = map { hex($_) } @v;
450                    printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
451                    if ( $c =~ m/^[qx]/i ) {
452                            exit;
453                    } elsif ( $c eq '?' ) {
454                            my $t = $self->trace ? 'on' : 'off' ;
455                            my $d = $self->debug ? 'on' : 'off' ;
456                            warn <<__USAGE__;
457    Usage:
458    
459    x|q\t\texit
460    e 6000 6010\tdump memory, +/- to walk forward/backward
461    m 1000 ff 00\tput ff 00 on 1000
462    j|u 1000\t\tjump (change pc)
463    r 42\t\trun 42 instruction opcodes
464    t\t\ttrace [$t]
465    d\t\tdebug [$d]
466    
467    __USAGE__
468                            warn $self->dump_R;
469                            $last = '';
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            return $run_for;
531    }
532    
533  =head1 AUTHOR  =head1 AUTHOR
534    
Legend:
Removed from v.35  
changed lines
  Added in v.97
  ViewVC Help
Powered by ViewVC 1.1.26