/[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 30 by dpavlin, Mon Jul 30 17:56:13 2007 UTC revision 96 by dpavlin, Thu Aug 2 13:58:26 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 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 17  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 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  =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  sub init {  our $orao;
54    
55    select(STDERR); $| = 1;
56    
57    sub boot {
58          my $self = shift;          my $self = shift;
59          warn "call upstream init\n";          warn "Orao calling upstream init\n";
60          $self->SUPER::init( @_ );          $self->SUPER::init(
61                    read => sub { $self->read( @_ ) },
62                    write => sub { $self->write( @_ ) },
63            );
64    
65          warn "staring Orao $ORAO::VERSION emulation\n";          warn "Orao $Orao::VERSION emulation starting\n";
66    
67            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',
72                    # should be 0x6000, but oraoemu has 2 byte prefix
73                    0x5FFE => 'dump/screen.dmp',
74                    0xC000 => 'rom/BAS12.ROM',
75                    0xE000 => 'rom/CRT12.ROM',
76            });
77    
78    #       $PC = 0xDD11;   # BC
79    #       $PC = 0xC274;   # MC
80    
81            $PC = 0xff89;
82    
83            $orao = $self;
84    
85    #       $self->prompt( 0x1000 );
86    
87            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            #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
121    
122            warn "Orao boot finished",
123                    $self->trace ? ' trace' : '',
124                    $self->debug ? ' debug' : '',
125                    "\n";
126    
127            M6502::reset();
128    
129            $self->booted( 1 );
130  }  }
131    
132  my $loaded_files = {  =head2 run
133          0xC000 => 'rom/BAS12.ROM',  
134          0xE000 => 'rom/CRT12.ROM',  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            $self->loop;
145  };  };
146    
147    =head1 Helper functions
148    
149  =head2 load_rom  =head2 load_rom
150    
151  called to init memory and load initial rom images  called to init memory and load initial rom images
# Line 60  called to init memory and load initial r Line 155  called to init memory and load initial r
155  =cut  =cut
156    
157  sub load_rom {  sub load_rom {
158      my ($self) = @_;      my ($self, $loaded_files) = @_;
159    
160      #my $time_base = time();      #my $time_base = time();
161    
162          foreach my $addr ( sort keys %$loaded_files ) {          foreach my $addr ( sort keys %$loaded_files ) {
163                  my $path = $loaded_files->{$addr};                  my $path = $loaded_files->{$addr};
164                  printf "loading '%s' at %04x\n", $path, $addr;                  $self->load_image( $path, $addr );
                 $self->load_oraoemu( $path, $addr );  
165          }          }
166  }  }
167    
168    # write chunk directly into memory, updateing vram if needed
169    sub _write_chunk {
170            my $self = shift;
171            my ( $addr, $chunk ) = @_;
172            $self->write_chunk( $addr, $chunk );
173            my $end = $addr + length($chunk);
174            my ( $f, $t ) = ( 0x6000, 0x7fff );
175    
176            if ( $end < $f || $addr >= $t ) {
177                    warn "skip vram update\n";
178                    return;
179            };
180    
181  =head2 load_oraoemu          $f = $addr if ( $addr > $f );
182            $t = $end if ( $end < $t );
183    
184            warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
185    #       foreach my $a ( $f .. $t ) {
186    #               $self->vram( $a - 0x6000 , $mem[ $a ] );
187    #       }
188            $self->render( @mem[ 0x6000 .. 0x7fff ] );
189            $self->render_mem( @mem ) if $self->show_mem;
190    }
191    
192    =head2 load_image
193    
194    Load binary files, ROM images and Orao Emulator files
195    
196      $orao->load_image( '/path/to/file', 0x1000 );
197    
198    Returns true on success.
199    
200  =cut  =cut
201    
202  sub load_oraoemu {  sub load_image {
203          my $self = shift;          my $self = shift;
204          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
205    
206          my $size = -s $path || die "no size for $path: $!";          if ( ! -e $path ) {
207                    warn "ERROR: file $path doesn't exist\n";
208                    return;
209            }
210    
211            my $size = -s $path || confess "no size for $path: $!";
212    
213          my $buff = read_file( $path );          my $buff = read_file( $path );
214    
215          if ( $size == 65538 ) {          if ( $size == 65538 ) {
216                  $addr = 0;                  $addr = 0;
217                  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;
218                  $self->write_chunk( $addr, substr($buff,2) );                  $self->_write_chunk( $addr, substr($buff,2) );
219                  return;                  return 1;
220          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
221                  $addr = 0;                  $addr = 0;
222                  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;
223                  #$self->write_chunk( $addr, substr($buff,0x20) );                  $self->_write_chunk( $addr, substr($buff,0x20) );
224                  $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );                  return 1;
                 return;  
225          }          }
226          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;
227          return $self->write_chunk( $addr, $buff );          $self->_write_chunk( $addr, $buff );
228            return 1;
229    
230          my $chunk;          my $chunk;
231    
# Line 113  sub load_oraoemu { Line 241  sub load_oraoemu {
241                  $pos += 4;                  $pos += 4;
242          }          }
243    
244          $self->write_chunk( $addr, $chunk );          $self->_write_chunk( $addr, $chunk );
245    
246            return 1;
247  };  };
248    
249  =head2 save_dump  =head2 save_dump
# Line 136  sub save_dump { Line 265  sub save_dump {
265          close($fh);          close($fh);
266    
267          my $size = -s $path;          my $size = -s $path;
268          printf "saved %s %d %x bytes\n", $path, $size, $size;          warn sprintf "saved %s %d %x bytes\n", $path, $size, $size;
269  }  }
270    
271  =head2 hexdump  =head2 hexdump
# Line 151  sub hexdump { Line 280  sub hexdump {
280          return sprintf(" %04x %s\n", $a,          return sprintf(" %04x %s\n", $a,
281                  join(" ",                  join(" ",
282                          map {                          map {
283                                  sprintf( "%02x", $_ )                                  if ( defined($_) ) {
284                          } $self->ram( $a, $a+8 )                                          sprintf( "%02x", $_ )
285                                    } else {
286                                            '  '
287                                    }
288                            } @mem[ $a .. $a+8 ]
289                  )                  )
290          );          );
291  }  }
292    
293    =head1 Memory management
294    
295    Orao implements all I/O using mmap addresses. This was main reason why
296    L<Acme::6502> was just too slow to handle it.
297    
298    =cut
299    
300    =head2 read
301    
302    Read from memory
303    
304      $byte = read( $address );
305    
306    =cut
307    
308    sub read {
309            my $self = shift;
310            my ($addr) = @_;
311            my $byte = $mem[$addr];
312            confess sprintf("can't find memory at address %04x",$addr) unless defined($byte);
313            warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
314    
315            # keyboard
316    
317            if ( first { $addr == $_ } @kbd_ports ) {
318                    warn sprintf("keyboard port: %04x\n",$addr);
319            } elsif ( $addr == 0x87fc ) {
320                    warn "0x87fc - arrows/back\n";
321    =for pascal
322                    if VKey=VK_RIGHT then Result:=16;
323                    if VKey=VK_DOWN then Result:=128;
324                    if VKey=VK_UP then Result:=192;
325                    if VKey=VK_LEFT then Result:=224;
326                    if Ord(KeyPressed)=VK_BACK then Result:=224;
327    =cut
328            } elsif ( $addr == 0x87fd ) {
329                    warn "0x87fd - enter\n";
330    =for pascal
331        if KeyPressed=Chr(13) then begin
332          Mem[$FC]:=13;
333          Result:=0;
334        end;
335    =cut
336            } elsif ( $addr == 0x87fa ) {
337                    warn "0x87fa = F1 - F4\n";
338    =for pascal
339        if VKey=VK_F4 then Result:=16;
340        if VKey=VK_F3 then Result:=128;
341        if VKey=VK_F2 then Result:=192;
342        if VKey=VK_F1 then Result:=224;
343    =cut
344            } elsif ( $addr == 0x87fb ) {
345                    warn "0x87fb\n";
346    =for pascal
347        if KeyPressed=Chr(32) then Result:=32;
348        if KeyPressed='"' then Result:=16;
349        if KeyPressed='!' then Result:=16;
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 VKey=191 then Result:=16;
363    =cut
364            }
365    
366            $self->mmap_pixel( $addr, 0, $byte, 0 );
367            return $byte;
368    }
369    
370    =head2 write
371    
372    Write into emory
373    
374      write( $address, $byte );
375    
376    =cut
377    
378    sub write {
379            my $self = shift;
380            my ($addr,$byte) = @_;
381            warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
382    
383            if ( $addr >= 0x6000 && $addr < 0x8000 ) {
384                    $self->vram( $addr - 0x6000 , $byte );
385            }
386    
387            if ( $addr == 0x8800 ) {
388                    warn sprintf "sound ignored: %x\n", $byte;
389            }
390    
391            if ( $addr > 0xafff ) {
392                    confess sprintf "write access 0x%04x > 0xafff aborting\n", $addr;
393            }
394    
395            $self->mmap_pixel( $addr, $byte, 0, 0 );
396    
397            $mem[$addr] = $byte;
398            return;
399    }
400    
401    =head1 Command Line
402    
403    Command-line debugging intrerface is implemented for communication with
404    emulated device
405    
406  =head2 prompt  =head2 prompt
407    
408    $orao->prompt( $address, $last_command );    my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
409    
410  =cut  =cut
411    
412    my $last = 'r 1';
413    
414  sub prompt {  sub prompt {
415          my $self = shift;          my $self = shift;
416            $self->app->sync;
417          my $a = shift;          my $a = shift;
418          my $last = shift;          print STDERR $self->hexdump( $a ),
         print $self->hexdump( $a ),  
419                  $last ? "[$last] " : '',                  $last ? "[$last] " : '',
420                  "> ";                  "> ";
421          my $in = <STDIN>;          my $in = <STDIN>;
422          chomp($in);          chomp($in);
423            warn "## prompt got: $in\n" if $self->debug;
424          $in ||= $last;          $in ||= $last;
425          $last = $in;          $last = $in;
426          return split(/\s+/, $in) if $in;          return ( $in, split(/\s+/, $in) ) if $in;
427  }  }
428    
429    =head2 cli
430    
431      $orao->cli();
432    
433    =cut
434    
435    my $show_R = 0;
436    
437    sub cli {
438            my $self = shift;
439            my $a = $PC || confess "no pc?";
440            my $run_for = 0;
441            warn $self->dump_R() if $show_R;
442            while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
443                    my $c = shift @v;
444                    next unless defined($c);
445                    my $v = shift @v;
446                    $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
447                    @v = map { hex($_) } @v;
448                    printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
449                    if ( $c =~ m/^[qx]/i ) {
450                            exit;
451                    } elsif ( $c eq '?' ) {
452                            my $t = $self->trace ? 'on' : 'off' ;
453                            my $d = $self->debug ? 'on' : 'off' ;
454                            warn <<__USAGE__;
455    Usage:
456    
457    x|q\t\texit
458    e 6000 6010\tdump memory, +/- to walk forward/backward
459    m 1000 ff 00\tput ff 00 on 1000
460    j|u 1000\t\tjump (change pc)
461    r 42\t\trun 42 instruction opcodes
462    t\t\ttrace [$t]
463    d\t\tdebug [$d]
464    
465    __USAGE__
466                            warn $self->dump_R;
467                    } elsif ( $c =~ m/^e/i ) {
468                            $a = $v if defined($v);
469                            my $to = shift @v;
470                            $to = $a + 32 if ( ! $to || $to <= $a );
471                            $to = 0xffff if ( $to > 0xffff );
472                            my $lines = int( ($to - $a + 8) / 8 );
473                            printf "## e %04x %04x (%d bytes) lines: %d\n", $a, $to, ($to-$a), $lines;
474                            while ( --$lines ) {
475                                    print $self->hexdump( $a );
476                                    $a += 8;
477                            }
478                            $last = '+';
479                            $show_R = 0;
480                    } elsif ( $c =~ m/^\+/ ) {
481                            $a += 8;
482                            $show_R = 0;
483                    } elsif ( $c =~ m/^\-/ ) {
484                            $a -= 8;
485                            $show_R = 0;
486                    } elsif ( $c =~ m/^m/i ) {
487                            $a = $v if defined($v);
488                            $self->poke_code( $a, @v );
489                            printf "poke %d bytes at %04x\n", $#v + 1, $a;
490                            $last = '+';
491                            $show_R = 0;
492                    } elsif ( $c =~ m/^l/i ) {
493                            my $to = shift @v || 0x1000;
494                            $a = $to;
495                            $self->load_image( $v, $a );
496                            $last = '';
497                    } elsif ( $c =~ m/^s/i ) {
498                            $self->save_dump( $v || 'mem.dump', @v );
499                            $last = '';
500                    } elsif ( $c =~ m/^r/i ) {
501                            $run_for = $v || 1;
502                            print "run_for $run_for instructions\n";
503                            $show_R = 1;
504                            last;
505                    } elsif ( $c =~ m/^(u|j)/ ) {
506                            my $to = $v || $a;
507                            printf "set pc to %04x\n", $to;
508                            $PC = $to;      # remember for restart
509                            $run_for = 1;
510                            $last = "r $run_for";
511                            $show_R = 1;
512                            last;
513                    } elsif ( $c =~ m/^t/ ) {
514                            $self->trace( not $self->trace );
515                            print "trace ", $self->trace ? 'on' : 'off', "\n";
516                            $last = '';
517                    } elsif ( $c =~ m/^d/ ) {
518                            $self->debug( not $self->debug );
519                            print "debug ", $self->debug ? 'on' : 'off', "\n";
520                            $last = '';
521                    } else {
522                            warn "# ignored $line\n" if ($line);
523                            $last = '';
524                    }
525            }
526    
527            return $run_for;
528    }
529    
530  =head1 AUTHOR  =head1 AUTHOR
531    
Legend:
Removed from v.30  
changed lines
  Added in v.96
  ViewVC Help
Powered by ViewVC 1.1.26