/[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 59 by dpavlin, Tue Jul 31 16:06:27 2007 UTC revision 61 by dpavlin, Tue Jul 31 16:22:10 2007 UTC
# Line 135  sub load_rom { Line 135  sub load_rom {
135          }          }
136  }  }
137    
138    # write chunk directly into memory, updateing vram if needed
 =head2 load_oraoemu  
   
 =cut  
   
139  sub _write_chunk {  sub _write_chunk {
140          my $self = shift;          my $self = shift;
141          my ( $addr, $chunk ) = @_;          my ( $addr, $chunk ) = @_;
# Line 161  sub _write_chunk { Line 157  sub _write_chunk {
157          }          }
158  }  }
159    
160    =head2 load_oraoemu
161    
162    Load binary files, ROM images and Orao Emulator files
163    
164      $orao->load_oraoemu( '/path/to/file', 0x1000 );
165    
166    Returns true on success.
167    
168    =cut
169    
170  sub load_oraoemu {  sub load_oraoemu {
171          my $self = shift;          my $self = shift;
172          my ( $path, $addr ) = @_;          my ( $path, $addr ) = @_;
173    
174            if ( ! -e $path ) {
175                    warn "ERROR: file $path doesn't exist\n";
176                    return;
177            }
178    
179          my $size = -s $path || confess "no size for $path: $!";          my $size = -s $path || confess "no size for $path: $!";
180    
181          my $buff = read_file( $path );          my $buff = read_file( $path );
# Line 173  sub load_oraoemu { Line 184  sub load_oraoemu {
184                  $addr = 0;                  $addr = 0;
185                  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;
186                  $self->_write_chunk( $addr, substr($buff,2) );                  $self->_write_chunk( $addr, substr($buff,2) );
187                  return;                  return 1;
188          } elsif ( $size == 32800 ) {          } elsif ( $size == 32800 ) {
189                  $addr = 0;                  $addr = 0;
190                  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;
191                  $self->_write_chunk( $addr, substr($buff,0x20) );                  $self->_write_chunk( $addr, substr($buff,0x20) );
192                  return;                  return 1;
193          }          }
194          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;
195          return $self->_write_chunk( $addr, $buff );          $self->_write_chunk( $addr, $buff );
196            return 1;
197    
198          my $chunk;          my $chunk;
199    
# Line 199  sub load_oraoemu { Line 211  sub load_oraoemu {
211    
212          $self->_write_chunk( $addr, $chunk );          $self->_write_chunk( $addr, $chunk );
213    
214            return 1;
215  };  };
216    
217  =head2 save_dump  =head2 save_dump
# Line 303  emulated device Line 316  emulated device
316    
317  =head2 prompt  =head2 prompt
318    
319    $orao->prompt( $address, $last_command );    my ( $entered_line, @p ) = $orao->prompt( $address, $last_command );
320    
321  =cut  =cut
322    
# Line 321  sub prompt { Line 334  sub prompt {
334          warn "## prompt got: $in\n" if $self->debug;          warn "## prompt got: $in\n" if $self->debug;
335          $in ||= $last;          $in ||= $last;
336          $last = $in;          $last = $in;
337          return split(/\s+/, $in) if $in;          return ( $in, split(/\s+/, $in) ) if $in;
338  }  }
339    
340  =head2 cli  =head2 cli
# Line 333  sub prompt { Line 346  sub prompt {
346  sub cli {  sub cli {
347          my $self = shift;          my $self = shift;
348          my $a = $PC || confess "no pc?";          my $a = $PC || confess "no pc?";
349          while ( my @v = $self->prompt( $a, $last ) ) {          while ( my ($line, @v) = $self->prompt( $a, $last ) ) {
350                  my $c = shift @v;                  my $c = shift @v;
351                    next unless defined($c);
352                  my $v = shift @v;                  my $v = shift @v;
353                  $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;                  $v = hex($v) if $v && $v =~ m/^[0-9a-f]+$/;
354                  @v = map { hex($_) } @v;                  @v = map { hex($_) } @v;
# Line 403  __USAGE__ Line 417  __USAGE__
417                          $self->debug( not $self->debug );                          $self->debug( not $self->debug );
418                          print "debug ", $self->debug ? 'on' : 'off', "\n";                          print "debug ", $self->debug ? 'on' : 'off', "\n";
419                  } else {                  } else {
420                          warn "# ignore $c\n";                          warn "# ignored $line\n" if ($line);
421                          last;                          $last = '';
422                  }                  }
423          }          }
424    
   
425  }  }
426    
427  =head1 AUTHOR  =head1 AUTHOR

Legend:
Removed from v.59  
changed lines
  Added in v.61

  ViewVC Help
Powered by ViewVC 1.1.26