view release on metacpan or  search on metacpan

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

package Acme::6502::Tube;

use warnings;
use strict;
use Carp;
use Time::HiRes qw(time);
use Term::ReadKey ();
use base qw(Acme::6502);

our $VERSION = '0.77';

use constant ERROR => 0xF800;

use constant {
  PAGE  => 0x0800,
  HIMEM => 0x8000
};

use constant {
  OSRDRM => 0xFFB9,
  OSEVEN => 0xFFBF,
  GSINIT => 0xFFC2,
  GSREAD => 0xFFC5,
  NVWRCH => 0xFFC8,
  NVRDCH => 0xFFCB,
  OSFIND => 0xFFCE,
  OSGBPB => 0xFFD1,
  OSBPUT => 0xFFD4,
  OSBGET => 0xFFD7,
  OSARGS => 0xFFDA,
  OSFILE => 0xFFDD,
  OSASCI => 0xFFE3,
  OSNEWL => 0xFFE7,
  OSWRCH => 0xFFEE,
  OSRDCH => 0xFFE0,
  OSWORD => 0xFFF1,
  OSBYTE => 0xFFF4,
  OSCLI  => 0xFFF7
};

sub _BUILD {
  my ( $self, $args ) = @_;

  $self->SUPER::_BUILD( $args );

  $self->{ time_base } = time();

  # Inline OSASCI code
  $self->poke_code( OSASCI,
    0xC9, 0x0D,          # CMP #&0D
    0xD0, 0x07,          # BNE +7
    0xA9, 0x0A,          # LDA #&0A
    0x20, 0xEE, 0xFF,    # JSR &FFEE
    0xA9, 0x0D           # LDA #&0D
  );

  # BRK handler. The interrupt handling is bogus - so don't
  # generate any interrupts before fixing it :)
  $self->poke_code(
    0xFF00, 0x85, 0xFC, 0x68, 0x58, 0x29, 0x10, 0xF0,
    0x17,   0x8A, 0x48, 0xBA, 0x38, 0xBD, 0x02, 0x01,
    0xE9,   0x01, 0x85, 0xFD, 0xBD, 0x03, 0x01, 0xE9,
    0x00,   0x85, 0xFE, 0x68, 0xAA, 0x6C, 0x02, 0x02,
    0x6C,   0x04, 0x02
  );

  $self->write_16( $self->BREAK, 0xFF00 );

  $self->make_vector( 'OSCLI',  0x208, \&_oscli );
  $self->make_vector( 'OSBYTE', 0x20A, \&_osbyte );
  $self->make_vector( 'OSWORD', 0x20C, \&_osword );
  $self->make_vector( 'OSWRCH', 0x20E, \&_oswrch );
  $self->make_vector( 'OSRDCH', 0x210, \&_osrdch );
  $self->make_vector( 'OSFILE', 0x212, \&_osfile );
  $self->make_vector( 'OSARGS', 0x214, \&_osargs );
  $self->make_vector( 'OSBGET', 0x216, \&_osbget );
  $self->make_vector( 'OSBPUT', 0x218, \&_osbput );
  $self->make_vector( 'OSGBPB', 0x21A, \&_osgbpb );
  $self->make_vector( 'OSFIND', 0x21C, \&_osfind );

  $self->set_jumptab( 0xFA00 );
}

sub _oscli {
  my $self = shift;
  my $blk = $self->get_xy();
  my $cmd = '';
  CH: for ( ;; ) {
    my $ch = $self->read_8( $blk++ );
    last CH if $ch < 0x20;
    $cmd .= chr( $ch );
  }
  $cmd =~ s/^[\s\*]+//g;
  if ( lc( $cmd ) eq 'quit' ) {
    exit;
  }
  else {
    system( $cmd );
  }
}

sub _osbyte {
  my $self = shift;
  my $a = $self->get_a();
  if ( $a == 0x7E ) {
    # Ack escape
    $self->write_8( 0xFF, 0 );
    $self->set_x( 0xFF );
  }
  elsif ( $a == 0x82 ) {
    # Read m/c high order address
    $self->set_xy( 0 );
  }
  elsif ( $a == 0x83 ) {
    # Read OSHWM (PAGE)
    $self->set_xy( PAGE );
  }
  elsif ( $a == 0x84 ) {

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

      $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.

=head1 CONFIGURATION AND ENVIRONMENT
  
Acme::6502 requires no configuration files or environment variables.

=head1 DEPENDENCIES

C<Acme::6502>

=head1 INCOMPATIBILITIES

None reported.

=head1 BUGS AND LIMITATIONS