]>
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, | |
7f1b6bd9 | 10 | OP_STOREI => 4, |
23c26e04 MG |
11 | OP_LOADI => 5, |
12 | OP_ROUTE => 6, | |
7f1b6bd9 | 13 | OP_LED => 7, |
23c26e04 MG |
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 | ||
7f1b6bd9 | 31 | #use Fcntl; |
23c26e04 MG |
32 | use Time::HiRes qw/sleep/; |
33 | ||
7f1b6bd9 MG |
34 | my $port; |
35 | #sysopen $port, '/dev/ttyUSB1', O_SYNC | O_RDWR or die "$!"; | |
23c26e04 MG |
36 | |
37 | ||
38 | use parent qw/Exporter/; | |
46a95fd3 MG |
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/; | |
23c26e04 MG |
41 | |
42 | use File::Slurp::Tiny 'write_file'; | |
43 | ||
7f1b6bd9 MG |
44 | =begin comment |
45 | ||
46 | sub send__ { | |
23c26e04 MG |
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 | ||
7f1b6bd9 MG |
66 | =end |
67 | ||
68 | ||
69 | =cut | |
70 | ||
71 | my $rom_cnt = 0; | |
72 | ||
46a95fd3 MG |
73 | # by default instructions are for all 4 chips to execute |
74 | our $CS = 0xF; | |
75 | ||
7f1b6bd9 MG |
76 | sub send_ { |
77 | my ($cmd) = @_; | |
78 | my %cmd = %$cmd; | |
46a95fd3 | 79 | my $op_cs = $cmd{op} + ($CS << 4); |
7f1b6bd9 | 80 | |
46a95fd3 | 81 | my $binary = pack 'vCC', $cmd{I}, $cmd{mem_addr}, $op_cs; |
7f1b6bd9 | 82 | my $hex = reverse unpack 'h*', $binary; |
46a95fd3 MG |
83 | # say "$rom_cnt: data <= 32'h$hex;"; |
84 | say $hex; | |
7f1b6bd9 MG |
85 | $rom_cnt++; |
86 | } | |
87 | ||
46a95fd3 MG |
88 | sub chip_select { |
89 | my ($new_cs, $sub) = @_; | |
90 | local $CS = $new_cs; | |
91 | $sub->(); | |
92 | } | |
7f1b6bd9 MG |
93 | |
94 | sub nop { | |
95 | send_ | |
46a95fd3 | 96 | { I => 0, mem_addr => 0, op => OP_NOP } |
7f1b6bd9 MG |
97 | } |
98 | ||
23c26e04 MG |
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_ | |
46a95fd3 | 106 | { I => $I, mem_addr => $addr, op => OP_LOADA } |
23c26e04 MG |
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_ | |
46a95fd3 | 116 | { I => $I, mem_addr => $addr, op => OP_LOADB } |
23c26e04 MG |
117 | } |
118 | ||
7f1b6bd9 MG |
119 | #sub read_ { |
120 | # my ($addr) = @_; | |
121 | # send_ { I => 0, mem_addr => $addr, op => OP_READ, CS => 1 } | |
122 | #} | |
23c26e04 MG |
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_ | |
46a95fd3 | 131 | { I => $I, mem_addr => $addr, op => OP_STORE } |
23c26e04 MG |
132 | } |
133 | ||
134 | sub loadi { | |
135 | my ($addr, $I) = @_; | |
136 | send_ | |
46a95fd3 | 137 | { I => $I, mem_addr => $addr, op => OP_LOADI } |
23c26e04 MG |
138 | } |
139 | ||
7f1b6bd9 | 140 | sub route { |
46a95fd3 MG |
141 | my ($addr, $dest_addr, $led) = @_; |
142 | $led //= 0; | |
7f1b6bd9 | 143 | my $I = $dest_addr; |
46a95fd3 | 144 | $I |= $led << 12; |
7f1b6bd9 | 145 | send_ |
46a95fd3 | 146 | { I => $I, mem_addr => $addr, op => OP_ROUTE } |
7f1b6bd9 MG |
147 | } |
148 | ||
149 | sub storei { | |
150 | my ($addr, $I) = @_; | |
151 | send_ | |
46a95fd3 | 152 | { I => $I, mem_addr => $addr, op => OP_STOREI } |
7f1b6bd9 MG |
153 | } |
154 | ||
155 | sub led { | |
156 | my ($addr, $mode, $offset_leds) = @_; | |
157 | my $I = $offset_leds; | |
158 | $I |= $mode << 4; | |
159 | send_ | |
46a95fd3 | 160 | { I => $I, mem_addr => $addr, op => OP_LED } |
7f1b6bd9 MG |
161 | } |
162 | ||
163 | sub ledm { | |
164 | my ($addr, $offset) = @_; | |
46a95fd3 | 165 | $offset //= 0; |
7f1b6bd9 MG |
166 | led $addr, 1, $offset; |
167 | } | |
168 | ||
169 | sub ledi { | |
170 | my ($leds) = @_; | |
171 | led 0, 0, $leds; | |
172 | } | |
173 | ||
23c26e04 | 174 | sub flag_zero { 0 } |
3b542afc | 175 | sub flag_temp { 7 } |
23c26e04 MG |
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 | ||
46a95fd3 MG |
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 | ||
23c26e04 MG |
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 | ||
46a95fd3 MG |
244 | sub mov { |
245 | my ($addrA, $addrC) = @_; | |
246 | alu3 alu_zero, alu_select_a, $addrA, $addrA, $addrC, flag_zero, flag_zero | |
247 | } | |
248 | ||
23c26e04 MG |
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 | } | |
3b542afc | 258 | |
46a95fd3 MG |
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 | ||
3b542afc MG |
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; | |
46a95fd3 | 276 | if ($nX > 0) { |
3b542afc | 277 | $nX--; |
46a95fd3 MG |
278 | $direction = 2; |
279 | } elsif ($nX < 0) { | |
280 | $nX++; | |
3b542afc | 281 | $direction = 0; |
46a95fd3 | 282 | } elsif ($nY > 0) { |
3b542afc | 283 | $nY--; |
46a95fd3 MG |
284 | $direction = 1; |
285 | } elsif ($nY < 0) { | |
286 | $nY++; | |
287 | $direction = 3; | |
3b542afc MG |
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 | } | |
7f1b6bd9 MG |
324 | |
325 | 1; |