view release on metacpan or  search on metacpan

lib/Acme/6502/Tube.pm  view on Meta::CPAN

}

sub _set_escape {
  my $self = shift;
  $self->write_8( 0xFF, 0xFF );
}

sub _osword {
  my $self = shift;
  my $a   = $self->get_a();
  my $blk = $self->get_xy();

  if ( $a == 0x00 ) {
    # Command line input
    my $buf = $self->read_16( $blk );
    my $len = $self->read_8( $blk + 2 );
    my $min = $self->read_8( $blk + 3 );
    my $max = $self->read_8( $blk + 4 );
    my $y   = 0;
    if ( defined( my $in = <> ) ) {
      my @c = map ord, split //, $in;
      while ( @c && $len-- > 1 ) {
        my $c = shift @c;
        if ( $c >= $min && $c <= $max ) {
          $self->write_8( $buf + $y++, $c );
        }
      }
      $self->write_8( $buf + $y++, 0x0D );
      $self->set_y( $y );
      $self->set_p( $self->get_p() & ~$self->C );
    }
    else {
      # Escape I suppose...
      $self->set_p( $self->get_p() | $self->C );
    }
  }
  elsif ( $a == 0x01 ) {
    # Read clock
    my $now = int( ( time() - $self->{ time_base } ) * 100 );
    $self->write_32( $blk, $now );
    $self->write_8( $blk + 4, 0 );
  }
  elsif ( $a == 0x02 ) {
    # Set clock
    my $tm = $self->read_32( $blk );
    $self->{ time_base } = time() - ( $tm * 100 );
  }
  else {
    die sprintf( "OSWORD %02x not handled\n", $a );
  }
}

sub _oswrch {
  my $self = shift;
  printf( "%c", $self->get_a() );
}

sub _osrdch {
  my $self = shift;
  Term::ReadKey::ReadMode( 4 );
  eval {
    my $k = ord( Term::ReadKey::ReadKey( 0 ) );
    $k = 0x0D if $k == 0x0A;
    $self->set_a( $k );
    if ( $k == 27 ) {
      $self->set_escape;
      $self->set_p( $self->get_p() | $self->C );
    }
    else {
      $self->set_p( $self->get_p() & ~$self->C );
    }
  };
  Term::ReadKey::ReadMode( 0 );
  die $@ if $@;
}

sub _osfile {
  my $self = shift;
  my $a     = $self->get_a();
  my $blk   = $self->get_xy();
  my $name  = $self->read_str( $self->read_16( $blk ) );
  my $load  = $self->read_32( $blk + 2 );
  my $exec  = $self->read_32( $blk + 6 );
  my $start = $self->read_32( $blk + 10 );
  my $end   = $self->read_32( $blk + 14 );

  # printf("%-20s %08x %08x %08x %08x\n", $name, $load, $exec, $start, $end);
  if ( $a == 0x00 ) {
    # Save
    open my $fh, '>', $name or die "Can't write $name\n";
    binmode $fh;
    my $buf = $self->read_chunk( $start, $end );
    syswrite $fh, $buf or die "Error writing $name\n";
    $self->set_a( 1 );
  }
  elsif ( $a == 0xFF ) {
    # Load
    if ( -f $name ) {
      open my $fh, '<', $name or die "Can't read $name\n";
      binmode $fh;
      my $len = -s $fh;
      sysread $fh, my $buf, $len or die "Error reading $name\n";
      $load = PAGE if $exec & 0xFF;
      $self->write_chunk( $load, $buf );
      $self->write_32( $blk + 2,  $load );
      $self->write_32( $blk + 6,  0x00008023 );
      $self->write_32( $blk + 10, $len );
      $self->write_32( $blk + 14, 0x00000000 );
      $self->set_a( 1 );
    }
    elsif ( -d $name ) {
      $self->set_a( 2 );
    }
    else {
      $self->set_a( 0 );
    }
  }
  else {
    die sprintf( "OSFILE %02x not handled\n", $a );
  }
}

sub _osargs {
  die "OSARGS not handled\n";
}

sub _osbget {
  die "OSBGET not handled\n";
}

sub _osbput {
  die "OSBPUT not handled\n";
}

sub _osgbpb {
  die "OSGBPB not handled\n";
}

sub _osfind {
  die "OSFIND not handled\n";
}

sub make_vector {
    my( $self, $name, $vec, $code ) = @_;

    my $addr = $self->$name;
    my $vecno = scalar @{ $self->{ os } };
    push @{ $self->{ os } }, [ $code, $name ];

    $self->SUPER::make_vector( $addr, $vec, $vecno );
}

sub call_os {
  my $self = shift;
  my $vecno = shift;

  eval {
    my $call = $self->{ os }->[ $vecno ] || die "Bad OS call $vecno\n";
    $call->[ 0 ]->( $self );
  };

  if ( $@ ) {
    my $err = $@;
    $self->write_16( ERROR, 0x7F00 );
    $err =~ s/\s+/ /;
    $err =~ s/^\s+//;
    $err =~ s/\s+$//;
    warn $err;
    my $ep = ERROR + 2;
    for ( map ord, split //, $err ) {
      $self->write_8( $ep++, $_ );
    }
    $self->write_8( $ep++, 0x00 );
    $self->set_pc( ERROR );
  }
}

1;
__END__

=head1 NAME

Acme::6502::Tube - Acorn 65C02 Second Processor Simulator

=head1 VERSION

This document describes Acme::6502::Tube version 0.76

=head1 SYNOPSIS

    use Acme::6502::Tube;

    my $cpu = Acme::6502::Tube->new();

    # Load BBC Basic
    $cpu->load_rom('BASIC2.rom', 0x8000);

    # Init registers
    $cpu->set_pc(0x8000);
    $cpu->set_a(0x01);
    $cpu->set_s(0xFF);
    $cpu->set_p(0x22);

    # Run
    $cpu->run(2000_000) while 1;
  
=head1 DESCRIPTION

Emulates an Acorn BBC Micro 6502 Tube second processor. You'll need
to find your own language ROM to load and it's only been tested with
BBC Basic II.

=head1 INTERFACE 

See L<Acme::6502>. C<Acme::6502::Tube> is an C<Acme::6502> instance that
has been initialised with a skeleton Tube OS.