git.rot13.org Git - x300-pci/blob - vhdl-pingen.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4 use autodie;
   5
   6 use Storable;
   7 use Data::Dump qw(dump);
   8
   9 my $sections = 4;
  10
  11 my $file = shift @ARGV;
  12 die "Usage: $0 *.pin2io.storable\n" unless $file;
  13
  14 my $name = $file;
  15 $name =~ s/^.*\///;
  16 $name =~ s/\..+$//;
  17 $name = 'epm' . $name if $name =~ m/^\d+/;
  18
  19 my $pin2io = retrieve($file);
  20 warn "# $= ",dump($pin2io);
  21 my @pin2io = @{ $$pin2io };
  22 warn "# @= ",dump( @pin2io );
  23
  24 my @ports;
  25 my $stat;
  26 my @pin_s;
  27 my @location_assignment,
  28
  29 my $pins_in_section = @pin2io / $sections;
  30 warn "# sections: $sections with $pins_in_section pins each\n";
  31
  32 foreach my $pin ( @pin2io ) {
  33         if ( $pin =~ m/IO(\d+)/ ) {
  34                 my $nr = $1;
  35                 push @ports, "$pin: inout std_logic;";
  36                 my $s = int($nr/$pins_in_section);
  37                 push @pin_s, "$pin <= s$s;";
  38                 $stat->{sections}->{ $s }++;
  39                 push @location_assignment, $nr;
  40         } else {
  41                 push @ports, "-- $pin";
  42         }
  43 }
  44
  45 $ports[$#ports] =~ s/;$//; # remove last semicolumn
  46
  47 print qq{
  48
  49 library ieee;
  50 use ieee.std_logic_1164.all;
  51 use ieee.std_logic_unsigned.all;
  52 entity $name is
  53  port(
  54
  55 }, join("\n", @ports), qq {
  56
  57  );
  58 end $name;
  59
  60
  61 architecture rtl of $name is
  62
  63 signal }, join(", ", map { "s$_" } sort keys %{ $stat->{sections} }), qq{ : std_logic;
  64
  65 begin
  66
  67 };
  68
  69 my @vals = ( 0, 1, 'Z' );
  70 my $i = 0;
  71 foreach my $s ( sort keys %{ $stat->{sections} } ) {
  72         my $v = $vals[$i];
  73         print qq{s$s <= '$v';\n};
  74         $i++; $i = $i % 3;
  75 }
  76
  77
  78 print join("\n", @pin_s), qq{
  79
  80 end rtl;
  81
  82 };#/vhdl
  83
  84 open(my $qsf, '>', $name.'.qsf');
  85 foreach (@location_assignment) {
  86         print $qsf "set_location_assignment PIN_$_ -to IO$_\n";
  87 }
  88