/[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 29 by dpavlin, Mon Jul 30 17:32:41 2007 UTC revision 90 by dpavlin, Thu Aug 2 12:23:18 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 List::Util qw/first/;
12    use M6502;
13    
14  use base qw(Class::Accessor M6502);  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 17  Orao - Orao emulator Line 20  Orao - Orao emulator
20    
21  =head1 VERSION  =head1 VERSION
22    
23  Version 0.02  Version 0.03
24    
25  =cut  =cut
26    
27  our $VERSION = '0.02';  our $VERSION = '0.03';
28    
29  =head1 SUMMARY  =head1 SUMMARY
30    
# Line 29  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 $loaded_files = {  my @kbd_ports = (
36          0xC000 => 'rom/BAS12.ROM',      0x87FC,0x87FD,0x87FA,0x87FB,0x87F6,0x87F7,
37          0xE000 => 'rom/CRT12.ROM',      0x87EE,0x87EF,0x87DE,0x87DF,0x87BE,0x87BF,
38  };      0x877E,0x877F,0x86FE,0x86FF,0x85FE,0x85FF,
39        0x83FE,0x83FF,
40    );
41    
42    =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
50    
51    our $orao;
52    
53    select(STDERR); $| = 1;
54    
55    sub boot {
56            my $self = shift;
57            warn "Orao calling upstream init\n";
58            $self->SUPER::init(
59                    read => sub { $self->read( @_ ) },
60                    write => sub { $self->write( @_ ) },
61            );
62    
63            warn "Orao $Orao::VERSION emulation starting\n";
64    
65            warn "emulating ", $#mem, " bytes of memory\n";
66    
67            $self->open_screen;
68            $self->load_rom({
69                    0x1000 => 'dump/SCRINV.BIN',
70                    # should be 0x6000, but oraoemu has 2 byte prefix
71                    0x5FFE => 'dump/screen.dmp',
72                    0xC000 => 'rom/BAS12.ROM',
73                    0xE000 => 'rom/CRT12.ROM',
74            });
75    
76    #       $PC = 0xDD11;   # BC
77    #       $PC = 0xC274;   # MC
78    
79            $PC = 0xff89;
80    
81            $orao = $self;
82    
83    #       $self->prompt( 0x1000 );
84    
85            my ( $trace, $debug ) = ( $self->trace, $self->debug );
86            $self->trace( 0 );
87            $self->debug( 0 );
88    
89            $self->render( @mem[ 0x6000 .. 0x7fff ] );
90    
91            if ( $self->show_mem ) {
92    
93                    warn "rendering memory map\n";
94    
95                    $self->render_mem( @mem );
96    
97                    my @mmap = (
98                            0x0000, 0x03FF, 'nulti blok',
99                            0x0400, 0x5FFF, 'korisnički RAM (23K)',
100                            0x6000, 0x7FFF, 'video RAM',
101                            0x8000, 0x9FFF, 'sistemske lokacije',
102                            0xA000, 0xAFFF, 'ekstenzija',
103                            0xB000, 0xBFFF, 'DOS',
104                            0xC000, 0xDFFF, 'BASIC ROM',
105                            0xE000, 0xFFFF, 'sistemski ROM',
106                    );
107    
108            } else {
109    
110                    warn "rendering video memory\n";
111                    $self->render( @mem[ 0x6000 .. 0x7fff ] );
112            
113            }
114            $self->sync;
115            $self->trace( $trace );
116            $self->debug( $debug );
117    
118            #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
119    
120            warn "Orao boot finished",
121                    $self->trace ? ' trace' : '',
122                    $self->debug ? ' debug' : '',
123                    "\n";
124    
125            M6502::reset();
126    
127    }
128    
129  =head2 load_rom  =head2 load_rom
130    
# Line 43  called to init memory and load initial r Line 135  called to init memory and load initial r
135  =cut  =cut
136    
137  sub load_rom {  sub load_rom {
138      my ($self) = @_;      my ($self, $loaded_files) = @_;
139    
140      #my $time_base = time();      #my $time_base = time();
141    
142          foreach my $addr ( sort keys %$loaded_files ) {          foreach my $addr ( sort keys %$loaded_files ) {
143                  my $path = $loaded_files->{$addr};                  my $path = $loaded_files->{$addr};
                 printf "loading '%s' at %04x\n", $path, $addr;  
144                  $self->load_oraoemu( $path, $addr );                  $self->load_oraoemu( $path, $addr );
145          }          }
146  }  }
147    
148    # write chunk directly into memory, updateing vram if needed
149    sub _write_chunk {
150            my $self = shift;
151            my ( $addr, $chunk ) = @_;
152            $self->write_chunk( $addr, $chunk );
153            my $end = $addr + length($chunk);
154            my ( $f, $t ) = ( 0x6000, 0x7fff );
155    
156            if ( $end < $f || $addr >= $t ) {
157                    warn "skip vram update\n";
158                    return;
159            };
160    
161            $f = $addr if ( $addr > $f );
162            $t = $end if ( $end < $t );
163    
164            warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
165    #       foreach my $a ( $f .. $t ) {
166    #               $self->vram( $a - 0x6000 , $mem[ $a ] );
167    #       }
168            $self->render( @mem[ 0x6000 .. 0x7fff ] );
169            $self->render_mem( @mem ) if $self->show_mem;
170    }
171    
172  =head2 load_oraoemu  =head2 load_oraoemu
173    
174    Load binary files, ROM images and Orao Emulator files
175    
176      $orao->load_oraoemu( '/path/to/file', 0x1000 );
177    
178    Returns true on success.
179    
180  =cut  =cut
181    
182  sub load_oraoemu {  sub load_oraoemu {
183          my $self = shift;          my $self = shift;
184          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
185    
186          my $size = -s $path || die "no size for $path: $!";          if ( ! -e $path ) {
187                    warn "ERROR: file $path doesn't exist\n";
188                    return;
189            }
190    
191            my $size = -s $path || confess "no size for $path: $!";
192    
193          my $buff = read_file( $path );          my $buff = read_file( $path );
194    
195          if ( $size == 65538 ) {          if ( $size == 65538 ) {
196                  $addr = 0;                  $addr = 0;
197                  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;
198                  $self->write_chunk( $addr, substr($buff,2) );                  $self->_write_chunk( $addr, substr($buff,2) );
199                  return;                  return 1;
200          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
201                  $addr = 0;                  $addr = 0;
202                  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;
203                  #$self->write_chunk( $addr, substr($buff,0x20) );                  $self->_write_chunk( $addr, substr($buff,0x20) );
204                  $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );                  return 1;
                 return;  
205          }          }
206          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;
207          return $self->write_chunk( $addr, $buff );          $self->_write_chunk( $addr, $buff );
208            return 1;
209    
210          my $chunk;          my $chunk;
211    
# Line 96  sub load_oraoemu { Line 221  sub load_oraoemu {
221                  $pos += 4;                  $pos += 4;
222          }          }
223    
224          $self->write_chunk( $addr, $chunk );          $self->_write_chunk( $addr, $chunk );
225    
226            return 1;
227  };  };
228    
229  =head2 save_dump  =head2 save_dump
# Line 119  sub save_dump { Line 245  sub save_dump {
245          close($fh);          close($fh);
246    
247          my $size = -s $path;          my $size = -s $path;
248          printf "saved %s %d %x bytes\n", $path, $size, $size;          warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
249  }  }
250    
251  =head2 hexdump  =head2 hexdump
# Line 134  sub hexdump { Line 260  sub hexdump {
260          return sprintf(" %04x %s\n", $a,          return sprintf(" %04x %s\n", $a,
261                  join(" ",                  join(" ",
262                          map {                          map {
263                                  sprintf( "%02x", $_ )                                  if ( defined($_) ) {
264                          } $self->ram( $a, $a+8 )                                          sprintf( "%02x", $_ )
265                                    } else {
266                                            '  '
267                                    }
268                            } @mem[ $a .. $a+8 ]
269                  )                  )
270          );          );
271  }  }
272    
273    =head1 Memory management
274    
275    Orao implements all I/O using mmap addresses. This was main reason why
276    L<Acme::6502> was just too slow to handle it.
277    
278    =cut
279    
280    =head2 read
281    
282    Read from memory
283    
284      $byte = read( $address );
285    
286    =cut
287    
288    sub read {
289            my $self = shift;
290            my ($addr) = @_;
291            my $byte = $mem[$addr];
292            confess sprintf("can't find memory at address %04x",$addr) unless defined($byte);
293            warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
294    
295            # keyboard
296    
297            if ( first { $addr == $_ } @kbd_ports ) {
298                    warn sprintf("keyboard port: %04x\n",$addr);
299            } elsif ( $addr == 0x87fc ) {
300                    warn "0x87fc - arrows/back\n";
301    =for pascal
302                    if VKey=VK_RIGHT then Result:=16;
303                    if VKey=VK_DOWN then Result:=128;
304                    if VKey=VK_UP then Result:=192;
305                    if VKey=VK_LEFT then Result:=224;
306                    if Ord(KeyPressed)=VK_BACK then Result:=224;
307    =cut
308            } elsif ( $addr == 0x87fd ) {
309                    warn "0x87fd - enter\n";
310    =for pascal
311        if KeyPressed=Chr(13) then begin
312          Mem[$FC]:=13;
313          Result:=0;
314        end;
315    =cut
316            } elsif ( $addr == 0x87fa ) {
317                    warn "0x87fa = F1 - F4\n";
318    =for pascal
319        if VKey=VK_F4 then Result:=16;
320        if VKey=VK_F3 then Result:=128;
321        if VKey=VK_F2 then Result:=192;
322        if VKey=VK_F1 then Result:=224;
323    =cut
324            } elsif ( $addr == 0x87fb ) {
325                    warn "0x87fb\n";
326    =for pascal
327        if KeyPressed=Chr(32) then Result:=32;
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 KeyPressed='+' then Result:=16;
338        if KeyPressed='*' then Result:=16;
339        if KeyPressed='?' then Result:=16;
340        if KeyPressed='<' then Result:=16;
341        if KeyPressed='>' then Result:=16;
342        if VKey=191 then Result:=16;
343    =cut
344            }
345    
346            $self->mmap_pixel( $addr, 0, $byte, 0 );
347            return $byte;
348    }
349    
350    =head2 write
351    
352    Write into emory
353    
354      write( $address, $byte );
355    
356    =cut
357    
358    sub write {
359            my $self = shift;
360            my ($addr,$byte) = @_;
361            warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
362    
363            if ( $addr >= 0x6000 && $addr < 0x8000 ) {
364                    $self->vram( $addr - 0x6000 , $byte );
365            }
366    
367            if ( $addr == 0x8800 ) {
368                    warn sprintf "sound ignored: %x\n", $byte;
369            }
370    
371            if ( $addr > 0xafff ) {
372                    confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
373            }
374    
375            $self->mmap_pixel( $addr, $byte, 0, 0 );
376    
377            $mem[$addr] = $byte;
378            return;
379    }
380    
381    =head1 Command Line
382    
383    Command-line debugging intrerface is implemented for communication with
384    emulated device
385    
386  =head2 prompt  =head2 prompt
387    
388    $orao->prompt( $address, $last_command );    my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
389    
390  =cut  =cut
391    
392    my $last = 'r 1';
393    
394  sub prompt {  sub prompt {
395          my $self = shift;          my $self = shift;
396            $self->app->sync;
397          my $a = shift;          my $a = shift;
398          my $last = shift;          print STDERR $self->hexdump( $a ),
         print $self->hexdump( $a ),  
399                  $last ? "[$last] " : '',                  $last ? "[$last] " : '',
400                  "> ";                  "> ";
401          my $in = <STDIN>;          my $in = <STDIN>;
402          chomp($in);          chomp($in);
403            warn "## prompt got: $in\n" if $self->debug;
404          $in ||= $last;          $in ||= $last;
405          $last = $in;          $last = $in;
406          return split(/\s+/, $in) if $in;          return ( $in, split(/\s+/, $in) ) if $in;
407    }
408    
409    =head2 cli
410    
411      $orao->cli();
412    
413    =cut
414    
415    my $show_R = 0;
416    
417    sub cli {
418            my $self = shift;
419            my $a = $PC || confess "no pc?";
420            warn $self->dump_R() if $show_R;
421            while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
422                    my $c = shift @v;
423                    next unless defined($c);
424                    my $v = shift @v;
425                    $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
426                    @v = map { hex($_) } @v;
427                    printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
428                    if ( $c =~ m/^[qx]/i ) {
429                            exit;
430                    } elsif ( $c eq '?' ) {
431                            my $t = $self->trace ? 'on' : 'off' ;
432                            my $d = $self->debug ? 'on' : 'off' ;
433                            warn <<__USAGE__;
434    Usage:
435    
436    x|q\t\texit
437    e 6000 6010\tdump memory, +/- to walk forward/backward
438    m 1000 ff 00\tput ff 00 on 1000
439    j|u 1000\t\tjump (change pc)
440    r 42\t\trun 42 instruction opcodes
441    t\t\ttrace [$t]
442    d\t\tdebug [$d]
443    
444    __USAGE__
445                            warn $self->dump_R;
446                    } elsif ( $c =~ m/^e/i ) {
447                            $a = $v if defined($v);
448                            my $to = shift @v;
449                            $to = $a + 32 if ( ! $to || $to <= $a );
450                            $to = 0xffff if ( $to > 0xffff );
451                            my $lines = int( ($to - $a + 8) / 8 );
452                            printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
453                            while ( --$lines ) {
454                                    print $self->hexdump( $a );
455                                    $a += 8;
456                            }
457                            $last = '+';
458                            $show_R = 0;
459                    } elsif ( $c =~ m/^\+/ ) {
460                            $a += 8;
461                            $show_R = 0;
462                    } elsif ( $c =~ m/^\-/ ) {
463                            $a -= 8;
464                            $show_R = 0;
465                    } elsif ( $c =~ m/^m/i ) {
466                            $a = $v if defined($v);
467                            $self->poke_code( $a, @v );
468                            printf "poke %d bytes at %04x\n", $#v + 1, $a;
469                            $last = '+';
470                            $show_R = 0;
471                    } elsif ( $c =~ m/^l/i ) {
472                            my $to = shift @v || 0x1000;
473                            $a = $to;
474                            $self->load_oraoemu( $v, $a );
475                            $last = '';
476                    } elsif ( $c =~ m/^s/i ) {
477                            $self->save_dump( $v || 'mem.dump', @v );
478                            $last = '';
479                    } elsif ( $c =~ m/^r/i ) {
480                            $run_for = $v || 1;
481                            print "run_for $run_for instructions\n";
482                            $show_R = 1;
483                            last;
484                    } elsif ( $c =~ m/^(u|j)/ ) {
485                            my $to = $v || $a;
486                            printf "set pc to %04x\n", $to;
487                            $PC = $to;      # remember for restart
488                            $run_for = 1;
489                            $last = "r $run_for";
490                            $show_R = 1;
491                            last;
492                    } elsif ( $c =~ m/^t/ ) {
493                            $self->trace( not $self->trace );
494                            print "trace ", $self->trace ? 'on' : 'off', "\n";
495                            $last = '';
496                    } elsif ( $c =~ m/^d/ ) {
497                            $self->debug( not $self->debug );
498                            print "debug ", $self->debug ? 'on' : 'off', "\n";
499                            $last = '';
500                    } else {
501                            warn "# ignored $line\n" if ($line);
502                            $last = '';
503                    }
504            }
505    
506  }  }
507    
508  =head1 AUTHOR  =head1 AUTHOR
Legend:
Removed from v.29  
changed lines
  Added in v.90
  ViewVC Help
Powered by ViewVC 1.1.26