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/;
  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/;
  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 sub send_ {
  74         my ($cmd) = @_;
  75         my %cmd = %$cmd;
  76
  77         my $binary = pack 'vCC', @cmd{qw/I mem_addr op/}; # we ignore CS for now
  78         my $hex = reverse unpack 'h*', $binary;
  79         say "$rom_cnt: data <= 32'h$hex;";
  80         $rom_cnt++;
  81 }
  82
  83
  84 sub nop {
  85         send_
  86           { I => 0, mem_addr => 0, op => OP_NOP, CS => 0 }
  87   }
  88
  89 sub loada {
  90         my ($addr, $flagr, $bsel, $aluc) = @_;
  91         my $I = 0;
  92         $I |= $flagr;
  93         $I |= $bsel << 4;
  94         $I |= $aluc << 5;
  95         send_
  96           { I => $I, mem_addr => $addr, op => OP_LOADA, CS => 0 }
  97   }
  98
  99 sub loadb {
 100         my ($addr, $cond, $inv, $alus) = @_;
 101         my $I = 0;
 102         $I |= $cond;
 103         $I |= $inv << 4;
 104         $I |= $alus << 5;
 105         send_
 106           { I => $I, mem_addr => $addr, op => OP_LOADB, CS => 0 }
 107   }
 108
 109 #sub read_ {
 110 #       my ($addr) = @_;
 111 #       send_ { I => 0, mem_addr => $addr, op => OP_READ, CS => 1 }
 112 #}
 113
 114 sub store {
 115         my ($addr, $flagw, $edge_, $cube) = @_;
 116         my $I = 0;
 117         $I |= $flagw;
 118         $I |= $edge_ << 7;
 119         $I |= $cube << 8;
 120         send_
 121           { I => $I, mem_addr => $addr, op => OP_STORE, CS => 0 }
 122   }
 123
 124 sub loadi {
 125         my ($addr, $I) = @_;
 126         send_
 127           { I => $I, mem_addr => $addr, op => OP_LOADI, CS => 0 }
 128 }
 129
 130 sub route {
 131         my ($addr, $dest_addr) = @_;
 132         my $I = $dest_addr;
 133         send_
 134           { I => $I, mem_addr => $addr, op => OP_ROUTE, CS => 0 }
 135 }
 136
 137 sub storei {
 138         my ($addr, $I) = @_;
 139         send_
 140           { I => $I, mem_addr => $addr, op => OP_STOREI, CS => 0 }
 141 }
 142
 143 sub led {
 144         my ($addr, $mode, $offset_leds) = @_;
 145         my $I = $offset_leds;
 146         $I |= $mode << 4;
 147         send_
 148           { I => $I, mem_addr => $addr, op => OP_LED, CS => 0 }
 149 }
 150
 151 sub ledm {
 152         my ($addr, $offset) = @_;
 153         led $addr, 1, $offset;
 154 }
 155
 156 sub ledi {
 157         my ($leds) = @_;
 158         led 0, 0, $leds;
 159 }
 160
 161 sub flag_zero { 0 }
 162 sub flag_temp { 7 }
 163
 164 sub flag_news { 8 + $_[0] }
 165
 166 sub alu_select_a {
 167         0b11110000
 168 }
 169
 170 sub alu_select_b {
 171         0b11001100
 172 }
 173
 174 sub alu_select_f {
 175         0b10101010
 176 }
 177
 178 sub alu_zero {
 179         0
 180 }
 181
 182 sub alu_xor {
 183         0b10010110
 184 }
 185
 186 sub alu_xnor {
 187         0b01101001
 188 }
 189
 190 sub alu_of_function (&) {
 191         my ($fun) = @_;
 192         my $alu = 0;
 193         for my $i (0 .. 7) {
 194                 local $a = ($i & 4) >> 2;
 195                 local $b = ($i & 2) >> 1;
 196                 local $_ = $i & 1;
 197                 $alu += ($fun->() ? 1 : 0) << $i;
 198         }
 199         $alu
 200 }
 201
 202 sub aluc_add { alu_of_function { ($a + $b + $_) & 2 } }
 203 sub alus_add { alu_of_function { ($a + $b + $_) & 1 } }
 204
 205 sub aluc_addAF { alu_of_function { ($a + $_) & 2 } }
 206 sub alus_addAF { alu_of_function { ($a + $_) & 1 } }
 207
 208 sub alu_or { alu_of_function { $a | $b | $_ } }
 209
 210 sub alu2 {
 211         my ($aluc, $alus, $addrA, $addrB, $flagr, $flagw, $cond, $inv) = @_;
 212         loada $addrA, $flagr, 0, $aluc;
 213         loadb $addrB, $cond, $inv, $alus;
 214         store $addrA, $flagw, 0, 0;
 215 }
 216
 217 sub alu3 {
 218         my ($aluc, $alus, $addrA, $addrB, $addrC, $flagr, $flagw) = @_;
 219         loada $addrA, $flagr, 0, $aluc;
 220         loadb $addrB, 0, 1, $alus;
 221         store $addrC, $flagw, 0, 0;
 222 }
 223
 224 sub add {
 225         my ($addrA, $addrB, $addrC, $flag_carry) = @_;
 226         alu3 aluc_add, alus_add, $addrA, $addrB, $addrC, flag_zero, $flag_carry;
 227 }
 228
 229 sub addC {
 230         my ($addrA, $addrB, $addrC, $flag_carry) = @_;
 231         alu3 aluc_add, alus_add, $addrA, $addrB, $addrC, $flag_carry, $flag_carry;
 232 }
 233
 234 # news_gen face partea de mijloc
 235 # news_[mf][mf] face primul alu3, apeleaza news_gen, apoi face ultimul alu3
 236 sub news_generic {
 237         my ($nX, $nY, $dest) = @_;
 238         my %dest = %$dest;
 239         while ($nX || $nY) {
 240                 my $direction;
 241                 if ($nX && $nY) {
 242                         $nX--;
 243                         $nY--;
 244                         $direction = 7;
 245                 } elsif ($nX) {
 246                         $nX--;
 247                         $direction = 0;
 248                 } else {
 249                         $nY--;
 250                         $direction = 6;
 251                 }
 252                 if ($nX || $nY) { # not the last go
 253                         alu3 alu_select_f, alu_select_a, 0, 0, 0, flag_news($direction), flag_zero
 254                 } elsif (exists $dest{address}) {
 255                         alu3 alu_select_f, alu_select_f, 0, 0, $dest{address}, flag_news($direction), flag_zero
 256                 } elsif (exists $dest{flag}) {
 257                         alu3 alu_select_f, alu_select_a, 0, 0, 0, flag_news($direction), $dest{flag}
 258                 } else {
 259                         die "No destination address nor flag given to [news_generic]\n"
 260                 }
 261         }
 262 }
 263
 264 sub news_mm {
 265         my ($addrIN, $addrOUT, $nX, $nY) = @_;
 266         alu3 alu_select_a, alu_select_a, $addrIN, 0, $addrIN, flag_zero, flag_zero;
 267         news_generic $nX, $nY, {address => $addrOUT};
 268 }
 269
 270 sub news_mf {
 271         my ($addrIN, $flagOUT, $nX, $nY) = @_;
 272         alu3 alu_select_a, alu_select_a, $addrIN, 0, $addrIN, flag_zero, flag_zero;
 273         news_generic $nX, $nY, {flag => $flagOUT};
 274 }
 275
 276 sub news_fm {
 277         my ($flagIN, $addrOUT, $nX, $nY) = @_;
 278         alu3 alu_select_f, alu_select_a, 0, 0, 0, $flagIN, flag_zero;
 279         news_generic $nX, $nY, {address => $addrOUT};
 280 }
 281
 282 sub news_ff {
 283         my ($flagIN, $flagOUT, $nX, $nY) = @_;
 284         alu3 alu_select_f, alu_select_a, 0, 0, 0, $flagIN, flag_zero;
 285         news_generic $nX, $nY, {flag => $flagOUT};
 286 }
 287
 288 1;