view release on metacpan or  search on metacpan

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

  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 ) {
    # Read HIMEM
    $self->set_xy( HIMEM );
  }
  elsif ( $a == 0xDA ) {
    $self->set_xy( 0x0900 );
  }
  else {
    die sprintf( "OSBYTE %02x not handled\n", $a );
  }
}

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 ) );

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

    }
    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