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_STOREI => 4,
  11         OP_LOADI => 5,
  12         OP_ROUTE => 6,
  13         OP_LED => 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 my $port;
  35 #sysopen $port, '/dev/ttyUSB1', O_SYNC | O_RDWR or die "$!";
  36
  37
  38 use parent qw/Exporter/;
  39 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 loadi storei ledm ledi route chip_select/;
  40 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 loadi storei ledm ledi route chip_select/;
  41
  42 use File::Slurp::Tiny 'write_file';
  43
  44 =begin comment
  45
  46 sub send__ {
  47         my ($cmd) = @_;
  48         my %cmd = %$cmd;
  49
  50         my $binary = pack 'vCC', @cmd{qw/I mem_addr op/}; # we ignore CS for now
  51         my $length = length $binary;
  52         my $wrote = syswrite $port, $binary, $length;
  53         sleep 0.2;
  54 #       say "Wrote $wrote of $length bytes";
  55         if ($cmd{op} == OP_READ) {
  56                 my $string_in;
  57                 my $count_in = sysread $port, $string_in, 2;
  58                 my @memory = unpack 'v*', $string_in;
  59                 for (@memory) {
  60                         printf "%X", $_
  61                 }
  62                 print " "
  63         }
  64 }
  65
  66 =end
  67
  68
  69 =cut
  70
  71 my $rom_cnt = 0;
  72
  73 # by default instructions are for all 4 chips to execute
  74 our $CS = 0xF;
  75
  76 sub send_ {
  77         my ($cmd) = @_;
  78         my %cmd = %$cmd;
  79         my $op_cs = $cmd{op} + ($CS << 4);
  80
  81         my $binary = pack 'vCC', $cmd{I}, $cmd{mem_addr}, $op_cs;
  82         my $hex = reverse unpack 'h*', $binary;
  83         #       say "$rom_cnt: data <= 32'h$hex;";
  84         say $hex;
  85         $rom_cnt++;
  86 }
  87
  88 sub chip_select {
  89         my ($new_cs, $sub) = @_;
  90         local $CS = $new_cs;
  91         $sub->();
  92 }
  93
  94 sub nop {
  95         send_
  96           { I => 0, mem_addr => 0, op => OP_NOP }
  97   }
  98
  99 sub loada {
 100         my ($addr, $flagr, $bsel, $aluc) = @_;
 101         my $I = 0;
 102         $I |= $flagr;
 103         $I |= $bsel << 4;
 104         $I |= $aluc << 5;
 105         send_
 106           { I => $I, mem_addr => $addr, op => OP_LOADA }
 107   }
 108
 109 sub loadb {
 110         my ($addr, $cond, $inv, $alus) = @_;
 111         my $I = 0;
 112         $I |= $cond;
 113         $I |= $inv << 4;
 114         $I |= $alus << 5;
 115         send_
 116           { I => $I, mem_addr => $addr, op => OP_LOADB }
 117   }
 118
 119 #sub read_ {
 120 #       my ($addr) = @_;
 121 #       send_ { I => 0, mem_addr => $addr, op => OP_READ, CS => 1 }
 122 #}
 123
 124 sub store {
 125         my ($addr, $flagw, $edge_, $cube) = @_;
 126         my $I = 0;
 127         $I |= $flagw;
 128         $I |= $edge_ << 7;
 129         $I |= $cube << 8;
 130         send_
 131           { I => $I, mem_addr => $addr, op => OP_STORE }
 132   }
 133
 134 sub loadi {
 135         my ($addr, $I) = @_;
 136         send_
 137           { I => $I, mem_addr => $addr, op => OP_LOADI }
 138 }
 139
 140 sub route {
 141         my ($addr, $dest_addr, $led) = @_;
 142         $led //= 0;
 143         my $I = $dest_addr;
 144         $I |= $led << 12;
 145         send_
 146           { I => $I, mem_addr => $addr, op => OP_ROUTE }
 147 }
 148
 149 sub storei {
 150         my ($addr, $I) = @_;
 151         send_
 152           { I => $I, mem_addr => $addr, op => OP_STOREI }
 153 }
 154
 155 sub led {
 156         my ($addr, $mode, $offset_leds) = @_;
 157         my $I = $offset_leds;
 158         $I |= $mode << 4;
 159         send_
 160           { I => $I, mem_addr => $addr, op => OP_LED }
 161 }
 162
 163 sub ledm {
 164         my ($addr, $offset) = @_;
 165         $offset //= 0;
 166         led $addr, 1, $offset;
 167 }
 168
 169 sub ledi {
 170         my ($leds) = @_;
 171         led 0, 0, $leds;
 172 }
 173
 174 sub flag_zero { 0 }
 175 sub flag_temp { 7 }
 176
 177 sub flag_news { 8 + $_[0] }
 178
 179 sub alu_select_a {
 180         0b11110000
 181 }
 182
 183 sub alu_select_b {
 184         0b11001100
 185 }
 186
 187 sub alu_select_f {
 188         0b10101010
 189 }
 190
 191 sub alu_zero {
 192         0
 193 }
 194
 195 sub alu_xor {
 196         0b10010110
 197 }
 198
 199 sub alu_xnor {
 200         0b01101001
 201 }
 202
 203 sub alu_of_function (&) {
 204         my ($fun) = @_;
 205         my $alu = 0;
 206         for my $i (0 .. 7) {
 207                 local $a = ($i & 4) >> 2;
 208                 local $b = ($i & 2) >> 1;
 209                 local $_ = $i & 1;
 210                 $alu += ($fun->() ? 1 : 0) << $i;
 211         }
 212         $alu
 213 }
 214
 215 sub aluc_add { alu_of_function { ($a + $b + $_) & 2 } }
 216 sub alus_add { alu_of_function { ($a + $b + $_) & 1 } }
 217
 218 sub aluc_addAF { alu_of_function { ($a + $_) & 2 } }
 219 sub alus_addAF { alu_of_function { ($a + $_) & 1 } }
 220
 221 sub alu_or { alu_of_function { $a | $b | $_ } }
 222
 223 sub alu_and { alu_of_function { $a & $b & $_ } }
 224
 225 BEGIN {
 226         die "alus_add != alu_xor" unless alus_add == alu_xor;
 227         die "bad alu_select_f" unless alu_select_f == alu_of_function { $_ };
 228 }
 229
 230 sub alu2 {
 231         my ($aluc, $alus, $addrA, $addrB, $flagr, $flagw, $cond, $inv) = @_;
 232         loada $addrA, $flagr, 0, $aluc;
 233         loadb $addrB, $cond, $inv, $alus;
 234         store $addrA, $flagw, 0, 0;
 235 }
 236
 237 sub alu3 {
 238         my ($aluc, $alus, $addrA, $addrB, $addrC, $flagr, $flagw) = @_;
 239         loada $addrA, $flagr, 0, $aluc;
 240         loadb $addrB, 0, 1, $alus;
 241         store $addrC, $flagw, 0, 0;
 242 }
 243
 244 sub mov {
 245         my ($addrA, $addrC) = @_;
 246         alu3 alu_zero, alu_select_a, $addrA, $addrA, $addrC, flag_zero, flag_zero
 247 }
 248
 249 sub add {
 250         my ($addrA, $addrB, $addrC, $flag_carry) = @_;
 251         alu3 aluc_add, alus_add, $addrA, $addrB, $addrC, flag_zero, $flag_carry;
 252 }
 253
 254 sub addC {
 255         my ($addrA, $addrB, $addrC, $flag_carry) = @_;
 256         alu3 aluc_add, alus_add, $addrA, $addrB, $addrC, $flag_carry, $flag_carry;
 257 }
 258
 259 sub xor_ {
 260         my ($addrA, $addrB, $addrC) = @_;
 261         alu3 alu_zero, alu_xor, $addrA, $addrB, $addrC, flag_zero, flag_zero;
 262 }
 263
 264 sub and_ {
 265         my ($addrA, $addrB, $addrC) = @_;
 266         alu3 alu_zero, alu_and, $addrA, $addrB, $addrC, flag_zero, flag_zero;
 267 }
 268
 269 # news_gen face partea de mijloc
 270 # news_[mf][mf] face primul alu3, apeleaza news_gen, apoi face ultimul alu3
 271 sub news_generic {
 272         my ($nX, $nY, $dest) = @_;
 273         my %dest = %$dest;
 274         while ($nX || $nY) {
 275                 my $direction;
 276                 if ($nX > 0) {
 277                         $nX--;
 278                         $direction = 2;
 279                 } elsif ($nX < 0) {
 280                         $nX++;
 281                         $direction = 0;
 282                 } elsif ($nY > 0) {
 283                         $nY--;
 284                         $direction = 1;
 285                 } elsif ($nY < 0) {
 286                         $nY++;
 287                         $direction = 3;
 288                 }
 289                 if ($nX || $nY) { # not the last go
 290                         alu3 alu_select_f, alu_select_a, 0, 0, 0, flag_news($direction), flag_zero
 291                 } elsif (exists $dest{address}) {
 292                         alu3 alu_select_f, alu_select_f, 0, 0, $dest{address}, flag_news($direction), flag_zero
 293                 } elsif (exists $dest{flag}) {
 294                         alu3 alu_select_f, alu_select_a, 0, 0, 0, flag_news($direction), $dest{flag}
 295                 } else {
 296                         die "No destination address nor flag given to [news_generic]\n"
 297                 }
 298         }
 299 }
 300
 301 sub news_mm {
 302         my ($addrIN, $addrOUT, $nX, $nY) = @_;
 303         alu3 alu_select_a, alu_select_a, $addrIN, 0, $addrIN, flag_zero, flag_zero;
 304         news_generic $nX, $nY, {address => $addrOUT};
 305 }
 306
 307 sub news_mf {
 308         my ($addrIN, $flagOUT, $nX, $nY) = @_;
 309         alu3 alu_select_a, alu_select_a, $addrIN, 0, $addrIN, flag_zero, flag_zero;
 310         news_generic $nX, $nY, {flag => $flagOUT};
 311 }
 312
 313 sub news_fm {
 314         my ($flagIN, $addrOUT, $nX, $nY) = @_;
 315         alu3 alu_select_f, alu_select_a, 0, 0, 0, $flagIN, flag_zero;
 316         news_generic $nX, $nY, {address => $addrOUT};
 317 }
 318
 319 sub news_ff {
 320         my ($flagIN, $flagOUT, $nX, $nY) = @_;
 321         alu3 alu_select_f, alu_select_a, 0, 0, 0, $flagIN, flag_zero;
 322         news_generic $nX, $nY, {flag => $flagOUT};
 323 }
 324
 325 1;