Acme-6502

 view release on metacpan or  search on metacpan

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

sub _inst {
    my $src = join( "\n", @_ );

    # registers
    $src    =~ s{\$(a|x|y|s|p|pc)\b}{\$self->{reg}->{$1}}g;

    # memory and zn access
    $src    =~ s{\$(mem|zn)\[}{\$self->{$1}->[}g;

    my $cr  = eval "sub { my \$self=shift; ${src} }";
    confess "$@" if $@;
    return $cr;
}

sub _bad_inst {
    my $self = shift;
    my $pc   = $self->get_pc;

    croak sprintf( "Bad instruction at &%04x (&%02x)\n",
      $pc - 1, $self->{ mem }->[ $pc - 1 ] );

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

}

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

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

    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+$//;

t/leak.t  view on Meta::CPAN

use strict;
use warnings;

use Test::More;
use Acme::6502;
use Acme::6502::Tube;

eval { require Test::LeakTrace; };

plan skip_all => "Test::LeakTrace require for this test" if $@;

Test::LeakTrace::no_leaks_ok( sub {
    my $cpu = Acme::6502->new;
} );

Test::LeakTrace::no_leaks_ok( sub {
    my $cpu = Acme::6502::Tube->new;
} );

t/pod-coverage.t  view on Meta::CPAN

#!perl -T

use Test::More;
eval "use Test::Pod::Coverage 1.04";
plan skip_all =>
 "Test::Pod::Coverage 1.04 required for testing POD coverage"
 if $@;
all_pod_coverage_ok(
  {
    private =>
     [ qr{^BUILD|DEMOLISH|AUTOMETHOD|START$}, qr{^_}, qr{call_os}, qr{make_vector} ]
  }
);

t/pod.t  view on Meta::CPAN

#!perl -T

use Test::More;
eval "use Test::Pod 1.14";
plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
all_pod_files_ok();