[clump.git] / asm.pm

#!/usr/bin/perl
use v5.14;
use warnings;

use constant +{
	OP_NOP => 0,
	OP_LOADA => 1,
	OP_LOADB => 2,
	OP_STORE => 3,
	OP_STOREI => 4,
	OP_LOADI => 5,
	OP_ROUTE => 6,
	OP_LED => 7,
};

q,
use Device::SerialPort;

my $port = Device::SerialPort->new($ARGV[0] // '/dev/ttyUSB1') or die "$!";
$port->baudrate(300);
#$port->baudrate(4000000);
$port->parity('none');
$port->databits(8);
$port->stopbits(2);
$port->handshake('none');
$port->read_const_time(2000);

$port->write_settings or die "$!";
,;

#use Fcntl;
use Time::HiRes qw/sleep/;

my $port;
#sysopen $port, '/dev/ttyUSB1', O_SYNC | O_RDWR or die "$!";


use parent qw/Exporter/;
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/;
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/;

use File::Slurp::Tiny 'write_file';

=begin comment

sub send__ {
	my ($cmd) = @_;
	my %cmd = %$cmd;

	my $binary = pack 'vCC', @cmd{qw/I mem_addr op/}; # we ignore CS for now
	my $length = length $binary;
	my $wrote = syswrite $port, $binary, $length;
	sleep 0.2;
#	say "Wrote $wrote of $length bytes";
	if ($cmd{op} == OP_READ) {
		my $string_in;
		my $count_in = sysread $port, $string_in, 2;
		my @memory = unpack 'v*', $string_in;
		for (@memory) {
			printf "%X", $_
		}
		print " "
	}
}

=end


=cut

my $rom_cnt = 0;

# by default instructions are for all 4 chips to execute
our $CS = 0xF;

sub send_ {
	my ($cmd) = @_;
	my %cmd = %$cmd;
	my $op_cs = $cmd{op} + ($CS << 4);

	my $binary = pack 'vCC', $cmd{I}, $cmd{mem_addr}, $op_cs;
	my $hex = reverse unpack 'h*', $binary;
	#	say "$rom_cnt: data <= 32'h$hex;";
	say $hex;
	$rom_cnt++;
}

sub chip_select {
	my ($new_cs, $sub) = @_;
	local $CS = $new_cs;
	$sub->();
}

sub nop {
	send_
	  { I => 0, mem_addr => 0, op => OP_NOP }
  }

sub loada {
	my ($addr, $flagr, $bsel, $aluc) = @_;
	my $I = 0;
	$I |= $flagr;
	$I |= $bsel << 4;
	$I |= $aluc << 5;
	send_
	  { I => $I, mem_addr => $addr, op => OP_LOADA }
  }

sub loadb {
	my ($addr, $cond, $inv, $alus) = @_;
	my $I = 0;
	$I |= $cond;
	$I |= $inv << 4;
	$I |= $alus << 5;
	send_
	  { I => $I, mem_addr => $addr, op => OP_LOADB }
  }

#sub read_ {
#	my ($addr) = @_;
#	send_ { I => 0, mem_addr => $addr, op => OP_READ, CS => 1 }
#}

sub store {
	my ($addr, $flagw, $edge_, $cube) = @_;
	my $I = 0;
	$I |= $flagw;
	$I |= $edge_ << 7;
	$I |= $cube << 8;
	send_
	  { I => $I, mem_addr => $addr, op => OP_STORE }
  }

sub loadi {
	my ($addr, $I) = @_;
	send_
	  { I => $I, mem_addr => $addr, op => OP_LOADI }
}

sub route {
	my ($addr, $dest_addr, $led) = @_;
	$led //= 0;
	my $I = $dest_addr;
	$I |= $led << 12;
	send_
	  { I => $I, mem_addr => $addr, op => OP_ROUTE }
}

sub storei {
	my ($addr, $I) = @_;
	send_
	  { I => $I, mem_addr => $addr, op => OP_STOREI }
}

sub led {
	my ($addr, $mode, $offset_leds) = @_;
	my $I = $offset_leds;
	$I |= $mode << 4;
	send_
	  { I => $I, mem_addr => $addr, op => OP_LED }
}

sub ledm {
	my ($addr, $offset) = @_;
	$offset //= 0;
	led $addr, 1, $offset;
}

sub ledi {
	my ($leds) = @_;
	led 0, 0, $leds;
}

sub flag_zero { 0 }
sub flag_temp { 7 }

sub flag_news { 8 + $_[0] }

sub alu_select_a {
	0b11110000
}

sub alu_select_b {
	0b11001100
}

sub alu_select_f {
	0b10101010
}

sub alu_zero {
	0
}

sub alu_xor {
	0b10010110
}

sub alu_xnor {
	0b01101001
}

sub alu_of_function (&) {
	my ($fun) = @_;
	my $alu = 0;
	for my $i (0 .. 7) {
		local $a = ($i & 4) >> 2;
		local $b = ($i & 2) >> 1;
		local $_ = $i & 1;
		$alu += ($fun->() ? 1 : 0) << $i;
	}
	$alu
}

sub aluc_add { alu_of_function { ($a + $b + $_) & 2 } }
sub alus_add { alu_of_function { ($a + $b + $_) & 1 } }

sub aluc_addAF { alu_of_function { ($a + $_) & 2 } }
sub alus_addAF { alu_of_function { ($a + $_) & 1 } }

sub alu_or { alu_of_function { $a | $b | $_ } }

sub alu_and { alu_of_function { $a & $b & $_ } }

BEGIN {
	die "alus_add != alu_xor" unless alus_add == alu_xor;
	die "bad alu_select_f" unless alu_select_f == alu_of_function { $_ };
}

sub alu2 {
	my ($aluc, $alus, $addrA, $addrB, $flagr, $flagw, $cond, $inv) = @_;
	loada $addrA, $flagr, 0, $aluc;
	loadb $addrB, $cond, $inv, $alus;
	store $addrA, $flagw, 0, 0;
}

sub alu3 {
	my ($aluc, $alus, $addrA, $addrB, $addrC, $flagr, $flagw) = @_;
	loada $addrA, $flagr, 0, $aluc;
	loadb $addrB, 0, 1, $alus;
	store $addrC, $flagw, 0, 0;
}

sub mov {
	my ($addrA, $addrC) = @_;
	alu3 alu_zero, alu_select_a, $addrA, $addrA, $addrC, flag_zero, flag_zero
}

sub add {
	my ($addrA, $addrB, $addrC, $flag_carry) = @_;
	alu3 aluc_add, alus_add, $addrA, $addrB, $addrC, flag_zero, $flag_carry;
}

sub addC {
	my ($addrA, $addrB, $addrC, $flag_carry) = @_;
	alu3 aluc_add, alus_add, $addrA, $addrB, $addrC, $flag_carry, $flag_carry;
}

sub xor_ {
	my ($addrA, $addrB, $addrC) = @_;
	alu3 alu_zero, alu_xor, $addrA, $addrB, $addrC, flag_zero, flag_zero;
}

sub and_ {
	my ($addrA, $addrB, $addrC) = @_;
	alu3 alu_zero, alu_and, $addrA, $addrB, $addrC, flag_zero, flag_zero;
}

# news_gen face partea de mijloc
# news_[mf][mf] face primul alu3, apeleaza news_gen, apoi face ultimul alu3
sub news_generic {
	my ($nX, $nY, $dest) = @_;
	my %dest = %$dest;
	while ($nX || $nY) {
		my $direction;
		if ($nX > 0) {
			$nX--;
			$direction = 2;
		} elsif ($nX < 0) {
			$nX++;
			$direction = 0;
		} elsif ($nY > 0) {
			$nY--;
			$direction = 1;
		} elsif ($nY < 0) {
			$nY++;
			$direction = 3;
		}
		if ($nX || $nY) { # not the last go
			alu3 alu_select_f, alu_select_a, 0, 0, 0, flag_news($direction), flag_zero
		} elsif (exists $dest{address}) {
			alu3 alu_select_f, alu_select_f, 0, 0, $dest{address}, flag_news($direction), flag_zero
		} elsif (exists $dest{flag}) {
			alu3 alu_select_f, alu_select_a, 0, 0, 0, flag_news($direction), $dest{flag}
		} else {
			die "No destination address nor flag given to [news_generic]\n"
		}
	}
}

sub news_mm {
	my ($addrIN, $addrOUT, $nX, $nY) = @_;
	alu3 alu_select_a, alu_select_a, $addrIN, 0, $addrIN, flag_zero, flag_zero;
	news_generic $nX, $nY, {address => $addrOUT};
}

sub news_mf {
	my ($addrIN, $flagOUT, $nX, $nY) = @_;
	alu3 alu_select_a, alu_select_a, $addrIN, 0, $addrIN, flag_zero, flag_zero;
	news_generic $nX, $nY, {flag => $flagOUT};
}

sub news_fm {
	my ($flagIN, $addrOUT, $nX, $nY) = @_;
	alu3 alu_select_f, alu_select_a, 0, 0, 0, $flagIN, flag_zero;
	news_generic $nX, $nY, {address => $addrOUT};
}

sub news_ff {
	my ($flagIN, $flagOUT, $nX, $nY) = @_;
	alu3 alu_select_f, alu_select_a, 0, 0, 0, $flagIN, flag_zero;
	news_generic $nX, $nY, {flag => $flagOUT};
}

1;
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,
23c26e04 MG	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/;
23c26e04 MG	33
7f1b6bd9 MG	34	my $port;
7f1b6bd9 MG	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/;
46a95fd3 MG	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;";
46a95fd3 MG	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	}
7f1b6bd9 MG	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	}
23c26e04 MG	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	}
23c26e04 MG	139
7f1b6bd9	140	sub route {
46a95fd3 MG	141	my ($addr, $dest_addr, $led) = @_;
46a95fd3 MG	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
7f1b6bd9 MG	325	1;