asm.pm

   1 #!/usr/bin/perl
   2 use v5.14;
   3 use warnings;
   4
   5 use constant +{
   6         OP_NOP => 0,
   7         OP_LOADA => 1,
   8         OP_LOADB => 2,
   9         OP_STORE => 3,
  10         OP_READ => 4,
  11         OP_LOADI => 5,
  12         OP_ROUTE => 6,
  13         OP_RUG => 7,
  14 };
  15
  16 q,
  17 use Device::SerialPort;
  18
  19 my $port = Device::SerialPort->new($ARGV[0] // '/dev/ttyUSB1') or die "$!";
  20 $port->baudrate(300);
  21 #$port->baudrate(4000000);
  22 $port->parity('none');
  23 $port->databits(8);
  24 $port->stopbits(2);
  25 $port->handshake('none');
  26 $port->read_const_time(2000);
  27
  28 $port->write_settings or die "$!";
  29 ,;
  30
  31 use Fcntl;
  32 use Time::HiRes qw/sleep/;
  33
  34 sysopen my $port, '/dev/ttyUSB1', O_SYNC | O_RDWR or die "$!";
  35
  36
  37 use parent qw/Exporter/;
  38 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/;
  39 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/;
  40
  41 use File::Slurp::Tiny 'write_file';
  42
  43 sub send_ {
  44         my ($cmd) = @_;
  45         my %cmd = %$cmd;
  46
  47         my $binary = pack 'vCC', @cmd{qw/I mem_addr op/}; # we ignore CS for now
  48         my $length = length $binary;
  49         my $wrote = syswrite $port, $binary, $length;
  50         sleep 0.2;
  51 #       say "Wrote $wrote of $length bytes";
  52         if ($cmd{op} == OP_READ) {
  53                 my $string_in;
  54                 my $count_in = sysread $port, $string_in, 2;
  55                 my @memory = unpack 'v*', $string_in;
  56                 for (@memory) {
  57                         printf "%X", $_
  58                 }
  59                 print " "
  60         }
  61 }
  62
  63 sub loada {
  64         my ($addr, $flagr, $bsel, $aluc) = @_;
  65         my $I = 0;
  66         $I |= $flagr;
  67         $I |= $bsel << 4;
  68         $I |= $aluc << 5;
  69         send_
  70           { I => $I, mem_addr => $addr, op => OP_LOADA, CS => 0 }
  71   }
  72
  73 sub loadb {
  74         my ($addr, $cond, $inv, $alus) = @_;
  75         my $I = 0;
  76         $I |= $cond;
  77         $I |= $inv << 4;
  78         $I |= $alus << 5;
  79         send_
  80           { I => $I, mem_addr => $addr, op => OP_LOADB, CS => 0 }
  81   }
  82
  83 sub read_ {
  84         my ($addr) = @_;
  85         send_ { I => 0, mem_addr => $addr, op => OP_READ, CS => 1 }
  86 }
  87
  88 sub store {
  89         my ($addr, $flagw, $edge_, $cube) = @_;
  90         my $I = 0;
  91         $I |= $flagw;
  92         $I |= $edge_ << 7;
  93         $I |= $cube << 8;
  94         send_
  95           { I => $I, mem_addr => $addr, op => OP_STORE, CS => 0 }
  96   }
  97
  98 sub loadi {
  99         my ($addr, $I) = @_;
 100         send_
 101           { I => $I, mem_addr => $addr, op => OP_LOADI, CS => 0 }
 102 }
 103
 104 sub flag_zero { 0 }
 105 sub flag_temp { 7 }
 106
 107 sub flag_news { 8 + $_[0] }
 108
 109 sub alu_select_a {
 110         0b11110000
 111 }
 112
 113 sub alu_select_b {
 114         0b11001100
 115 }
 116
 117 sub alu_select_f {
 118         0b10101010
 119 }
 120
 121 sub alu_zero {
 122         0
 123 }
 124
 125 sub alu_xor {
 126         0b10010110
 127 }
 128
 129 sub alu_xnor {
 130         0b01101001
 131 }
 132
 133 sub alu_of_function (&) {
 134         my ($fun) = @_;
 135         my $alu = 0;
 136         for my $i (0 .. 7) {
 137                 local $a = ($i & 4) >> 2;
 138                 local $b = ($i & 2) >> 1;
 139                 local $_ = $i & 1;
 140                 $alu += ($fun->() ? 1 : 0) << $i;
 141         }
 142         $alu
 143 }
 144
 145 sub aluc_add { alu_of_function { ($a + $b + $_) & 2 } }
 146 sub alus_add { alu_of_function { ($a + $b + $_) & 1 } }
 147
 148 sub aluc_addAF { alu_of_function { ($a + $_) & 2 } }
 149 sub alus_addAF { alu_of_function { ($a + $_) & 1 } }
 150
 151 sub alu_or { alu_of_function { $a | $b | $_ } }
 152
 153 sub alu2 {
 154         my ($aluc, $alus, $addrA, $addrB, $flagr, $flagw, $cond, $inv) = @_;
 155         loada $addrA, $flagr, 0, $aluc;
 156         loadb $addrB, $cond, $inv, $alus;
 157         store $addrA, $flagw, 0, 0;
 158 }
 159
 160 sub alu3 {
 161         my ($aluc, $alus, $addrA, $addrB, $addrC, $flagr, $flagw) = @_;
 162         loada $addrA, $flagr, 0, $aluc;
 163         loadb $addrB, 0, 1, $alus;
 164         store $addrC, $flagw, 0, 0;
 165 }
 166
 167 sub add {
 168         my ($addrA, $addrB, $addrC, $flag_carry) = @_;
 169         alu3 aluc_add, alus_add, $addrA, $addrB, $addrC, flag_zero, $flag_carry;
 170 }
 171
 172 sub addC {
 173         my ($addrA, $addrB, $addrC, $flag_carry) = @_;
 174         alu3 aluc_add, alus_add, $addrA, $addrB, $addrC, $flag_carry, $flag_carry;
 175 }
 176
 177 # news_gen face partea de mijloc
 178 # news_[mf][mf] face primul alu3, apeleaza news_gen, apoi face ultimul alu3
 179 sub news_generic {
 180         my ($nX, $nY, $dest) = @_;
 181         my %dest = %$dest;
 182         while ($nX || $nY) {
 183                 my $direction;
 184                 if ($nX && $nY) {
 185                         $nX--;
 186                         $nY--;
 187                         $direction = 7;
 188                 } elsif ($nX) {
 189                         $nX--;
 190                         $direction = 0;
 191                 } else {
 192                         $nY--;
 193                         $direction = 6;
 194                 }
 195                 if ($nX || $nY) { # not the last go
 196                         alu3 alu_select_f, alu_select_a, 0, 0, 0, flag_news($direction), flag_zero
 197                 } elsif (exists $dest{address}) {
 198                         alu3 alu_select_f, alu_select_f, 0, 0, $dest{address}, flag_news($direction), flag_zero
 199                 } elsif (exists $dest{flag}) {
 200                         alu3 alu_select_f, alu_select_a, 0, 0, 0, flag_news($direction), $dest{flag}
 201                 } else {
 202                         die "No destination address nor flag given to [news_generic]\n"
 203                 }
 204         }
 205 }
 206
 207 sub news_mm {
 208         my ($addrIN, $addrOUT, $nX, $nY) = @_;
 209         alu3 alu_select_a, alu_select_a, $addrIN, 0, $addrIN, flag_zero, flag_zero;
 210         news_generic $nX, $nY, {address => $addrOUT};
 211 }
 212
 213 sub news_mf {
 214         my ($addrIN, $flagOUT, $nX, $nY) = @_;
 215         alu3 alu_select_a, alu_select_a, $addrIN, 0, $addrIN, flag_zero, flag_zero;
 216         news_generic $nX, $nY, {flag => $flagOUT};
 217 }
 218
 219 sub news_fm {
 220         my ($flagIN, $addrOUT, $nX, $nY) = @_;
 221         alu3 alu_select_f, alu_select_a, 0, 0, 0, $flagIN, flag_zero;
 222         news_generic $nX, $nY, {address => $addrOUT};
 223 }
 224
 225 sub news_ff {
 226         my ($flagIN, $flagOUT, $nX, $nY) = @_;
 227         alu3 alu_select_f, alu_select_a, 0, 0, 0, $flagIN, flag_zero;
 228         news_generic $nX, $nY, {flag => $flagOUT};
 229 }