Acme-6502

 view release on metacpan or  search on metacpan

inc/MyBuilder.pm  view on Meta::CPAN

package MyBuilder;

use base qw( Module::Build );

sub create_build_script {
  my ( $self, @args ) = @_;
  $self->_auto_mm;
  return $self->SUPER::create_build_script( @args );
}

sub _auto_mm {
  my $self = shift;
  my $mm   = $self->meta_merge;
  my @meta = qw( homepage bugtracker MailingList repository );
  for my $meta ( @meta ) {
    next if exists $mm->{resources}{$meta};
    my $auto = "_auto_$meta";
    next unless $self->can( $auto );
    my $av = $self->$auto();
    $mm->{resources}{$meta} = $av if defined $av;
  }
  $self->meta_merge( $mm );
}

sub _auto_repository {
  my $self = shift;
  if ( -d '.svn' ) {
    my $info = `svn info .`;
    return $1 if $info =~ /^URL:\s+(.+)$/m;
  }
  elsif ( -d '.git' ) {
    my $info = `git remote -v`;
    return unless $info =~ /^origin\s+(.+)$/m;
    my $url = $1;
    # Special case: patch up github URLs
    $url =~ s!^git\@github\.com:!git://github.com/!;
    return $url;
  }
  return;
}

sub _auto_bugtracker {
  'http://rt.cpan.org/NoAuth/Bugs.html?Dist=' . shift->dist_name;
}

sub ACTION_testauthor {
  my $self = shift;
  $self->test_files( 'xt/author' );
  $self->ACTION_test;
}

sub ACTION_critic {
  exec qw( perlcritic -1 -q -profile perlcriticrc lib/ ), glob 't/*.t';
}

sub ACTION_tags {
  exec(
    qw(
     ctags -f tags --recurse --totals
     --exclude=blib
     --exclude=.svn
     --exclude='*~'
     --languages=Perl
     t/ lib/
     )
  );
}

sub ACTION_tidy {
  my $self = shift;

  my @extra = qw( Build.PL );

  my %found_files = map { %$_ } $self->find_pm_files,
   $self->_find_file_by_type( 'pm', 't' ),
   $self->_find_file_by_type( 'pm', 'inc' ),
   $self->_find_file_by_type( 't',  't' );

  my @files = ( keys %found_files,

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

# Opcode to thunk into perlspace
use constant {
  ESCAPE_OP  => 0x0B,
  ESCAPE_SIG => 0xAD
};

BEGIN {
    for my $reg ( qw(a x y s p pc) ) {
        no strict 'refs';
        *{ __PACKAGE__ . "\::get_${reg}" } = sub {
            my $self = shift;
            return $self->{ reg }->{ $reg };
        };
        *{ __PACKAGE__ . "\::set_${reg}" } = sub {
            my ( $self, $v ) = @_;
            $self->{ reg }->{ $reg } = $v;
        };
    }
}

sub new {
    my $class = shift;
    my $self  = bless { }, $class;

    $self->_BUILD( @_ );

    return $self;
}

my @OP_CACHE;

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

    $args ||= {};

    $self->{ mem } = [ ( 0 ) x 65536 ];
    $self->{ reg } = {
        map { $_ => 0 } qw( a x y s p pc )
    };
    $self->{ os } = [ ];
    $self->{ jumptab } = $args->{ jumptab } || 0xFA00;

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

  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

t/leak.t  view on Meta::CPAN

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

done_testing;

t/monkeynes.t  view on Meta::CPAN

use strict;
use warnings;

use Test::More 'no_plan';

BEGIN {
  use_ok( 'Acme::6502' );
}

my %test_lut = (
  m => sub {
    return shift->read_8( hex shift );
  },
  ps => sub {
    return shift->get_p;
  },
  pc => sub {
    return shift->get_pc;
  },
  sp => sub {
    return shift->get_s;
  },
  acc => sub {
    return shift->get_a;
  },
  ix => sub {
    return shift->get_x;
  },
  iy => sub {
    return shift->get_y;
  },
  s => sub {
    return $_[0]->get_p & $_[0]->N ? 1 : 0;
  },
  v => sub {
    return $_[0]->get_p & $_[0]->V ? 1 : 0;
  },
  b => sub {
    return $_[0]->get_p & $_[0]->B ? 1 : 0;
  },
  d => sub {
    return $_[0]->get_p & $_[0]->D ? 1 : 0;
  },
  i => sub {
    return $_[0]->get_p & $_[0]->I ? 1 : 0;
  },
  z => sub {
    return $_[0]->get_p & $_[0]->Z ? 1 : 0;
  },
  c => sub {
    return $_[0]->get_p & $_[0]->C ? 1 : 0;
  },
);

my %regset_lut = (
  ps => sub {
    shift->set_p( shift );
  },
  pc => sub {
    shift->set_pc( shift );
  },
  sp => sub {
    shift->set_s( shift );
  },
  acc => sub {
    shift->set_a( shift );
  },
  ix => sub {
    shift->set_x( shift );
  },
  iy => sub {
    shift->set_y( shift );
  },
  s => sub {
    $_[0]->set_p( $_[0]->get_p & ~$_[0]->N );
    $_[0]->set_p( $_[0]->get_p | $_[0]->N ) if $_[1];
  },
  v => sub {
    $_[0]->set_p( $_[0]->get_p & ~$_[0]->V );
    $_[0]->set_p( $_[0]->get_p | $_[0]->V ) if $_[1];
  },
  b => sub {
    $_[0]->set_p( $_[0]->get_p & ~$_[0]->B );
    $_[0]->set_p( $_[0]->get_p | $_[0]->B ) if $_[1];
  },
  d => sub {
    $_[0]->set_p( $_[0]->get_p & ~$_[0]->D );
    $_[0]->set_p( $_[0]->get_p | $_[0]->D ) if $_[1];
  },
  i => sub {
    $_[0]->set_p( $_[0]->get_p & ~$_[0]->I );
    $_[0]->set_p( $_[0]->get_p | $_[0]->I ) if $_[1];
  },
  z => sub {
    $_[0]->set_p( $_[0]->get_p & ~$_[0]->Z );
    $_[0]->set_p( $_[0]->get_p | $_[0]->Z ) if $_[1];
  },
  c => sub {
    $_[0]->set_p( $_[0]->get_p & ~$_[0]->C );
    $_[0]->set_p( $_[0]->get_p | $_[0]->C ) if $_[1];
  },
);

my $glob = $ENV{TEST_OP} || '*';
my @files = glob( "t/monkeynes/script_${glob}.txt" );

for my $file ( @files ) {
  open( my $script, $file ) || die qq(cannot load test script "$file");
  _diag( qq(Running script "$file") );
  my @lines = <$script>;
  chomp( @lines );
  run_script( @lines );
  close( $script );
}

sub run_script {
  my $cpu;
  for ( @_ ) {
    chomp;
    next if m{^\s*$};
    next if m{^save};
    if ( m{^# (.+)} ) {
      _diag( $1 );
    }
    elsif ( $_ eq 'clear' ) {
      next;

 view all matches for this distribution
 view release on metacpan -  search on metacpan