Conway works (with sleeps)

[clump.git] / asm.pm

diff --git a/asm.pm b/asm.pm
new file mode 100644 (file)
index 0000000..d07004e
--- /dev/null
+++ b/asm.pm
@@ -0,0 +1,174 @@
+#!/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;
+}