]>
Commit | Line | Data |
---|---|---|
23c26e04 MG |
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 } | |
3b542afc | 105 | sub flag_temp { 7 } |
23c26e04 MG |
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 | } | |
3b542afc MG |
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 | } |