#!/usr/bin/perl
use warnings;
use strict;
use autodie;

use Storable;
use Data::Dump qw(dump);

my $sections = 4;

my $file = shift @ARGV;
die "Usage: $0 *.pin2io.storable\n" unless $file;

my $name = $file;
$name =~ s/^.*\///;
$name =~ s/\..+$//;
$name = 'epm' . $name if $name =~ m/^\d+/;

my $pin2io = retrieve($file);
warn "# $= ",dump($pin2io);
my @pin2io = @{ $$pin2io };
warn "# @= ",dump( @pin2io );

my @ports;
my $stat;
my @pin_s;
my @location_assignment,

my $pins_in_section = @pin2io / $sections;
warn "# sections: $sections with $pins_in_section pins each\n";

foreach my $pin ( @pin2io ) {
	if ( $pin =~ m/IO(\d+)/ ) {
		my $nr = $1;
		push @ports, "$pin: inout std_logic;";
		my $s = int($nr/$pins_in_section);
		push @pin_s, "$pin <= s$s;";
		$stat->{sections}->{ $s }++;
		push @location_assignment, $nr;
	} else {
		push @ports, "-- $pin";
	}
}

$ports[$#ports] =~ s/;$//; # remove last semicolumn

print qq{

library ieee;
use ieee.std_logic_1164.all;
use ieee.std_logic_unsigned.all;
entity $name is
 port(

}, join("\n", @ports), qq {

 );
end $name;


architecture rtl of $name is

signal }, join(", ", map { "s$_" } sort keys %{ $stat->{sections} }), qq{ : std_logic;

begin

};

my @vals = ( 0, 1, 'Z' );
my $i = 0;
foreach my $s ( sort keys %{ $stat->{sections} } ) {
	my $v = $vals[$i];
	print qq{s$s <= '$v';\n};
	$i++; $i = $i % 3;
}


print join("\n", @pin_s), qq{

end rtl;

};#/vhdl

open(my $qsf, '>', $name.'.qsf');
foreach (@location_assignment) {
	print $qsf "set_location_assignment PIN_$_ -to IO$_\n";
}

