/[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 52 by dpavlin, Tue Jul 31 12:57:35 2007 UTC
# Line 39  Start emulator Line 39  Start emulator
39    
40  our $orao;  our $orao;
41    
42    select(STDERR); $| = 1;
43    
44  sub init {  sub init {
45          my $self = shift;          my $self = shift;
46          warn "Orao calling upstream init\n";          warn "Orao calling upstream init\n";
47          $self->SUPER::init( $self, @_ );          $self->SUPER::init( $self, @_ );
48    
49          warn "staring Orao $Orao::VERSION emulation\n";          warn "Orao $Orao::VERSION emulation starting\n", dump( $self );
50    
51          $self->open_screen;          $self->open_screen;
52          $self->load_rom({          $self->load_rom({
# Line 53  sub init { Line 55  sub init {
55                  0xE000 => 'rom/CRT12.ROM',                  0xE000 => 'rom/CRT12.ROM',
56          });          });
57    
58          $self->load_oraoemu( 'dump/orao-1.2' );          $PC = 0xDD11;   # BC
59          $self->load_oraoemu( 'dump/SCRINV.BIN' );  #       $PC = 0xC274;   # MC
         $PC = 0x1000;  
60    
61          $orao = $self;          $orao = $self;
62    
63  #       $self->prompt( 0x1000 );  #       $self->prompt( 0x1000 );
64    
65          warn "rendering memory map\n";          my ( $trace, $debug ) = ( $self->trace, $self->debug );
66            $self->trace( 0 );
67            $self->debug( 0 );
68    
69            if ( $self->show_mem ) {
70    
71                    warn "rendering memory map\n";
72    
73                    my @mmap = (
74                            0x0000, 0x03FF, 'nulti blok',
75                            0x0400, 0x5FFF, 'korisnički RAM (23K)',
76                            0x6000, 0x7FFF, 'video RAM',
77                            0x8000, 0x9FFF, 'sistemske lokacije',
78                            0xA000, 0xAFFF, 'ekstenzija',
79                            0xB000, 0xBFFF, 'DOS',
80                            0xC000, 0xDFFF, 'BASIC ROM',
81                            0xE000, 0xFFFF, 'sistemski ROM',
82                    );
83    
84                    foreach my $i ( 0 .. $#mmap / 3 ) {
85                            my $o = $i * 3;
86                            my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];
87                            printf "%04x - %04x - %s\n", $from, $to, $desc;
88                            for my $a ( $from .. $to ) {
89                                    if ( $a >= 0x6000 && $a < 0x8000 ) {
90                                            my $b = $self->read( $a );
91                                            $self->vram( $a - 0x6000, $b );
92                                    } else {
93                                            $self->read( $a );
94                                    }
95                            }
96                    }
97    
98          my @mmap = (          } else {
                 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',  
         );  
99    
100          foreach my $i ( 0 .. $#mmap / 3 ) {                  warn "rendering video memory\n";
101                  my $o = $i * 3;                  for my $a ( 0x6000 .. 0x7fff ) {
102                  my ( $from, $to, $desc ) = @mmap[$o,$o+1,$o+2];                          $self->vram( $a - 0x6000, $mem[$a] );
                 printf "%04x - %04x - %s\n", $from, $to, $desc;  
                 for my $a ( $from .. $to ) {  
                         $orao->read( $a );  
103                  }                  }
104                  $self->sync;          
105          }          }
106            $self->sync;
107          warn "Orao init finished\n";          $self->trace( $trace );
108            $self->debug( $debug );
109    
110            #( $A, $P, $X, $Y, $S, $IPeriod ) = ( 1, 2, 3, 4, 5, 6 );
111    
112            warn "Orao init finished",
113                    $self->trace ? ' trace' : '',
114                    $self->debug ? ' debug' : '',
115                    "\n";
116    
117  }  }
118    
# Line 112  sub load_rom { Line 140  sub load_rom {
140    
141  =cut  =cut
142    
143    sub _write_chunk {
144            my $self = shift;
145            my ( $addr, $chunk ) = @_;
146            $self->write_chunk( $addr, $chunk );
147            my $end = $addr + length($chunk);
148            my ( $f, $t ) = ( 0x6000, 0x7fff );
149    
150            if ( $end < $f || $addr >= $t ) {
151                    warn "skip vram update\n";
152                    return;
153            };
154    
155            $f = $addr if ( $addr > $f );
156            $t = $end if ( $end < $t );
157    
158            warn sprintf("refresh video ram %04x-%04x\n", $f, $t);
159            foreach my $a ( $f .. $t ) {
160                    $self->vram( $a - 0x6000 , $mem[ $a ] );
161            }
162    }
163    
164  sub load_oraoemu {  sub load_oraoemu {
165          my $self = shift;          my $self = shift;
166          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
# Line 123  sub load_oraoemu { Line 172  sub load_oraoemu {
172          if ( $size == 65538 ) {          if ( $size == 65538 ) {
173                  $addr = 0;                  $addr = 0;
174                  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;
175                  $self->write_chunk( $addr, substr($buff,2) );                  $self->_write_chunk( $addr, substr($buff,2) );
176                  return;                  return;
177          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
178                  $addr = 0;                  $addr = 0;
179                  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;
180                  #$self->write_chunk( $addr, substr($buff,0x20) );                  $self->_write_chunk( $addr, substr($buff,0x20) );
                 $self->poke_code( $addr, map { ord($_) } split(//,substr($buff,0x20)) );  
181                  return;                  return;
182          }          }
183          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;
184          return $self->poke_code( $addr, map { ord($_) } split(//,$buff) );          return $self->_write_chunk( $addr, $buff );
         return $self->write_chunk( $addr, $buff );  
185    
186          my $chunk;          my $chunk;
187    
# Line 150  sub load_oraoemu { Line 197  sub load_oraoemu {
197                  $pos += 4;                  $pos += 4;
198          }          }
199    
200          $self->write_chunk( $addr, $chunk );          $self->_write_chunk( $addr, $chunk );
201    
202  };  };
203    
# Line 189  sub hexdump { Line 236  sub hexdump {
236                  join(" ",                  join(" ",
237                          map {                          map {
238                                  sprintf( "%02x", $_ )                                  sprintf( "%02x", $_ )
239                          } $self->ram( $a, $a+8 )                          } @mem[ $a .. $a+8 ]
240                  )                  )
241          );          );
242  }  }
243    
 =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;  
 }  
   
244  =head1 Memory management  =head1 Memory management
245    
246  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 260  sub read {
260          my $self = shift;          my $self = shift;
261          my ($addr) = @_;          my ($addr) = @_;
262          my $byte = $mem[$addr];          my $byte = $mem[$addr];
263          warn "# Orao::read(",dump(@_),") = ",dump( $byte ),"\n" if $self->debug;          warn sprintf("# Orao::read(%04x) = %02x\n", $addr, $byte) if $self->trace;
264          $self->mmap_pixel( $addr, 0, $byte, 0 );          $self->mmap_pixel( $addr, 0, $byte, 0 );
265          return $byte;          return $byte;
266  }  }
# Line 248  Write into emory Line 275  Write into emory
275    
276  sub write {  sub write {
277          my $self = shift;          my $self = shift;
         warn "# Orao::write(",dump(@_),")\n" if $self->debug;  
278          my ($addr,$byte) = @_;          my ($addr,$byte) = @_;
279            warn sprintf("# Orao::write(%04x,%02x)\n", $addr, $byte) if $self->trace;
280    
281          if ( $addr >= 0x6000 && $addr < 0x8000 ) {          if ( $addr >= 0x6000 && $addr < 0x8000 ) {
282                  $self->vram( $addr - 0x6000 , $byte );                  $self->vram( $addr - 0x6000 , $byte );
283          }          }
284    
         if ( $addr > 0xafff ) {  
                 warn sprintf "access to %04x above affff aborting\n", $addr;  
                 return -1;  
         }  
285          if ( $addr == 0x8800 ) {          if ( $addr == 0x8800 ) {
286                  warn sprintf "sound ignored: %x\n", $byte;                  warn sprintf "sound ignored: %x\n", $byte;
287          }          }
288    
289            if ( $addr > 0xafff ) {
290                    confess sprintf "write access %04x > afff aborting\n", $self, $addr;
291            }
292    
293          $self->mmap_pixel( $addr, $byte, 0, 0 );          $self->mmap_pixel( $addr, $byte, 0, 0 );
294    
295          $mem[$addr] = $byte;          $mem[$addr] = $byte;
296            return;
297  }  }
298    
299    =head1 Command Line
300    
301    Command-line debugging intrerface is implemented for communication with
302    emulated device
303    
304    =head2 prompt
305    
306      $orao->prompt( $address, $last_command );
307    
308    =cut
309    
310    my $last = 'r 1';
311    
312    sub prompt {
313            my $self = shift;
314            $self->app->sync;
315            my $a = shift;
316            print STDERR $self->hexdump( $a ),
317                    $last ? "[$last] " : '',
318                    "> ";
319            my $in = <STDIN>;
320            chomp($in);
321            warn "## prompt got: $in\n" if $self->debug;
322            $in ||= $last;
323            $last = $in;
324            return split(/\s+/, $in) if $in;
325    }
326    
327    =head2 cli
328    
329      $orao->cli();
330    
331    =cut
332    
333    sub cli {
334            my $self = shift;
335            my $a = $PC || confess "no pc?";
336            while ( my @v = $self->prompt( $a, $last ) ) {
337                    my $c = shift @v;
338                    my $v = shift @v;
339                    $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
340                    @v = map { hex($_) } @v;
341                    printf "## a: %04x parsed cli: c:%s v:%s %s\n", $a, $c, ($v || 'undef'), join(",",@v) if $self->debug;
342                    if ( $c =~ m/^[qx]/i ) {
343                            exit;
344                    } elsif ( $c eq '?' ) {
345                            my $t = $self->trace ? 'on' : 'off' ;
346                            my $d = $self->debug ? 'on' : 'off' ;
347                            warn <<__USAGE__;
348    Usage:
349    
350    x|q\t\texit
351    e 6000 6010\tdump memory, +/- to walk forward/backward
352    m 1000 ff 00\tput ff 00 on 1000
353    j|u 1000\t\tjump (change pc)
354    r 42\t\trun 42 instruction opcodes
355    t\t\ttrace [$t]
356    d\t\tdebug [$d]
357    
358    __USAGE__
359                            warn sprintf(" PC: %04x A:%02x P:%02x X:%02x Y:%02x S:%02x\n", $PC, $A, $P, $X, $Y, $S);
360                    } elsif ( $c =~ m/^e/i ) {
361                            $a = $v if defined($v);
362                            my $to = shift @v;
363                            $to = $a + 32 if ( ! $to || $to <= $a );
364                            my $lines = int( ($to - $a - 8) / 8 );
365                            printf "## m %04x %04x lines: %d\n", $a, $to, $lines;
366                            while ( $lines ) {
367                                    print $self->hexdump( $a );
368                                    $a += 8;
369                                    $lines--;
370                            }
371                            $last = '+';
372                    } elsif ( $c =~ m/^\+/ ) {
373                            $a += 8;
374                    } elsif ( $c =~ m/^\-/ ) {
375                            $a -= 8;
376                    } elsif ( $c =~ m/^m/i ) {
377                            $a = $v;
378                            $self->poke_code( $a, @v );
379                            printf "poke %d bytes at %04x\n", $#v + 1, $a;
380                            $last = '+';
381                    } elsif ( $c =~ m/^l/i ) {
382                            my $to = shift @v || 0x1000;
383                            $a = $to;
384                            $self->load_oraoemu( $v, $a );
385                            $last = '';
386                    } elsif ( $c =~ m/^s/i ) {
387                            $self->save_dump( $v || 'mem.dump', @v );
388                            $last = '';
389                    } elsif ( $c =~ m/^r/i ) {
390                            $run_for = $v || 1;
391                            print "run_for $run_for instructions\n";
392                            last;
393                    } elsif ( $c =~ m/^(u|j)/ ) {
394                            my $to = $v || $a;
395                            printf "set pc to %04x\n", $to;
396                            $PC = $to;      # remember for restart
397                            $run_for = 1;
398                            $last = sprintf('m %04x', $to);
399                            last;
400                    } elsif ( $c =~ m/^t/ ) {
401                            $self->trace( not $self->trace );
402                            print "trace ", $self->trace ? 'on' : 'off', "\n";
403                    } elsif ( $c =~ m/^d/ ) {
404                            $self->debug( not $self->debug );
405                            print "debug ", $self->debug ? 'on' : 'off', "\n";
406                    } else {
407                            warn "# ignore $c\n";
408                            last;
409                    }
410            }
411    
412    
413    }
414    
415  =head1 AUTHOR  =head1 AUTHOR
416    
Legend:
Removed from v.35  
changed lines
  Added in v.52
  ViewVC Help
Powered by ViewVC 1.1.26