Conway works (with sleeps)

[clump.git] / asm.pm

#!/usr/bin/perl
use v5.14;
use warnings;

use constant +{
	OP_NOP => 0,
	OP_LOADA => 1,
	OP_LOADB => 2,
	OP_STORE => 3,
	OP_READ => 4,
	OP_LOADI => 5,
	OP_ROUTE => 6,
	OP_RUG => 7,
};

q,
use Device::SerialPort;

my $port = Device::SerialPort->new($ARGV[0] // '/dev/ttyUSB1') or die "$!";
$port->baudrate(300);
#$port->baudrate(4000000);
$port->parity('none');
$port->databits(8);
$port->stopbits(2);
$port->handshake('none');
$port->read_const_time(2000);

$port->write_settings or die "$!";
,;

use Fcntl;
use Time::HiRes qw/sleep/;

sysopen my $port, '/dev/ttyUSB1', O_SYNC | O_RDWR or die "$!";


use parent qw/Exporter/;
our @EXPORT = qw/loada loadb store write_verilog alu_select_a alu_select_b alu_select_f alu_zero flag_zero flag_news alu_xor alu_xnor alu_or alu_of_function aluc_add alus_add aluc_addAF alus_addAF alu2 alu3 add addC/;
our @EXPORT_OK = qw/loada loadb store write_verilog alu_select_a alu_select_b alu_select_f alu_zero flag_zero flag_news  alu_xor alu_xnor alu_or alu_of_function aluc_add alus_add aluc_addAF alus_addAF alu2 alu3 add addC/;

use File::Slurp::Tiny 'write_file';

sub send_ {
	my ($cmd) = @_;
	my %cmd = %$cmd;

	my $binary = pack 'vCC', @cmd{qw/I mem_addr op/}; # we ignore CS for now
	my $length = length $binary;
	my $wrote = syswrite $port, $binary, $length;
	sleep 0.2;
#	say "Wrote $wrote of $length bytes";
	if ($cmd{op} == OP_READ) {
		my $string_in;
		my $count_in = sysread $port, $string_in, 2;
		my @memory = unpack 'v*', $string_in;
		for (@memory) {
			printf "%X", $_
		}
		print " "
	}
}

sub loada {
	my ($addr, $flagr, $bsel, $aluc) = @_;
	my $I = 0;
	$I |= $flagr;
	$I |= $bsel << 4;
	$I |= $aluc << 5;
	send_
	  { I => $I, mem_addr => $addr, op => OP_LOADA, CS => 0 }
  }

sub loadb {
	my ($addr, $cond, $inv, $alus) = @_;
	my $I = 0;
	$I |= $cond;
	$I |= $inv << 4;
	$I |= $alus << 5;
	send_
	  { I => $I, mem_addr => $addr, op => OP_LOADB, CS => 0 }
  }

sub read_ {
	my ($addr) = @_;
	send_ { I => 0, mem_addr => $addr, op => OP_READ, CS => 1 }
}

sub store {
	my ($addr, $flagw, $edge_, $cube) = @_;
	my $I = 0;
	$I |= $flagw;
	$I |= $edge_ << 7;
	$I |= $cube << 8;
	send_
	  { I => $I, mem_addr => $addr, op => OP_STORE, CS => 0 }
  }

sub loadi {
	my ($addr, $I) = @_;
	send_
	  { I => $I, mem_addr => $addr, op => OP_LOADI, CS => 0 }
}

sub flag_zero { 0 }

sub flag_news { 8 + $_[0] }

sub alu_select_a {
	0b11110000
}

sub alu_select_b {
	0b11001100
}

sub alu_select_f {
	0b10101010
}

sub alu_zero {
	0
}

sub alu_xor {
	0b10010110
}

sub alu_xnor {
	0b01101001
}

sub alu_of_function (&) {
	my ($fun) = @_;
	my $alu = 0;
	for my $i (0 .. 7) {
		local $a = ($i & 4) >> 2;
		local $b = ($i & 2) >> 1;
		local $_ = $i & 1;
		$alu += ($fun->() ? 1 : 0) << $i;
	}
	$alu
}

sub aluc_add { alu_of_function { ($a + $b + $_) & 2 } }
sub alus_add { alu_of_function { ($a + $b + $_) & 1 } }

sub aluc_addAF { alu_of_function { ($a + $_) & 2 } }
sub alus_addAF { alu_of_function { ($a + $_) & 1 } }

sub alu_or { alu_of_function { $a | $b | $_ } }

sub alu2 {
	my ($aluc, $alus, $addrA, $addrB, $flagr, $flagw, $cond, $inv) = @_;
	loada $addrA, $flagr, 0, $aluc;
	loadb $addrB, $cond, $inv, $alus;
	store $addrA, $flagw, 0, 0;
}

sub alu3 {
	my ($aluc, $alus, $addrA, $addrB, $addrC, $flagr, $flagw) = @_;
	loada $addrA, $flagr, 0, $aluc;
	loadb $addrB, 0, 1, $alus;
	store $addrC, $flagw, 0, 0;
}

sub add {
	my ($addrA, $addrB, $addrC, $flag_carry) = @_;
	alu3 aluc_add, alus_add, $addrA, $addrB, $addrC, flag_zero, $flag_carry;
}

sub addC {
	my ($addrA, $addrB, $addrC, $flag_carry) = @_;
	alu3 aluc_add, alus_add, $addrA, $addrB, $addrC, $flag_carry, $flag_carry;
}