#!/usr/local/bin/perl -w
#====================================================================================
# Design unit  : SEUs Simulation Tool (SST)
#
# File name    : SST_list_instances.pl
#
# Purpose      : - This script gives a list of all the instances that can be found in 
#                  our design (all_instances.dat).
#                - It works with the file that come out of modelsim after running
#                  .structure.tree expandall -1 and
#                  .structure.tree write filename
#                  which we call hiearchy.dat
#
# Authors      : Daniel González Gutiérrez TEC-EDM
#
# Contact      : mailto:microelectronics@estec.esa.int
#                http://www.estec.esa.int/microelectronics
#
# Copyright (C): European Space Agency (ESA) 2004. No part may be reproduced
#                in any form without the prior written permission of ESA.
#
# Disclaimer   : All information is provided "as is", there is no warranty that
#                the information is correct or suitable for any purpose,
#                neither implicit nor explicit. This information does not
#                necessarily reflect the policy of the European Space Agency.
#====================================================================================
#====================================================================================
# Revision control
# 
###Version 1.0	31/10/03 --DGG
#
###Revision 1.1	22/03/04 --DGG
#
###Revision 1.2	27/07/04 --DGG
#  - Removed the creation of a directory structure to store the wire files. Now all 
#    the files are stored in the same place (under /wire_files). If several instances 
#    have the same name, a ‘-n#’ will be appended at the end of the file name, from 
#    the second occurrence on, where # holds the number of repetitions 
#  - File names are added to every line of all_instances.dat
#  - If an instance name has any of the following characters: \/:*?"<>| they will be
#    replaced by '-' when giving a name for its corresponding file (the instance full
#    path column will keep the original characters.
#
###Revision 1.3	25/11/04 --DGG
#====================================================================================

#----------------------------------------------------------------------------
# Imported modules
#---------------------------------------------------------------------------- 
use File::Spec;       # This module allows us to use some methods to avoid 
                      # differentdirectory naming convention in Windows 
                      # and Unix.
use lib "./SST/control_files"; 
use SST_perl_package; # $wire_files_ext is defined here

#----------------------------------------------------------------------------
# My variables
#----------------------------------------------------------------------------                    
my($current_level) = 0;
my($current_path) = "";
my($difference);
my($hierarchy_line);
my($instance_full_name) = "";
my($new_level);
my($new_instance);
my($old_instance);

my(@levels);

my (%file_names); #this hash keeps all the names given to the instance files

# Assign variables to directory names 
my($control_f_dir) = File::Spec->catdir('./SST', 'control_files');
my($all_instances) = File::Spec->catfile($control_f_dir, "all_instances.dat");

#----------------------------------------------------------------------------
# Script body
#----------------------------------------------------------------------------                  

if (defined ($ARGV[0])) {
  open (HIERARCHY, "<$ARGV[0]") or die "unable to open $ARGV[0]: $!";
  open (ALL_INSTANCES, ">$all_instances");
  print ("\n Building all_instances.dat...");
  printf (ALL_INSTANCES "%-6s %-60s %-16s %-85s\n\n","Force","File name","# wires","Instance full path");
  while ($hierarchy_line =<HIERARCHY>) {
    (@levels) = ($hierarchy_line =~ /\t/g);
    $new_level = @levels;
    if ( ($hierarchy_line =~ /(.+):/) ||
         ($hierarchy_line =~ /Generate (\w+)/) ){    
      $new_instance = $1;
      $new_instance =~ s/\t//g; #remove tabs
      if ($new_level > $current_level) {
        $current_path = $old_instance;
      }
      elsif ($new_level == $current_level) {
        ;
      }
      else {
        $difference = $current_level - $new_level;
        # difference will be >1 when finding generate clauses
        for ($i = 0; $i < $difference; $i++) {
          ($current_path) = $current_path =~ /(\/.+)\//;
        }
      }
                  
      # update values
      $instance_full_name = $current_path."/$new_instance";
      $current_level = $new_level;
      $old_instance = $instance_full_name;
      
      # Set the name of the wire file
      $new_instance =~ s/[\/\\:\*\?\"<>\|]/-/g; #substitute all the not supported charaters with a '-'
      if (defined ($file_names{$new_instance}) ) {
        $new_file_name = find_a_name ($new_instance);
      }
      else { 
        $new_file_name = $new_instance;
      }
      $file_names{$new_file_name} = "";
      
      # print the instance name in all_instances.dat
      if ($hierarchy_line =~ /.+:/) {
        printf (ALL_INSTANCES "%-6s %-60s %-16s %-85s\n","No","$new_file_name","unknown","$instance_full_name");
      } 
    }
    else {
    next;
    }
  }
  close (HIERARCHY);
  close (ALL_INSTANCES);
  print ("done\n");

}
else {
  die ("### Error: No input hierarchy file specified\n");
}  

#----------------------------------------------------------------------------
# Subroutines from here down
#----------------------------------------------------------------------------
#----------------------------------------------------------------------------
# find_a_name
# This subroutines gives a new name for an instance which name is already
# assigned. It appends -n# to the original file name, where # is the ordinal
# number corresponding to the new name assignment.
#----------------------------------------------------------------------------
sub find_a_name {
  my($base_name) = @_;
  my($number) = 1;
  my($given_name);
  
  $given_name = $base_name;
  while (defined($file_names{$given_name})) {
    $given_name = $base_name."-n$number";
    ++$number; 
  }
  return $given_name;
}  