/[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 82 by dpavlin, Wed Aug 1 21:40:17 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(run_for));
16    
17  =head1 NAME  =head1 NAME
18    
# 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  =head2 boot
43    
44    Start emulator, open L<Screen>, load initial ROM images, and render memory
45    
46      my $orao = Orao->new({});
47      $orao->boot;
48    
49  =cut  =cut
50    
51  our $orao;  our $orao;
52    
53  sub init {  select(STDERR); $| = 1;
54    
55    sub boot {
56          my $self = shift;          my $self = shift;
57          warn "Orao calling upstream init\n";          warn "Orao calling upstream init\n";
58          $self->SUPER::init( $self, @_ );          $self->SUPER::init( $self, @_ );
59    
60          warn "staring Orao $Orao::VERSION emulation\n";          warn "Orao $Orao::VERSION emulation starting\n";
61    
62          $self->open_screen;          $self->open_screen;
63          $self->load_rom({          $self->load_rom({
64                  0x1000 => 'dump/SCRINV.BIN',                  0x1000 => 'dump/SCRINV.BIN',
65                    # should be 0x6000, but oraoemu has 2 byte prefix
66                    0x5FFE => 'dump/screen.dmp',
67                  0xC000 => 'rom/BAS12.ROM',                  0xC000 => 'rom/BAS12.ROM',
68                  0xE000 => 'rom/CRT12.ROM',                  0xE000 => 'rom/CRT12.ROM',
69          });          });
70    
71          $self->load_oraoemu( 'dump/orao-1.2' );  #       $PC = 0xDD11;   # BC
72          $self->load_oraoemu( 'dump/SCRINV.BIN' );  #       $PC = 0xC274;   # MC
73          $PC = 0x1000;  
74            $PC = 0xff89;
75    
76          $orao = $self;          $orao = $self;
77    
78  #       $self->prompt( 0x1000 );  #       $self->prompt( 0x1000 );
79    
80          warn "rendering memory map\n";          my ( $trace, $debug ) = ( $self->trace, $self->debug );
81            $self->trace( 0 );
82            $self->debug( 0 );
83    
84            $self->render( @mem[ 0x6000 .. 0x7fff ] );
85    
86            if ( $self->show_mem ) {
87    
88                    warn "rendering memory map\n";
89    
90                    $self->render_mem( @mem );
91    
92                    my @mmap = (
93                            0x0000, 0x03FF, 'nulti blok',
94                            0x0400, 0x5FFF, 'korisnički RAM (23K)',
95                            0x6000, 0x7FFF, 'video RAM',
96                            0x8000, 0x9FFF, 'sistemske lokacije',
97                            0xA000, 0xAFFF, 'ekstenzija',
98                            0xB000, 0xBFFF, 'DOS',
99                            0xC000, 0xDFFF, 'BASIC ROM',
100                            0xE000, 0xFFFF, 'sistemski ROM',
101                    );
102    
103            } else {
104    
105                    warn "rendering video memory\n";
106                    $self->render( @mem[ 0x6000 .. 0x7fff ] );
107            
108            }
109            $self->sync;
110            $self->trace( $trace );
111            $self->debug( $debug );
112    
113          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',  
         );  
114    
115          foreach my $i ( 0 .. $#mmap / 3 ) {          warn "Orao boot finished",
116                  my $o = $i * 3;                  $self->trace ? ' trace' : '',
117                  my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];                  $self->debug ? ' debug' : '',
118                  printf "%04x - %04x - %s\n", $from, $to, $desc;                  "\n";
                 for my $a ( $from .. $to ) {  
                         $orao->read( $a );  
                 }  
                 $self->sync;  
         }  
119    
120          warn "Orao init finished\n";          M6502::reset();
121    
122            warn dump( M6502->run );
123  }  }
124    
125  =head2 load_rom  =head2 load_rom
# Line 107  sub load_rom { Line 141  sub load_rom {
141          }          }
142  }  }
143    
144    # write chunk directly into memory, updateing vram if needed
145    sub _write_chunk {
146            my $self = shift;
147            my ( $addr, $chunk ) = @_;
148            $self->write_chunk( $addr, $chunk );
149            my $end = $addr + length($chunk);
150            my ( $f, $t ) = ( 0x6000, 0x7fff );
151    
152            if ( $end < $f || $addr >= $t ) {
153                    warn "skip vram update\n";
154                    return;
155            };
156    
157            $f = $addr if ( $addr > $f );
158            $t = $end if ( $end < $t );
159    
160            warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
161    #       foreach my $a ( $f .. $t ) {
162    #               $self->vram( $a - 0x6000 , $mem[ $a ] );
163    #       }
164            $self->render( @mem[ 0x6000 .. 0x7fff ] );
165            $self->render_mem( @mem ) if $self->show_mem;
166    }
167    
168  =head2 load_oraoemu  =head2 load_oraoemu
169    
170    Load binary files, ROM images and Orao Emulator files
171    
172      $orao->load_oraoemu( '/path/to/file', 0x1000 );
173    
174    Returns true on success.
175    
176  =cut  =cut
177    
178  sub load_oraoemu {  sub load_oraoemu {
179          my $self = shift;          my $self = shift;
180          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
181    
182            if ( ! -e $path ) {
183                    warn "ERROR: file $path doesn't exist\n";
184                    return;
185            }
186    
187          my $size = -s $path || confess "no size for $path: $!";          my $size = -s $path || confess "no size for $path: $!";
188    
189          my $buff = read_file( $path );          my $buff = read_file( $path );
# Line 123  sub load_oraoemu { Line 191  sub load_oraoemu {
191          if ( $size == 65538 ) {          if ( $size == 65538 ) {
192                  $addr = 0;                  $addr = 0;
193                  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;
194                  $self->write_chunk( $addr, substr($buff,2) );                  $self->_write_chunk( $addr, substr($buff,2) );
195                  return;                  return 1;
196          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
197                  $addr = 0;                  $addr = 0;
198                  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;
199                  #$self->write_chunk( $addr, substr($buff,0x20) );                  $self->_write_chunk( $addr, substr($buff,0x20) );
200                  $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );                  return 1;
                 return;  
201          }          }
202          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;
203          return $self->poke_code( $addr, map { ord($_) } split(//,$buff) );          $self->_write_chunk( $addr, $buff );
204          return $self->write_chunk( $addr, $buff );          return 1;
205    
206          my $chunk;          my $chunk;
207    
# Line 150  sub load_oraoemu { Line 217  sub load_oraoemu {
217                  $pos += 4;                  $pos += 4;
218          }          }
219    
220          $self->write_chunk( $addr, $chunk );          $self->_write_chunk( $addr, $chunk );
221    
222            return 1;
223  };  };
224    
225  =head2 save_dump  =head2 save_dump
# Line 188  sub hexdump { Line 256  sub hexdump {
256          return sprintf(" %04x %s\n", $a,          return sprintf(" %04x %s\n", $a,
257                  join(" ",                  join(" ",
258                          map {                          map {
259                                  sprintf( "%02x", $_ )                                  if ( defined($_) ) {
260                          } $self->ram( $a, $a+8 )                                          sprintf( "%02x", $_ )
261                                    } else {
262                                            '  '
263                                    }
264                            } @mem[ $a .. $a+8 ]
265                  )                  )
266          );          );
267  }  }
268    
 =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;  
 }  
   
269  =head1 Memory management  =head1 Memory management
270    
271  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 285  sub read {
285          my $self = shift;          my $self = shift;
286          my ($addr) = @_;          my ($addr) = @_;
287          my $byte = $mem[$addr];          my $byte = $mem[$addr];
288          warn "# Orao::read(",dump(@_),") = ",dump( $byte ),"\n" if $self->debug;          warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
289    
290            # keyboard
291    
292            if ( first { $addr == $_ } @kbd_ports ) {
293                    warn sprintf("keyboard port: %04x\n",$addr);
294            } elsif ( $addr == 0x87fc ) {
295                    warn "0x87fc - arrows/back\n";
296    =for pascal
297                    if VKey=VK_RIGHT then Result:=16;
298                    if VKey=VK_DOWN then Result:=128;
299                    if VKey=VK_UP then Result:=192;
300                    if VKey=VK_LEFT then Result:=224;
301                    if Ord(KeyPressed)=VK_BACK then Result:=224;
302    =cut
303            } elsif ( $addr == 0x87fd ) {
304                    warn "0x87fd - enter\n";
305    =for pascal
306        if KeyPressed=Chr(13) then begin
307          Mem[$FC]:=13;
308          Result:=0;
309        end;
310    =cut
311            } elsif ( $addr == 0x87fa ) {
312                    warn "0x87fa = F1 - F4\n";
313    =for pascal
314        if VKey=VK_F4 then Result:=16;
315        if VKey=VK_F3 then Result:=128;
316        if VKey=VK_F2 then Result:=192;
317        if VKey=VK_F1 then Result:=224;
318    =cut
319            } elsif ( $addr == 0x87fb ) {
320                    warn "0x87fb\n";
321    =for pascal
322        if KeyPressed=Chr(32) then Result:=32;
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 KeyPressed='#' then Result:=16;
332        if KeyPressed='+' then Result:=16;
333        if KeyPressed='*' then Result:=16;
334        if KeyPressed='?' then Result:=16;
335        if KeyPressed='<' then Result:=16;
336        if KeyPressed='>' then Result:=16;
337        if VKey=191 then Result:=16;
338    =cut
339            }
340    
341          $self->mmap_pixel( $addr, 0, $byte, 0 );          $self->mmap_pixel( $addr, 0, $byte, 0 );
342          return $byte;          return $byte;
343  }  }
# Line 248  Write into emory Line 352  Write into emory
352    
353  sub write {  sub write {
354          my $self = shift;          my $self = shift;
         warn "# Orao::write(",dump(@_),")\n" if $self->debug;  
355          my ($addr,$byte) = @_;          my ($addr,$byte) = @_;
356            warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
357    
358          if ( $addr >= 0x6000 && $addr < 0x8000 ) {          if ( $addr >= 0x6000 && $addr < 0x8000 ) {
359                  $self->vram( $addr - 0x6000 , $byte );                  $self->vram( $addr - 0x6000 , $byte );
360          }          }
361    
         if ( $addr > 0xafff ) {  
                 warn sprintf "access to %04x above affff aborting\n", $addr;  
                 return -1;  
         }  
362          if ( $addr == 0x8800 ) {          if ( $addr == 0x8800 ) {
363                  warn sprintf "sound ignored: %x\n", $byte;                  warn sprintf "sound ignored: %x\n", $byte;
364          }          }
365    
366            if ( $addr > 0xafff ) {
367                    warn sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
368                    return;
369            }
370    
371          $self->mmap_pixel( $addr, $byte, 0, 0 );          $self->mmap_pixel( $addr, $byte, 0, 0 );
372    
373          $mem[$addr] = $byte;          $mem[$addr] = $byte;
374            return;
375  }  }
376    
377    =head1 Command Line
378    
379    Command-line debugging intrerface is implemented for communication with
380    emulated device
381    
382    =head2 prompt
383    
384      my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
385    
386    =cut
387    
388    my $last = 'r 1';
389    
390    sub prompt {
391            my $self = shift;
392            $self->app->sync;
393            my $a = shift;
394            print STDERR $self->hexdump( $a ),
395                    $last ? "[$last] " : '',
396                    "> ";
397            my $in = <STDIN>;
398            chomp($in);
399            warn "## prompt got: $in\n" if $self->debug;
400            $in ||= $last;
401            $last = $in;
402            return ( $in, split(/\s+/, $in) ) if $in;
403    }
404    
405    =head2 cli
406    
407      $orao->cli();
408    
409    =cut
410    
411    my $show_R = 0;
412    
413    sub cli {
414            my $self = shift;
415            my $a = $PC || confess "no pc?";
416            warn $self->dump_R() if $show_R;
417            while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
418                    my $c = shift @v;
419                    next unless defined($c);
420                    my $v = shift @v;
421                    $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
422                    @v = map { hex($_) } @v;
423                    printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
424                    if ( $c =~ m/^[qx]/i ) {
425                            exit;
426                    } elsif ( $c eq '?' ) {
427                            my $t = $self->trace ? 'on' : 'off' ;
428                            my $d = $self->debug ? 'on' : 'off' ;
429                            warn <<__USAGE__;
430    Usage:
431    
432    x|q\t\texit
433    e 6000 6010\tdump memory, +/- to walk forward/backward
434    m 1000 ff 00\tput ff 00 on 1000
435    j|u 1000\t\tjump (change pc)
436    r 42\t\trun 42 instruction opcodes
437    t\t\ttrace [$t]
438    d\t\tdebug [$d]
439    
440    __USAGE__
441                            warn $self->dump_R;
442                    } elsif ( $c =~ m/^e/i ) {
443                            $a = $v if defined($v);
444                            my $to = shift @v;
445                            $to = $a + 32 if ( ! $to || $to <= $a );
446                            $to = 0xffff if ( $to > 0xffff );
447                            my $lines = int( ($to - $a + 8) / 8 );
448                            printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
449                            while ( --$lines ) {
450                                    print $self->hexdump( $a );
451                                    $a += 8;
452                            }
453                            $last = '+';
454                            $show_R = 0;
455                    } elsif ( $c =~ m/^\+/ ) {
456                            $a += 8;
457                            $show_R = 0;
458                    } elsif ( $c =~ m/^\-/ ) {
459                            $a -= 8;
460                            $show_R = 0;
461                    } elsif ( $c =~ m/^m/i ) {
462                            $a = $v if defined($v);
463                            $self->poke_code( $a, @v );
464                            printf "poke %d bytes at %04x\n", $#v + 1, $a;
465                            $last = '+';
466                            $show_R = 0;
467                    } elsif ( $c =~ m/^l/i ) {
468                            my $to = shift @v || 0x1000;
469                            $a = $to;
470                            $self->load_oraoemu( $v, $a );
471                            $last = '';
472                    } elsif ( $c =~ m/^s/i ) {
473                            $self->save_dump( $v || 'mem.dump', @v );
474                            $last = '';
475                    } elsif ( $c =~ m/^r/i ) {
476                            $run_for = $v || 1;
477                            print "run_for $run_for instructions\n";
478                            $show_R = 1;
479                            last;
480                    } elsif ( $c =~ m/^(u|j)/ ) {
481                            my $to = $v || $a;
482                            printf "set pc to %04x\n", $to;
483                            $PC = $to;      # remember for restart
484                            $run_for = 1;
485                            $last = "r $run_for";
486                            $show_R = 1;
487                            last;
488                    } elsif ( $c =~ m/^t/ ) {
489                            $self->trace( not $self->trace );
490                            print "trace ", $self->trace ? 'on' : 'off', "\n";
491                            $last = '';
492                    } elsif ( $c =~ m/^d/ ) {
493                            $self->debug( not $self->debug );
494                            print "debug ", $self->debug ? 'on' : 'off', "\n";
495                            $last = '';
496                    } else {
497                            warn "# ignored $line\n" if ($line);
498                            $last = '';
499                    }
500            }
501    
502    }
503    
504  =head1 AUTHOR  =head1 AUTHOR
505    
Legend:
Removed from v.35  
changed lines
  Added in v.82
  ViewVC Help
Powered by ViewVC 1.1.26