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/; | |
7f1b6bd9 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/; |
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/; | |
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 | ||
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 | ||
23c26e04 MG |
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 | ||
7f1b6bd9 MG |
109 | #sub read_ { |
110 | # my ($addr) = @_; | |
111 | # send_ { I => 0, mem_addr => $addr, op => OP_READ, CS => 1 } | |
112 | #} | |
23c26e04 MG |
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 | ||
7f1b6bd9 MG |
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 | ||
23c26e04 | 161 | sub flag_zero { 0 } |
3b542afc | 162 | sub flag_temp { 7 } |
23c26e04 MG |
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 | } | |
3b542afc MG |
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 | } | |
7f1b6bd9 MG |
287 | |
288 | 1; |