#-----------------------------------------------------------------------------
# File          : vhdlUcf.pl
# Author        : Ryan Herbst, ryan@amaroq.com
# Created       : 07/29/2004
#-----------------------------------------------------------------------------
# Description:
# This script will generate a Xilinx UCF entries from a top level VHDL file.
# This script is designed to be run from Lemmy. It will insert either the
# pine location entires or the pin type entries.
# This file takes no args from Lemmy. It will read the current line to
# extract the command type and the file name. The command is 'l' for pin
# location and 'i' for pin type.
#-----------------------------------------------------------------------------
# Copyright (c) 2004 by Ryan Herbst. All rights reserved.
#-----------------------------------------------------------------------------
# Modification history:
# 07/29/2004: created.
#-----------------------------------------------------------------------------

# Get current line contents
$Lemmy->GetLineContent(0);
$in = $Lemmy->LineContent;

# Extract command
my @ins = split (/ /,$in);

# Get File Name
my $command = $ins[0];
my $src_file = "$ins[1].vhd";
my $def_tech = $ins[2];

# Open VHDL source file
$res = open(DAT, $src_file);
if ( ! $res ) {
   $Lemmy->DoAddText("Could not open file: $src_file\n",1,1);
   exit;
}
@raw_data=<DAT>;
close(DAT);

# Setup array to store signal name
my @sig_name;

# Variable to track the state
my $state = 0;

# Go through each line in the file
foreach $src_line (@raw_data) {

   # Strip Leading spaces
   $src_line =~ s/^\s*//;

   # Strip Trailing spaces
   $src_line =~ s/\s*$//;

   # Skip all lines starting with a comment or empty lines
   if ( $src_line =~ /^\-\-/ || length($src_line) < 1) { next; };

   # Split the line into words
   @words = split (/ /,$src_line);

   # Are we still looking for the entity declaration
   if ( $state < 5 ) {

      # process each word individually
      foreach $word (@words) {

         # State 0, looking for the word entity
         if ( $state == 0 ) {
            if ( $word =~ /entity/i ) { $state = 1; }
         }

         # State 1, extract entity name
         elsif ( $state == 1 ) {
            $ent_name = $word;
            $state = 2;
         }

         # State 2, look for 'is'
         elsif ( $state == 2 ) {
            if ( $word !~ /is/i ) {
               die("Error. Expecting is and got $word\n");
            }
            $state = 3;
         }

         # State 3, look for 'port'
         elsif ( $state == 3 ) {
            if ( $word =~ /port/i ) {
               $state = 4;
            }
         }

         # State 4, look for '('
         elsif ( $state == 4 ) {
            if ( $word !~ /\(/i ) {
               die("Error. Expecting ( and got $word\n");
            }
            $state = 5;
         }
      }
   }

   # Now we extract port names, assume each port singal declration
   # is on its own line
   elsif ( $state == 5 ) {

      # check for end of port declaration
      if ( $src_line =~ /^\)\;/ ) {
         $state = 6;
      }
      else {

         # Is signal a vector
         if ( $src_line =~ /std_logic_vector\(/ ) {

            # process line
            $tmp_line = $src_line;
            $tmp_line =~ s/.*std_logic_vector\(\s*//;
            $tmp_line =~ s/\s*\);.*//;
            $tmp_line =~ s/downto//;

            # extract numbers
            @nums = split(/ /,$tmp_line);

            # Loop through numbers and add them to signal list
            for ($i = $nums[0]; $i >= $nums[1]; $i-- ) {

               # add signal name
               push(@sig_name,$words[0] . "($i)");

               # is signal the longest name so far?
               if ((length($words[0]) + length("$i") + 2 ) > $sig_len ) {
                  $sig_len = length($words[0]) + length("$i") + 2;
               }
            }
         }

         # not a vector
         else {
            # Get signal name
            push(@sig_name,$words[0]);

            # is signal the longest name so far?
            if ( length($words[0]) > $sig_len ) {
               $sig_len = length($words[0]);
            }
         }
      }
   }
}

# Command is for pin number list
if ( $command =~ /^p$/ ) {

   # Print UCF header
   $Lemmy->DoAddText("#-----------------------------------------------------------------------------\n",1,1);
   $Lemmy->DoAddText("#-------------------------- Pin Location Constraints -------------------------\n",1,1);
   $Lemmy->DoAddText("#-----------------------------------------------------------------------------\n",1,1);
   $Lemmy->DoAddText("# This section contains the pin location constraints for the design\n",1,1);
   $Lemmy->DoAddText("#-----------------------------------------------------------------------------\n",1,1);
   $Lemmy->DoAddText("\n",1,1);

   # Signal list
   foreach $signal (@sig_name) {

      # Start the line
      $out = "NET \"$signal\"";

      # Pad the line
      for ($i=0; $i <= ($sig_len - length($signal)); $i++ ) {
         $out .= " ";
      }

      # Print the rest of the line
      $out .= " LOC = \"\";\n";
      $Lemmy->DoAddText($out,1,1);
   }
}

# Command is for pin number list
elsif ( $command =~ /^s$/ ) {

   # Print UCF header
   $Lemmy->DoAddText("#-----------------------------------------------------------------------------\n",1,1);
   $Lemmy->DoAddText("#-------------------------- IO Standard Constraints --------------------------\n",1,1);
   $Lemmy->DoAddText("#-----------------------------------------------------------------------------\n",1,1);
   $Lemmy->DoAddText("# This section defines the IO types, IO delays and other IO parameters \n",1,1);
   $Lemmy->DoAddText("#-----------------------------------------------------------------------------\n",1,1);
   $Lemmy->DoAddText("\n",1,1);

   # Signal list
   foreach $signal (@sig_name) {

      # Start the line
      $out = "NET \"$signal\"";

      # Pad the line
      for ($i=0; $i <= ($sig_len - length($signal)); $i++ ) {
         $out .= " ";
      }

      # Print the rest of the line
      if ( length($def_tech) < 2 ) {
         $out .= " IOSTANDARD = \"LVCMOS33\";\n";
      }
      else {
         $out .= " IOSTANDARD = \"$def_tech\";\n";
      }
      $Lemmy->DoAddText($out,1,1);
   }
}

else {
   $Lemmy->DoAddText("Unsupported Command\n",1,1);
}