#!/usr/local/bin/perl -w
#====================================================================================
# Design unit  : SEUs emulator SPT (Single Event Upset Perl Tool)
#
# File name    : SPT_wires_parser.pl
#
# Purpose      : - This script gives a list of all the wires of every instance  
#                  of a particular desing.
#                - It also sets the number of inputs/signals of each instance in 
#                  the corresponding column of all_instances.dat.
#                - It works with the files that come out of modelsim after  
#                  running the following commands:
#                  .signals.tree expandall -1 and
#                  .signals.tree write filename
#
# 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
#  - Minor changes to make it compliant with revision 1.2 of SST_list_instances.pl
#
###Revision 1.3	25/11/04 --DGG
#====================================================================================

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

#----------------------------------------------------------------------------
# My variables
#----------------------------------------------------------------------------                    

my($ai_line);
my($wir_file);  # file with extension: $wire_files_ext (defined in SST_config.tcl)
my($level_number);
my($total_number);
my($tree_line);
my($sig_file);  # file with extension: .sig 
my($wire_name);

my($sec,$min,$hour,$mday,$mon,$year,undef,undef,undef) = localtime(time);
$year += 1900;

my(@fields);
my(@levels);
my(@wire_path);
my(@sublevel_on);

my($control_f_dir) = File::Spec->catdir('./SST', 'control_files');
my($wire_f_dir) = File::Spec->catdir('./SST', 'wire_files');
my($all_instances_dat) =  File::Spec->catfile($control_f_dir, "all_instances.dat");
my($all_instances_tmp) = File::Spec->catfile($control_f_dir, "all_instances.tmp");
my($log) = File::Spec->catfile($control_f_dir, "all_wires_parser.log");
#----------------------------------------------------------------------------
# Script body
#----------------------------------------------------------------------------                  

open (LOG, ">$log") or die "can't open $log: $!";
print(LOG "-- all_wires_parser.pl script run, started on $mday/$mon/$year at ");
printf (LOG "%02d%s%02d%s%02d\n","$hour",":","$min",":","$sec");

# for each module instantiated in the design, open the .sig file
# and convert it to .in/.out file.

open (AI, "<$all_instances_dat") or die "unable to open $all_instances_dat: $!";
open (AI_TMP, ">$all_instances_tmp") or die "unable to open $all_instances_tmp: $!";

print ("\n Reading .sig files and creating .$wire_files_ext files...");
while ($ai_line = <AI>) {
  if ($ai_line !~ /(^n|^y)/i) {        
   print (AI_TMP $ai_line); 
   next;
  } 
  @fields = split (' ',$ai_line);
      
  $sig_file = File::Spec->catfile($wire_f_dir, "$fields[1]\.sig");
  $wir_file = $sig_file;
  $wir_file =~ s/\.sig/\.$wire_files_ext/;
  if (!open (SIG_FILE, "<$sig_file")) {
    # In case that no wires are left from the masking done in the startup_madro, remove
    # this line from all_instances.dat
    print (LOG "\n---Warning: The instance $fields[1] has no wires available to be forced\n");
    print (LOG "            It is being removed from all_instances.dat\n");
    next
  }  
  open (WIR_FILE, ">$wir_file") or die "unable to open $wir_file: $!";
  printf (WIR_FILE "%-10s %-30s %-8s\n\n","Force","Name","\@Time");
  
  $total_number = 0;
  @wire_path = ();
  while ($tree_line =<SIG_FILE>) {
    @fields = split('=',$tree_line);
    # $fields[0] = wire name
    # $fields[1] = wire value
    (@levels) = ($fields[0] =~ /\t/g);
    $level_number = @levels;
    $fields[0] =~ s/(\t| )//g; #remove tabs and white spaces
    # new wire or sub-wire found
    if ($fields[1] =~ /\{/) {
      $wire_path[$level_number] = $fields[0];
      $sublevel_on[$level_number]  = 1;
    }
    else {
      # process main wires
      if ($level_number == 0) {
        printf (WIR_FILE "%-10s %-30s %-8s\n","No","$fields[0]","0$reference_unit");
        $sublevel_on[$level_number] = 0;
        $total_number +=1 ;
      }
      # process sub-wires
      else {
        next if (($fields[0] =~ /\(/) && (!$sublevel_on[$level_number-1]));
	$wire_path[$level_number] = $fields[0];
	$wire_name= "";
	for ($i = 0; $i <= $level_number; $i++) {
	  $wire_name = $wire_name."$wire_path[$i]";
	}  
	printf (WIR_FILE "%-10s %-30s %-8s\n","No","$wire_name","0$reference_unit");
        $sublevel_on[$level_number] = 0;
        $total_number +=1 ;
      }
    }  
  }    
  close (SIG_FILE);
  close (WIR_FILE);
  unlink $sig_file;
  # introduce the number of inputs/signals of each instance in all_instances.dat
  @fields = split (' ',$ai_line);
  printf (AI_TMP "%-6s %-60s %-16s %-85s\n","$fields[0]","$fields[1]","$total_number","$fields[3]" );
}
print ("done\n");
close (AI);
close (AI_TMP);

if (!rename ($all_instances_tmp, $all_instances_dat)) {
  print ("\n### Error: Unable to rename the file $all_instances_tmp\n");
  die   ("      The file $all_instances_dat might be in use by another aplication");
}

