#!/cadappl/perl/5.004/bin/perl -w
#!/usr/bin/perl -w
#######################################################################
# ID: veri_spec.pl,v 1.0 2001/10/30
# Author : Yu-wen Pang/Timo Schuering
# ---------------------------------------------------------------------#
#
# Disclaimer: Use this script at your own risk 
#
#######################################################################
# Default Variables

chomp($PROGRAM=`basename $0`)   ;
$MI="(${PROGRAM}) Info    : "   ;
$MW="(${PROGRAM}) Warning : "   ;
$ME="(${PROGRAM}) Error   : "   ;
$MS=" " x length($MW)           ;
$DATE=`date` ;
$LOG="${PROGRAM}.log"           ;
chomp($PDIR=`dirname $0`)       ;

#######################################################################
use FileHandle ;

#######################################################################
%PCB= () ; # Program Control Block
%RMF= () ; # Scratch Table to check if modules inside netlist
%VFT= () ; # 5 - dimensional table for verilog files,modules,references
$PCB{SPEC} = 1 ;
$PCB{BUSDET} = 1 ;
#######################################################################
# Subprogram Definition
#######################################################################
#
# ---------------------------------------------------------------------
# COMMAND_LINE
# ---------------------------------------------------------------------
# Inputs : @ARGV
# Return : None
# Change : PCB{ }
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Descr. : This subprogram allows parsing for fixed position parameters,
#          simple switches and switch prefixed parameters
######################################################################
sub command_line
{ 
 $fix = 0 ; #Zähler für Parameter in Command_line

 while ($ARG= shift @ARGV )

{  #if ( $PCB{DEBUG} ) { print "Processing Input Paramter $ARG\n" } ;

     
	if ( $ARG =~ /^(-h|-help|--help)$/ )
		{ last; }

	elsif ($ARG=~/(-verilog|-mifspec|-script)$/)
		{ $tmp_arg = shift @ARGV;
		  if ($tmp_arg=~/(.+\.v|.+\.mif)$/) {$fix+=1;}

		  if ($tmp_arg=~/.+\.v$/ && $ARG=~/-verilog$/)
			{$PCB{"VERILOG_FILE"}=$tmp_arg;}

		  elsif ($tmp_arg=~/.+\.mif$/ && $ARG=~/-mifspec$/)
			{$PCB{"MIFSPEC_FILE"}=$tmp_arg;}

		  elsif ($tmp_arg=~/.+\.pl$/ && $ARG=~/-script$/)
			{$PCB{"SCRIPT_FILE"}=$tmp_arg;}

		  else {print"$tmp_arg : Ungültige bzw. unpassende Datei!\n";$ARG="-h";last;}
		}
	else {print "$ARG : ungültige Option!!\n"; $ARG="-h";last;}
  
 }

#print "ARGV=@ARGV, ARG=$ARG\n";

 if ($fix==0 || $fix!=2 || $ARG =~/^(-h|-help|--help)$/ )

      { print"\n\n";
        print "$MI This program compares a verilognetlist against\n",
              "$MS a hardware input/output specification provided\n",
              "$MS as Maker Interchange Format file.             \n",
              "$MS It will check consistancy between I/O-signal  \n",
	      "$MS names, bus-sizes and buffer types.            \n",
              "\n",
              "$MS To invoke, type: \n",
              "$MS $PROGRAM -verilog Verilog-NL -mifspec HWIO-Spec\n",
	      "$MS          -script Perl-Script                   \n",
              "\n",
              "$MS Flags: -help              | Help\n",
	      "\n\n",
	      "$MS Possible Problems :                            \n",
	      "$MS Assign statements can not be processed.        \n",
	      "$MS Quoting of #-Characters leads to problems in   \n",
	      "$MS script files.                                \n\n";

        exit 1;        
      }

 foreach $file (values (%PCB))
	{ if ($file=~/.+\.\w+/)
		{ -e $file || die "$file : $!";
		}
	}

 }


#######################################################################

@verilog_keywords = (
                    "assign"   , 
                    "endmodule",
                    "inout"    ,
                    "input"    ,
                    "module"   ,
                    "output"   ,
                    "wand"     ,
                    "wire" 
                   ); 

# ======================================================================
# FUNCTION  KEYWORD ( <string-argument> )
# ======================================================================
# Returns 1 if the string argument is a verilog keyword,otherwise 0
#-------------------------------------------------------------------------

sub keyword {

 foreach $word ( @verilog_keywords ) {
  if ( $word eq $_[0] ) { return 1 ; }
  }
  return 0 ;
}


# ======================================================================
# FUNCTION update_RMF ( <module name> )
# ======================================================================
# Iterates over the to be Removed Modules Found  Array and Compares 
# it with the given module name argument. If equal, the corresponding
# entry gets an 1 to remember it was found

# This function is used to check modules to be removed really exist

sub update_RMF {

for $RM (keys(%RMF)) {
 if ( $RM eq $_[0] ) 
   {
    $RMF{$RM} = 1 ;
   }
 }
}

# ======================================================================
# FUNCTION check_RMF
# ======================================================================
# Iterates over the to be Removed Modules Found  Array and returns 
# a string containing the names of all modules not yet found.        
# If all modules are found it return the null string

# This function is used to check modules all modules are found and to
# report those not found inside the netlist


sub check_RMF {

$nfm = "" ;

for $RM (keys(%RMF)) {
 #  print "$RM ? $RMF{$RM} \n" ;
  if ( $RMF{$RM} == 0 ) {
    $nfm = $nfm . " " .  $RM ;
  }
}
 return $nfm ;
}


# ======================================================================
# FUNCTION read_verilog_netlist
# ======================================================================
# Reads the verilog netlist from the STDIO and creates associative 
# arrays containing all modules and their submodules
#-----------------------------------------------------------------------
# Input : Verilog Netzliste
# Return : none
# Change : %VFT


sub read_verilog_netlist {

$module_name     = "" ; 
$in_module       =  0 ; ## module_status initialisieren
$module_number   =  0 ; ## Zähler für verarbeitete Module

$FILE_PTR = FileHandle-> new ;

## wenn kein Name von Verilog Netzliste in Command-line eingegeben ist,
if   (!defined($_[0])) 
 { 
   $VNLF_name = "-"             ;
   $tmp_msg   = "from <stdin> " ;  ## wird einer von Standard-Eingabe
#                                     erfordert.  
} 
else                   
 {
  $VNLF_name = $_[0]         ; 
  $tmp_msg = "from $_[0] "   ; 
 }

 open($FILE_PTR,"$VNLF_name") || die "cannot open $VNLF_name for reading:$!";
 print "$MI Scanning Modules $tmp_msg...\n" ;

## wenn ein Module verarbeitet ist, wird ein "." im Bildschirm gezeigt.
$col   = 1 ;

#
# assemble parts closing with ; or endmodule
# --------------------------------------------
#
$SECTION_START = "" ;
while (1) {
 $SECTION = $SECTION_START ;
 while(1) { 
  if (eof($FILE_PTR)) {
    last ;
  }
  $LINE = <$FILE_PTR> ;
  #remove newline and whitespaces
  chomp($LINE) ; 
  # discard comments
  $LINE =~ s/\/\/.*$// ;
  $LINE =~ s/ +\[/\[/g   ; 
### Section suchen ### 
### sucht in jeder Zeile solange, bis ";" oder "endmodule" vorkommt.
  if ($LINE =~ /;|(endmodule)/ ) {
   $SECTION = $SECTION . $` . $& ;
   $SECTION_START = $' ;
   last ;
  } else {
   $SECTION = $SECTION . $LINE   ;
  }
 }
 if (eof($FILE_PTR)) {
  last ;
 }
# print LOG_FP  "$SECTION\n" ;
 $_ = "$SECTION\n" ;
#### Verarbeitung einer Section #### 
 if ( /([^A-Za-z0-9]|^)module[ ]+([^( ]+)[ ]+\(/ ) {
## wenn einer Module-Def. begegnet,
  $module_name = $2    ;
  $toplevel    = $2    ;
## dann speichert den Module-Name in VFT.
  $VFT{$VNLF_name}{modules}{$module_name}{name}{"-"}       = $module_name ;
  $in_module   = 1     ;## turn on Module-Status
  $in_port_map = 0     ;## Bei Verarbeitung von Submodule wird 
                        ## der in_port_map-Status angeschaltet.
  update_RMF($module_name)       ;

  $module_number ++      ; ## zählt, wieviele Module-Def. verarbeitet ist.
 ##zeigt im Bildschirm,dass das Programm bei Module-Def.arbeitet.
  syswrite(STDOUT,".",1) ;
  $col++ ; if ( $col > 79) { $col = 1 ; print "\n" ; }
 }

 if ($in_module && $PCB{SPEC} ) {
### sucht keyword "input" und speichert input-ports
  if ( s/^ *input *// || $in_input_list) {
   $in_input_list = 1 ;
   while( s/(\[([0-9]+):([0-9]+)\])? *([A-Za-z0-9_\\\[\]]+)// ) {
    # print "Input : $&\n" ;
    if (!defined($1)) {
## wenn $1 nicht vorhanden ist, dann ist das kein Busport.
##speichern Name und Direction     
     $VFT{$VNLF_name}{modules}{$module_name}{ports}{$4} = "in" ;
    } else {## speichern Name, Direction und Index von dem Busport.
     $VFT{$VNLF_name}{modules}{$module_name}{busports}{$4}{HI} = $2   ;
     $VFT{$VNLF_name}{modules}{$module_name}{busports}{$4}{LI} = $3   ;
     $VFT{$VNLF_name}{modules}{$module_name}{busports}{$4}{DN} = "in" ;
    }
    s/ *[;,] *// ;
    if ($& =~ /;/) { $in_input_list = 0 ; }
## input-Section ist zum Ende
   }
  }
### sucht keyword "output" und speichert die Output-ports.
  if ( s/^ *output *// || $in_output_list) {
   $in_output_list = 1 ;
   while( s/(\[([0-9]+):([0-9]+)\])? *([A-Za-z0-9_\\\[\]]+)// ) {
    # print "Output : $2\n" ;
    if (! defined($1)) {
     $VFT{$VNLF_name}{modules}{$module_name}{ports}{$4} = "out" ;
    } else {
     $VFT{$VNLF_name}{modules}{$module_name}{busports}{$4}{HI} = $2    ;
     $VFT{$VNLF_name}{modules}{$module_name}{busports}{$4}{LI} = $3    ;
     $VFT{$VNLF_name}{modules}{$module_name}{busports}{$4}{DN} = "out" ;
    }
    s/ *[;,] *// ;
    if ($& =~ /;/) { $in_output_list = 0 ; }
   }
  }
## Output-Section ist zum Ende
## sucht keyword "inout" und speichert die inout-ports.
  if ( s/^ *inout *// || $in_inout_list) {
   $in_inout_list = 1 ;
   while( s/(\[([0-9]+):([0-9]+)\])? *([A-Za-z0-9_\\\[\]]+)// ) {
    # print "Output : $&\n" ;
    if (!defined($1)) {
     $VFT{$VNLF_name}{modules}{$module_name}{ports}{$4} = "inout" ;
    } else {
     $VFT{$VNLF_name}{modules}{$module_name}{busports}{$4}{HI} = $2 ;
     $VFT{$VNLF_name}{modules}{$module_name}{busports}{$4}{LI} = $3 ;
     $VFT{$VNLF_name}{modules}{$module_name}{busports}{$4}{DN} = "inout" ;
    }

    s/ *[;,] *// ;
    if ($& =~ /;/) { $in_inout_list = 0 ; }
   }
  }

## sucht keyword "wire" und speichert wire-Namen
  if ( s/^ *wire *// || $in_wire_list)  {
   $in_wire_list = 1 ;
   while( s/[A-Za-z0-9_\\\[\]]+// ) {
    # print "Wire : $&\n" ;
    $VFT{$VNLF_name}{modules}{$module_name}{wires}{$&} = $& ;
    s/ *[;,] *// ;
    if ($& =~ /;/) { $in_wire_list = 0 ; }
## wire-Section ist zum Ende
   } 
  }

  }

#### Submodule verarbeiten ####
  if ($in_module) {

## sucht instances
  if (/([A-Za-z0-9][A-Za-z0-9_]*)[ ]+(\\?[A-Za-z0-9][A-Za-z0-9_\[\]]*)[ ]*[(]/) {
    if ( !keyword($1) and !keyword($2) ) { 
      $VFT{$VNLF_name}{modules}{$module_name}{references}{$1} = $1 ;
      $instance_name = $2 ;
##speichert Instance-Name und den ref.Module
      $VFT{$VNLF_name}{modules}{$module_name}{instances}{$instance_name}{reference} = $1 ;
      $in_port_map = 1 ;
    }
  }
  }
  # There are port maps with and without bussed assignments

  if ($in_module && $in_port_map && $PCB{SPEC}) {
      s/ *\( *// ;
      # Port Maps speichern
      while( s/\.([A-Za-z0-9_]+) *\( *(([A-Za-z0-9_\\\[\]]+)|(\{[^\}]+\})) *\)// ) {
       # print "Lib-Pin:$1 \n" ;
       if (defined($3)) {
        $VFT{$VNLF_name}{modules}{$module_name}{instances}{$instance_name}{port}{$1} = $3 ;  
       } else {
        $VFT{$VNLF_name}{modules}{$module_name}{instances}{$instance_name}{busport}{$1} = $4 ;       
       }
       s/ *, *//   ;
       s/ *\) *;// ;
       if ($& =~ /;/) { $in_port_map = 0 ; }
## Eine instance-Section ist zum Ende
      }
 }


 if ( /endmodule/ ) { ## Eine module-Def. ist zum Ende
  $in_module = 0 ;
 }

 }

 if ($col > 1) { $col = 1 ; print "\n" ; }

 print "$MI $module_number fonts processed.. ? Ahhhmmm, modules of course.\n" ;
 print LOG_FP "$MI $module_number modules processed.\n" ;
}


# ======================================================================
# FUNCTION compress_modules
# ======================================================================
# Iterates over the Module Table and delete leaf modules by
# searching for each submodule whether it is defined a module
# in the overall module table
#-----------------------------------------------------------------------
# Input : Name von Verilog Netzliste
# Return : none
# Change : %{$VFT{$VNLF_name}{"modules"}{$module_name}{"references"}}

sub compress_modules {

 print "$MI Compressing Modules ...\n" ;
 print LOG_FP "$MI Compressing Modules ...\n" ;


 if   (!defined($_[0])) 
 { 
   $VNLF_name = "-"             ;
 } 
 else                   
 {
  $VNLF_name = $_[0]         ; 
 }

 for $M (keys(%{$VFT{$VNLF_name}{modules}})) {
   syswrite(STDOUT,".",1) ;
   $col++ ; if ( $col > 79) { $col = 1 ; print "\n" ; }

## im Module $M alle submodule ausnehmen
   for $R (keys(%{$VFT{$VNLF_name}{modules}{$M}{references}})) {
    $is_leaf = 1 ;
    for $DM (keys (%{$VFT{$VNLF_name}{"modules"}})) {
     if ($R eq $DM) {## vergleicht mit allen Haupt-module-Namen, wenn gleich.
      $is_leaf = 0 ; ## dann $R ist nicht leaf_cell.
      last ;
     }
    }
    if ($is_leaf) { 
     $leaf_cells{$R} = $R ; 
     delete $VFT{$VNLF_name}{"modules"}{$M}{"references"}{$R} ;
    }
   }
  }

 if ($col > 1) { $col = 1 ; print "\n" ; }

}


# ======================================================================
# FUNCTION get_all_modules ( <module-name> )
# ======================================================================
# Recursively finds all modules hierarchically below the given
# module argument and combines them into the returned string.
# If no module is found, an empty string is returned

sub get_all_modules {

 my $module_list = $_[0] ;
 my $module_name = $_[0] ;
 my $submod_list = ""    ;
 my $M ;
  
 $VNLF_name = "-" ;

 for $M (keys(%{$VFT{$VNLF_name}{modules}{$module_name}{references}}))  
 {
  $submod_list = get_all_modules ( $M ) ;
  $module_list = $module_list . " " . $submod_list ;
 }

 return $module_list ;
}

#======================================================================
# FUNCTION get_leaf_cells
#======================================================================
# Find the first leaf cells attached to a port by recursively
# diving into hierarchical cells
#----------------------------------------------------------------------
# Input : 1.Name einer Verilog-Netzliste 
#         2.der letzte von read_verilog_netlist eingelesene Module-Name
#         ($toplevel)
#         3.Ports in $toplevel
# Return : leaves-liste
# Change : none

sub get_leaf_cells  {

 my $POINT   ; #für eingegangenen Port
 my @POINTA  ;
 my $I       ;
 my $CELL    ; #für Instance-Name
 my $IPORT   ; #für Port-Name in einem Cell
 my $REFN    ; #für Moduletyp-Name von einem Cell
 my $MODUL   ; #für den Module-Name, den die Funktion read_verilog_netlist
#               am letzten eingelesen hat
 my $LEAVES  ; #für leaf-cells-liste, in der jede mit Parameter $P in 
#               Netzliste verbunden ist.
 my $BUSNAME ;
 my $BUSINDX ;
 my $SIGNAL  ;
 my $BUSSIGNALS ;
 my $INDEX   ;

 $VNLF_name = $_[0] ; 
 $POINT     = $_[2] ;
 $POINT     =~ s/ //g ;
 $MODUL     = $_[1] ;
 $MODUL     =~ s/ //g ;
 $LEAVES    = ""     ;
  
 if ($POINT eq "") { return "" } ;
 
 $BUSNAME  = "" ;
 $BUSINDX  = "" ;
 
 if ( $POINT =~ /([A-Za-z0-9_]+)\[([0-9]+)\]/ ) {
  $BUSNAME = $1 ;
  $BUSINDX = $2 ; 
  # print "bn $BUSNAME ; bi $BUSINDX\n" ;
 }


 @POINTA = split(/\//,$POINT)    ;
 # print "$#POINTA @POINTA[$#POINTA]\n" ;
 for ($I = 0; $I <= $#POINTA ;$I++) {
  for $CELL (keys(%{$VFT{$VNLF_name}{modules}{$MODUL}{instances}})) {
   # print "Checking cell $CELL\n" ;
   # ------------------ check single portmaps --------------------------------
   for $IPORT  (keys(%{$VFT{$VNLF_name}{modules}{$MODUL}{instances}{$CELL}{port}})) {
     if ($IPORT eq "") {
       next ;
     }
    # print "IPIN:" . $VFT{$VNLF_name}{modules}{$MODUL}{instances}{$CELL}{port}{$IPORT} . " == " . $POINT . " ?\n" ;
    if ( $VFT{$VNLF_name}{modules}{$MODUL}{instances}{$CELL}{port}{$IPORT} eq $POINTA[$I]) {
      $REFN = $VFT{$VNLF_name}{modules}{$MODUL}{instances}{$CELL}{reference} ;
      $S = sprintf("%15s : %-20s => %-30s,%-20s,%-20s\n",
                   $MODUL,$POINT,$CELL,$REFN,$IPORT) ;
      # print $S ;

      if ( exists($VFT{$VNLF_name}{modules}{$REFN})) {
       # print "Cell $REFN is hierarchical.\n" ;
       $LEAVES = $LEAVES . " " . get_leaf_cells($VNLF_name,$REFN,$IPORT) ;  
       next ;
      }
      $LEAVES = $LEAVES . " " . $REFN ;
      next ;
    }
    if ( $VFT{$VNLF_name}{modules}{$MODUL}{instances}{$CELL}{port}{$IPORT} eq $BUSNAME ) {
      $REFN = $VFT{$VNLF_name}{modules}{$MODUL}{instances}{$CELL}{reference} ;
      $S = sprintf("%15s : %-20s => %-30s,%-20s,%-20s [%d]\n",
                   $MODUL,$POINT,$CELL,$REFN,$IPORT,$BUSINDX)         ;
      # print $S ;

      if ( exists($VFT{$VNLF_name}{modules}{$REFN})) {
       # print "Cell $REFN is hierarchical.\n" ;
       $LEAVES = $LEAVES . " " . get_leaf_cells($VNLF_name,$REFN,$IPORT . "[$BUSINDX]") ;  
       next ;
      }
      $LEAVES = $LEAVES . " " . $REFN ;
      next ;
    }
   }
   # ----------- check bussed portmaps ------------------------------------------
   for $IPORT  (keys(%{$VFT{$VNLF_name}{modules}{$MODUL}{instances}{$CELL}{busport}})) {
    $BUSSIGNALS = $VFT{$VNLF_name}{modules}{$MODUL}{instances}{$CELL}{busport}{$IPORT}  ;
    $BUSSIGNALS =~ s/([{] *)|( *[}])//g ;
    $BUSSIGNALS =~ tr/,/ /   ;
    $BUSSIGNALS =~ s/ +/ /g  ;
    
    $INDEX  = 0 ; 
    foreach $SIGNAL ( split(/ /,$BUSSIGNALS) ) {
     # print "BUssigs : $SIGNAL\n" ;
     $INDEX = $INDEX + 1           ;
     if ($SIGNAL eq $POINTA[$I]) {
      $REFN = $VFT{$VNLF_name}{modules}{$MODUL}{instances}{$CELL}{reference} ;
      if ( exists($VFT{$VNLF_name}{modules}{$REFN})) {
       # print "Cell $REFN is hierarchical.\n" ;
       $INDEX = $VFT{$VNLF_name}{modules}{$REFN}{busports}{$IPORT}{HI} - $INDEX + 1 ;
       $LEAVES = $LEAVES . " " . get_leaf_cells($VNLF_name,$REFN,$IPORT . "[$INDEX]")   ;  
       next ;
      }
      $LEAVES = $LEAVES . " " . $REFN ;
      next ;
     }
    }
   }
  }  
 }
 $LEAVES =~ s/^ *//;
 return $LEAVES ;
}
#======================================================================================
# FUNCTION process_verilog_netlist
#======================================================================================
# Store Relevant Netlist Information in Comparison DB
#--------------------------------------------------------------------------------------
# Input : Name von Verilog-Netzliste / $toplevel 
# Return : none
# Change : %CMP{"VNL"}

sub process_verilog_netlist  {

  my $toplevel  ;
  my $I         ; # Index
  my $LI        ; # LowIndex
  my $HI        ; # HighIndex
#  my $BN        ; 
# my $BI        ;
  my $P         ; # Port
  my $DN        ; # DirectioN
  my $BUSPORT   ;

  $toplevel  = $_[1] ;
  $VNLF_name = $_[0] ;

# von %VFT die Ports-Namen und Direction herausziehen und in %CMP{"VNL"}
# speichern
   print "$MI Processing Verilog module $toplevel ...\n" ;
  for $P (sort (keys(%{$VFT{$VNLF_name}{modules}{$toplevel}{ports}}))) {
    $DN = $VFT{$VNLF_name}{modules}{$toplevel}{ports}{$P} ;
    $CMP{"VNL"}[0]{port}{$P}{DN} = $DN ;
    $LEAVES = get_leaf_cells($VNLF_name,$toplevel,$P) ;
    foreach $leaf (split(/ /,$LEAVES)) {
       $CMP{"VNL"}[0]{port}{$P}{BF}{$leaf} = 0 ; 
    }
  }
# von %VFT die Busorts-Namen Index und Direction herausziehen und in
# %CMP{"VNL"} speichern
  for $BUSPORT (sort(keys(%{$VFT{$VNLF_name}{modules}{$toplevel}{busports}}))) {
    $LI = $VFT{$VNLF_name}{modules}{$toplevel}{busports}{$BUSPORT}{LI} ;
    $HI = $VFT{$VNLF_name}{modules}{$toplevel}{busports}{$BUSPORT}{HI} ; 
    $DN = $VFT{$VNLF_name}{modules}{$toplevel}{busports}{$BUSPORT}{DN} ; 
# Bus Expansion
    for ($I = $LI ; $I <= $HI ; $I ++ ) {
     $CMP{"VNL"}[0]{port}{$BUSPORT     . "[$I]"}{DN} = $DN             ;
     $LEAVES = get_leaf_cells($VNLF_name,$toplevel,$BUSPORT . "[$I]")  ;
     foreach $leaf (split(/ /,$LEAVES)) {
       $CMP{"VNL"}[0]{port}{$BUSPORT . "[$I]"}{BF}{$leaf} = 0 ; 
     }
    }
  }
}


#==========================================================================
# FUNKTION : delete_mif_struct
#==========================================================================
# Descr. : vermeiden, diegleiche, eingebettete Struktur aus allen anderen 
#          Strukturen mitzuzählen.
#--------------------------------------------------------------------------
# Input : %MIF_LEARN_STRUCT, $QITEM_PATH ..
# Return : 1 oder 0, wenn nichts getilgt ist.
# Change : %MIF_LEARN_STRUCT

sub  delete_mif_struct {

 my $STRUCT ;
 my $r      ;

 $STRUCT = $_[0] ;
 $PATH   = $_[1] ;
 $r      = 0     ;

# Die Ebenen, die tiefer als aktuelle $ITEM_PATH (Ebene) sind, werden gelöscht.
#------------------------------------------------------------------------------
 foreach $KEY (keys %{$STRUCT}) {
  if ( $KEY =~ /$PATH/ ) {
    delete $STRUCT->{$KEY} ;
    $r = 1 ;
   }
 }
 return $r ; 
}
#============================================================================
# FUNKTION : learn_mif_structure
#============================================================================
# The purpose of this procedure is to prepare the data structures
# to store the contents of the MIF file
# The function has to distinguish arrays,structures and records 
#
# Eg., ColorCatalog is a collection of several color - blocks
# The  Color - block itself consists of records.
# Thus, the derived datstructure would be
#
# $MIF_DB{ColorCatalog}[$n]{Color}{ColorTag} 
#                                 {ColorCyan} 
#                                 {ColorMagenta} 
#                                 {ColorYellow}  
#                                 {ColorBlack}   
#                                 {ColorAttribute}[$n] 
#---------------------------------------------------------------------------
# Input : mif Datei ohne Kommentar
# Return : 1
# Change : %MIF_STRUCT / %MIF_LEARN_STRUCT

sub learn_mif_structure {

open(MIFFILE_PTR,"$PCB{MIFSPEC_FILE}.stripped")||die "cannot open $PCB{MIFSPEC_FILE}.stripped:$!";


$INDENT_LEVEL = 0 ;  #eingerückte bzw. aktuelle Ebene
$LAST_INDENT_LEVEL = 0  ;  #letzte Ebene vor der aktuellen
$ITEM_PATH         = "" ;  #in MIF-Datei zu beschreibende Gegenstände-Liste
#                           (aktuell)

while ($ORIG_LINE = <MIFFILE_PTR>)
{
 $PURE_LINE = $ORIG_LINE ;
 if ( $PURE_LINE =~ /^ *$/  ) { next ; } #leere Zeile springen
 
 if ( $PURE_LINE =~ /^[&=]/ ) { next ; } #Images/Bilder springen
 $LAST_INDENT_LEVEL = $INDENT_LEVEL        ; 
 $INDENT_LEVEL += $PURE_LINE =~ s/^ *</$&/ ; #ein '<' bedeutet der Anfang einer
#                                             Ebene / eine Ebene tiefer
 $INDENT_LEVEL -= $PURE_LINE =~ s/> *$/$&/ ; #ein '>' bedeutet das Ende einer
#                                             Ebene / eine Ebene höher 

 # Entering a new level
 if ( $LAST_INDENT_LEVEL + 1 == $INDENT_LEVEL ) {
  $PURE_LINE =~ /<([A-Za-z0-9]+)/ ;
  $BASE_ITEM = $1 ;  # $BASE_ITEM :für ein einzelner in MIF zu beschreibender
#                                  Gegenstand
  $ITEM_PATH = "$ITEM_PATH $BASE_ITEM" ;
  $QITEM_PATH = quotemeta($ITEM_PATH)  ;
  delete_mif_struct(\%MIF_LEARN_STRUCT,"$QITEM_PATH .*") ;
  # print_mif_structure(\%MIF_LEARN_STRUCT) ;

# zählt, wieviele Mals eine bestimmte Struktur bei bestimmter Umgebung vorkommt
  if ( exists($MIF_LEARN_STRUCT{$ITEM_PATH}))
   {
    $MIF_LEARN_STRUCT{$ITEM_PATH} ++  ;
   }
  else
   {
    $MIF_LEARN_STRUCT{$ITEM_PATH} = 1 ;
   }
#  print $PURE_LINE ;
#  print "ITEM_PATH : $ITEM_PATH\n" ; 
 }


 # Remaining in a level
 if ( $LAST_INDENT_LEVEL     == $INDENT_LEVEL ) {
  $PURE_LINE =~ /<([A-Za-z0-9]+)/ ;
  $BASE_ITEM = $1 ;

  if ( exists($MIF_LEARN_STRUCT{"$ITEM_PATH $BASE_ITEM"}))
   {
    $MIF_LEARN_STRUCT{"$ITEM_PATH $BASE_ITEM"} ++  ;
   }
  else
   {
    $MIF_LEARN_STRUCT{"$ITEM_PATH $BASE_ITEM"} = 1 ;
   }
 }

 # Leaving a level
 if ( $LAST_INDENT_LEVEL - 1 == $INDENT_LEVEL ) {

  $ITEM_PATH =~ s/ [A-Za-z0-9]+ *$// ;
  $QITEM_PATH = quotemeta($ITEM_PATH) ;

  foreach $MLK (keys(%MIF_LEARN_STRUCT)) {
    if ( $MLK =~ /$QITEM_PATH .*/ ) {
     if (exists $MIF_STRUCT{$MLK})   {
      if ( $MIF_LEARN_STRUCT{$MLK} > $MIF_STRUCT{$MLK} ) {
#---eine generelle Struktur ist aufgebaut, an %MIF_STRUCT übergeben
        $MIF_STRUCT{$MLK} = $MIF_LEARN_STRUCT{$MLK} ; 
      }
     } else {
       $MIF_STRUCT{$MLK} = $MIF_LEARN_STRUCT{$MLK} ; 
     }
    } 
   }
   
#  print "ITEM_PATH : $ITEM_PATH\n" ; 
 }
}
 close(MIFFILE_PTR) ;
 return 1 ;
}
#######################################################################
sub print_mif_structure {

 my $MSK ;
 my $STRUCT ;

 $STRUCT = $_[0] ;
 
 foreach $MSK (sort(keys %{$STRUCT})) {
  print "$MSK : $STRUCT->{$MSK}\n" ;
 }

 return 1 ;
}

#=========================================================================
# FUNKTION : store_db
#=========================================================================
# Descr. : 1. überprüfen, ob der übergegebene Item Path existiert
#          2. wenn ja, die richtige Stelle für den Inhalt (Content) finden
#             in der gleichen (mehrmals vorkommenden) Strukturen
#          3. den Inhalt speichern
#-------------------------------------------------------------------------
# Input : $ITEM_PATH $BASE_ITEM / $$BASE_CONTENT
# Return : 1
# Change : %MIF_DB


sub store_db          {

 my $ITEM_PATH ;
 my $ITEM_SCRATCH_PATH ;
 my $CONTENT   ; # Inhalt (Beschreibung) zu Item
 my $BASE_ITEM ;

 $ITEM_SCRATCH_PATH = $_[0] ;
 $CONTENT           = $_[1] ;
 $ITEM_PATH         = ""    ;
 $AA = \%MIF_DB             ; #$AA für : Zwischenspeicher für %MIF_DB mit
#                              verschiedene Ebenen  
# print "Try to store $ITEM_SCRATCH_PATH : $CONTENT\n" ;

 while ($ITEM_SCRATCH_PATH ne "") {
  $ITEM_SCRATCH_PATH =~ s/^ [A-Za-z0-9]+// ;
  $BASE_ITEM         = $& ;
  $BASE_ITEM         =~ s/^ +// ;
  $ITEM_PATH         = "$ITEM_PATH $BASE_ITEM"       ;
  if (! exists $MIF_STRUCT{$ITEM_PATH} ) {
   print "Internal Error : Can not find MIF_STRUCT of \'$ITEM_PATH\'\n" ;
   print "Tried to store $ITEM_SCRATCH_PATH : \'$CONTENT\'\n" ;
   print "Line Count $LINE_COUNT\n" ;  
   print_mif_structure(\%MIF_STRUCT) ;
   exit(-1) ;
  }
# überprüfen, ob die gleiche Struktur mehrmals vorkommt
  $IS_ARRAY          = $MIF_STRUCT{$ITEM_PATH} - 1   ; 

  # print "Debug: IP = $ITEM_PATH ($IS_ARRAY) <: $CONTENT\n" ;
# herausfinden, in wievielte Struktur der Inhalt gespeichert werden soll
  if ($IS_ARRAY) {
   $ARRAY_I          = $MIF_LEARN_STRUCT{$ITEM_PATH} - 1 ;
   # print "Debug: IX = $ITEM_PATH ($ARRAY_I) <: $CONTENT\n" ;
   if ($ITEM_SCRATCH_PATH ne "") {
    $AA = \%{$AA -> {$BASE_ITEM} -> [$ARRAY_I]}   ;
    next ;
   }
   $AA -> {$BASE_ITEM} -> [$ARRAY_I] =  $CONTENT    ;
   next ;
  }
  if ($ITEM_SCRATCH_PATH ne "") {
   $AA =  \%{$AA -> {$BASE_ITEM}} ;
   next ;
   }
   $AA -> {$BASE_ITEM} = $CONTENT ;
 }
 
 return 1 ;
}
#============================================================================
# Funktion : store_mif_content
#============================================================================
# Descr. : 1. in mif-Datei nach tiefen gehen, bis ein Inhalt (Content) und
#          dessen Item auf der gleichen Ebene stehen 
#          2. in FUNKTION store_db den Inhalt speichern
#----------------------------------------------------------------------------
# Input : mif-Datei ohne Kommentar
# Return : 1
# Change : %MIF_DB / %MIF_LEARN_STRUCT


sub store_mif_content {
 
open(MIFFILE_PTR,"$PCB{MIFSPEC_FILE}.stripped") ;


my $INDENT_LEVEL      = 0  ;
my $LAST_INDENT_LEVEL = 0  ;
my $ITEM_PATH         = "" ;
my %LEARN_MIF_STRUCT  = () ;
my $AA ;
$LINE_COUNT = 0 ; # zeigen, welche Zeile gerade bearbeitet wird

while ($ORIG_LINE = <MIFFILE_PTR>)
{
 $LINE_COUNT++           ;
 chomp($ORIG_LINE)       ;
 $PURE_LINE = $ORIG_LINE ;
 if ( $PURE_LINE =~ /^ *$/ ) { next ; }

 if ( $PURE_LINE =~ /^[&=]/   ) { next ; }


 $LAST_INDENT_LEVEL = $INDENT_LEVEL        ; 
 $INDENT_LEVEL += $PURE_LINE =~ s/^ *</$&/ ;
 $INDENT_LEVEL -= $PURE_LINE =~ s/> *$/$&/ ; 

 # Entering a new level
 if ( $LAST_INDENT_LEVEL + 1 == $INDENT_LEVEL ) {
  $PURE_LINE =~ /<([A-Za-z0-9]+)/ ;
  $BASE_ITEM = $1 ;
  $ITEM_PATH = "$ITEM_PATH $BASE_ITEM" ;
  $QITEM_PATH = quotemeta($ITEM_PATH)  ;
  delete_mif_struct(\%MIF_LEARN_STRUCT,"$QITEM_PATH .*") ;
  if ( exists($MIF_LEARN_STRUCT{$ITEM_PATH}))
   {
    $MIF_LEARN_STRUCT{$ITEM_PATH} ++  ;
   }
  else
   {
    $MIF_LEARN_STRUCT{$ITEM_PATH} = 1 ;
   }
 }

 # Remaining in a level
 if ( $LAST_INDENT_LEVEL     == $INDENT_LEVEL) {
   $PURE_LINE =~ /<([A-Za-z0-9]+)/ ;
   $BASE_ITEM = $1    ;
   $BASE_CONTENT = $' ; #Der Inhalt zu einem Gegenstand (Item) ist das, was
#                        hinter Gegenstand-Name steht, außer '>'    
$BASE_CONTENT =~ s/> *$// ;
   
  if ( exists($MIF_LEARN_STRUCT{"$ITEM_PATH $BASE_ITEM"}))
   {
    $MIF_LEARN_STRUCT{"$ITEM_PATH $BASE_ITEM"} ++  ;
   }
  else
   {
    $MIF_LEARN_STRUCT{"$ITEM_PATH $BASE_ITEM"} = 1 ;
   }

   store_db("$ITEM_PATH $BASE_ITEM",$BASE_CONTENT) ;
   # $AA = \%MIF_DB ;
   # traverse_DB ($AA,0) ;
 }

 # Leaving a level
 # eine Ebene höher zurück,indem der letzte Item entfernt wird
 if ( $LAST_INDENT_LEVEL - 1 == $INDENT_LEVEL ) {
  $ITEM_PATH =~ s/ [A-Za-z0-9]+ *$// ;
 }
}
 close(MIFFILE_PTR) ;
 return 1 ;

}
#===============================================================================
# FUNKTION : PSH_INTERPRETER (PERL SHELL INTERPRETER)
#===============================================================================
# Descr. : Der PSH_INTERPRETER wird von command line /stdio die script file
#   bekommen, in der Infos über die Stellen von benötigen Tabellen verwiesen
#   werden, und perl-Kommando in der Script-file ausführen. Die Tabellen-Infos
#   können direkt in dieser Script-File stehen oder wieder in einer
#   anderen Datei stehen. Der Interpreter erlaubt, die anderen Aufgaben, die
#   die Verilog-DB und MIF-DB brauchen, zu erfüllen.
#-------------------------------------------------------------------------------
# Input : Perl script file (für dieses Projekt : t.pl)
# Return : none
# Change : je nach dem, was die perl script file erzielt


sub PSH_INTERPRETER {

 my  %PSH_INDENT  =  () ; # überprüfen, ob ein Block abgeschlossen ist.
 my  $PSH_COMMAND =  "" ; # für Kommando-liste in der Perl shell
 my  $PSH_LINE          ; # für von der Perl Shell eingelesene Zeile
 my  $PSH_INDENT        ;
 my  $PSH_IK            ;
 my  $PSH_IS            ;
 my  $PSH_FILE = FileHandle-> new ;
 my  $PSH_SRCE = FileHandle-> new ;

 $PSH_FILE = $_[0]      ;

 printf "psh>"  ;


 while ( $PSH_LINE = <$PSH_FILE> ) {
  chomp($PSH_LINE)      ;
  # Remove Comments, however quoting not solved
  # Do not misinterpret $# sequences
  $PSH_LINE =~ s/([^\$])#.*$/$1/ ;

# Ergebnis in eine gewünschte Datei schreiben, wenn sie angegeben ist.
  if ( $PSH_LINE =~ s/; *(>>?) *([A-Za-z0-9_\/\.]+)/;/    ) {
   open(LOG_FH,"$1$2")||warn "discarding $2 output\n" ;
   select(LOG_FH)  ;
  } else {
   select(STDOUT)  ;
   close(LOG_FH)   ;
  }

# Ein andere Perl Shell kann reingezogen werden.
  if ( $PSH_LINE =~ /source +([A-Za-z0-9\/_\-\.~+]+)/ ) {
   if ( ! open($PSH_SRCE,"<$1") ) {
    print "Could not open perl file $1\n" ; 
   }
   PSH_INTERPRETER($PSH_SRCE) ;
   next ;
  }

  
# überprüfen, ob ein Block abgeschlossen ist. wenn ja, dann die Perl-Kommandos
# in diesem Block werden in Kommando-liste eingeführt und später ausgeführt.
# wenn nein, weiter nach dem Ende dieses Blochs suchen.    

  $PSH_COMMAND =$PSH_COMMAND . " " . $PSH_LINE ; 
  $PSH_INDENT{"{}"} += $PSH_LINE =~ s/[{]/{/g;    
  $PSH_INDENT{"{}"} -= $PSH_LINE =~ s/[}]/}/g ;
  $PSH_INDENT{"()"} += $PSH_LINE =~ s/[(]/(/g ;
  $PSH_INDENT{"()"} -= $PSH_LINE =~ s/[)]/)/g ;

  $PSH_IS = 0 ;
  for $PSH_IK (keys %PSH_INDENT) {
   $PSH_IS += $PSH_INDENT{$PSH_IK} ;
  }

  # print "IS : $PSH_IS ::\n" ;
  # print "$PSH_COMMAND\n"    ;
 
  if ($PSH_IS > 0) { print " " x $PSH_IS . "    " ; next ; }

  eval $PSH_COMMAND ;
  $PSH_COMMAND = "" ;

  printf "\npsh>" ;
 }
}
#########################################################################
sub print_keys {
 my $KEY ;
 for $KEY (keys(%{$_[0]})) {
  print "$KEY\n" ;
 }
}
#=========================================================================
# FUNKTION : process_mif
#=========================================================================
# Descr. : aus %MIF_DB, in der alle Inhalte von MIF-Datei gespeichert sind,
#          die für Vergleich erwünschten Infos herausziehen und die
#          Comparison-database (%CMP) erzeugen 
#------------------------------------------------------------------------- 
# Input : none 
# Return : none
# Change : %TBL_DATA / %NAME_IDX / %CMP


sub process_mif {

 my  $CI ; # Cell index, in $CI speichert : in welchem Cell der Tabelle Name,
#            Buffer, Direction stehen. Die Infos sind in Perl script file
#            angegeben.
 my  $BF ;
 my  $UC ;  # uppercase
 my  $UCSTR ; # uppercase-string
 my  $RI ; # RowIndex
 my  $CR ; # Anzahl der CellRow

#---------------------------------------------------------------------------
# nach den angegebenen Infos über Tabellen-Nr, den zu vergleichenden Items,
# und der entsprechenden Stelle des Inhalts (Content) in MIF-Datei den Inhalt
# aus %MIF_DB herausziehen und in %TBL_DATA (Index by Tabellen) speichern.
#----------------------------------------------------------------------------

%TBL_DATA =() ;

 for $TBL (keys(%CHECK_DATA)) { # in %CHECH_DATA stehen die Infos über Tabellen

  $ROW = 0 ;
  while(defined($MIF_DB{Tbls}{Tbl}[$TBL]{TblBody}{Row}[$ROW])) {
   for $ITEM (keys(%{$CHECK_DATA{$TBL}})) {
    $CI = $CHECK_DATA{$TBL}{$ITEM};

    if (defined($MIF_DB{Tbls}{Tbl}[$TBL]{TblBody}{Row}[$ROW]{Cell}[$CI])) {
     $STR = 0   ;
     $CSTR = "" ;
     $UC   = 0  ;
     # Check whether we have an uppercase font
     if (exists($MIF_DB{Tbls}{Tbl}[$TBL]{TblBody}{Row}[$ROW]{Cell}[$CI]{CellContent}{Para}[0]{Pgf}{PgfFont}{FCase})) {
      $UCSTR = $MIF_DB{Tbls}{Tbl}[$TBL]{TblBody}{Row}[$ROW]{Cell}[$CI]{CellContent}{Para}[0]{Pgf}{PgfFont}{FCase} ;
      if ($UCSTR =~ "FUppercase") {
        $UC = 1 ;
      }
     }

     while(defined($MIF_DB{Tbls}{Tbl}[$TBL]{TblBody}{Row}[$ROW]{Cell}[$CI]{CellContent}{Para}[0]{ParaLine}[0]{String}[$STR])) {
      $TSTR = $MIF_DB{Tbls}{Tbl}[$TBL]{TblBody}{Row}[$ROW]{Cell}[$CI]{CellContent}{Para}[0]{ParaLine}[0]{String}[$STR] ;
      $TSTR =~ s/(^ *[`])|(['] *$)//g ;
      $STR++ ;
      $CSTR = $CSTR . $TSTR ;
     }

     if ($UC) {
       $CSTR =~ tr/[a-z]/[A-Z]/ ;
     }
     # Detect tiled/shared cells
     # When cells are tiled the cell structure is kept but only the first cell 
     # has any content

     if (defined($MIF_DB{Tbls}{Tbl}[$TBL]{TblBody}{Row}[$ROW]{Cell}[$CI]{CellRows})) {
       $CR = $MIF_DB{Tbls}{Tbl}[$TBL]{TblBody}{Row}[$ROW]{Cell}[$CI]{CellRows} ; 
       for ($RI = 0 ; $RI < $CR ; $RI++) {
        $TBL_DATA{$TBL}[$ROW + $RI]{$ITEM} = $CSTR ;
       }
     }
     if (!defined($TBL_DATA{$TBL}[$ROW]{$ITEM})) {
      $TBL_DATA{$TBL}[$ROW]{$ITEM} = $CSTR ;
     }
    }
   }
   $ROW ++ ;
 }
}

# --------------------------------------------
# Indexing by Name (in %NAME_IDX : Port-Namen als keys)
%NAME_IDX = () ;

for $TBL (keys(%TBL_DATA)) {
 $ROW = 0 ;
 while(defined($TBL_DATA{$TBL}[$ROW])) {
  $NAME = $TBL_DATA{$TBL}[$ROW]{NAME} ;
  # ------------------------------------------
  # Bus / Differential Pin Expansion
  if ( $NAME =~ /\[ *([0-9]+) *: *([0-9]+) *\]/ ) {
   $LI = $2 ;
   $HI = $1 ;
   if ($LI > $HI) {
    print "$MW : Low index comes for High Index at $NAME\n" ;
    $LI = $1 ;
    $HI = $2 ;
   }
   for ($I = $LI;$I <= $HI ; $I++) {
    $BM_NAME = $NAME ; # $BM_NAME:Zwischenspeicher für differenzielle
#                        Busports
    $BM_NAME =~ s/\[ *([0-9]+) *: *([0-9]+) *\]/\[$I\]/ ;
    if ( $BM_NAME =~ /([pPnN])\/([pPnN])/ ) {
     $DB_NAME = $BM_NAME ;
     $DB_NAME =~ s/([pPnN])\/([pPnN])/$1/ ;
     $NAME_IDX{$DB_NAME}{ROW} = $ROW ;
     $NAME_IDX{$DB_NAME}{TBL} = $TBL ;
     $DB_NAME = $BM_NAME ; # $DB_NAME : Namen von differenziellen Busports
     $DB_NAME =~ s/([pPnN])\/([pPnN])/$2/ ;
     $NAME_IDX{$DB_NAME}{ROW} = $ROW ;
     $NAME_IDX{$DB_NAME}{TBL} = $TBL ;
    } else {
     $NAME_IDX{$BM_NAME}{ROW} = $ROW ; 
     $NAME_IDX{$BM_NAME}{TBL} = $TBL ; 
    }
   }
  } else {
   if ( $NAME =~ /([pPnN])\/([pPnN])/ ) {
     $DN_NAME = $NAME ; # $DN_NAME : Namen von differenziellen nicht-Busports
     $DN_NAME =~ s/([pPnN])\/([pPnN])/$1/ ;
     $NAME_IDX{$DN_NAME}{ROW} = $ROW ;
     $NAME_IDX{$DN_NAME}{TBL} = $TBL ;
     $DN_NAME = $NAME ;
     $DN_NAME =~ s/([pPnN])\/([pPnN])/$2/ ;
     $NAME_IDX{$DN_NAME}{ROW} = $ROW ;
     $NAME_IDX{$DN_NAME}{TBL} = $TBL ;
    } else {
     $NAME_IDX{$NAME}{ROW} = $ROW ;
     $NAME_IDX{$NAME}{TBL} = $TBL ;
    }
  }
  $ROW++ ;
  }
 }
#----------------------------------------------------------------------------
# mit Hilfe von %NAME_IDX die entsprechenden 'Direction' und 'Buffer' aus
# %TBL_DATA herausziehen und in %CMP{"MIF"} speichern

 $CMP{"MIF"}[0] = () ;

 for $NAME (sort(keys(%NAME_IDX))) {
   $ROW = $NAME_IDX{$NAME}{ROW} ;
   $TBL = $NAME_IDX{$NAME}{TBL} ;
   $DIRECTION = "??"       ;
   if (exists($TBL_DATA{$TBL}[$ROW]{DIRECTION})) {
    $DIRECTION = $TBL_DATA{$TBL}[$ROW]{DIRECTION}    ;
    $DIRECTION =~ s/([dD])?[oO][uU][tT]([pP][uU][tT])?/out/ ;
    $DIRECTION =~ s/([dD])?[iI][nN]([pP][uU][tT])?/in/      ;
    $DIRECTION =~ s/[bB][iI][dD][iI][rR]/inout/      ;
   }
   $BUFFER = "??" ;

   if (exists($TBL_DATA{$TBL}[$ROW]{BUFFER})) {
    $BUFFER    = $TBL_DATA{$TBL}[$ROW]{BUFFER}       ;
   } 
   if ($BUFFER ne "" || $DIRECTION ne "") {
    # printf("%-30s : %10s : %s \n",$NAME,$DIRECTION,$BUFFER) ;
    $CMP{"MIF"}[0]{port}{$NAME}{DN} = $DIRECTION  ;
    for  $BF (split(/ /,$BUFFER)) {
     chomp($BF) ;
     $CMP{"MIF"}[0]{port}{$NAME}{BF}{$BF} = 0      ;
    }
  }
 } 

}
##############################################################################
sub dump_table        {

 my $ROW ;
 my $TBL ;
 my $CSTR ;

  $ROW = 0 ;
  $TBL = $_[0] ;
  while(defined($MIF_DB{Tbls}{Tbl}[$TBL]{TblBody}{Row}[$ROW])) {
   $ITEM_LIST = "" ;
   for $ITEM (keys(%{$CHECK_DATA{$TBL}})) {
    $CI = $CHECK_DATA{$TBL}{$ITEM};

    if (defined($MIF_DB{Tbls}{Tbl}[$TBL]{TblBody}{Row}[$ROW]{Cell}[$CI])) {
     $STR = 0 ;
     $CSTR = "" ;
     while(defined($MIF_DB{Tbls}{Tbl}[$TBL]{TblBody}{Row}[$ROW]{Cell}[$CI]{CellContent}{Para}[0]{ParaLine}[0]{String}[$STR])) {
      $TSTR = $MIF_DB{Tbls}{Tbl}[$TBL]{TblBody}{Row}[$ROW]{Cell}[$CI]{CellContent}{Para}[0]{ParaLine}[0]{String}[$STR] ;
      $TSTR =~ s/(^ *[`])|(['] *$)//g ;
      $STR++ ;
      $CSTR = $CSTR . $TSTR ;
     }
     $ITEM_LIST = $ITEM_LIST . "$ITEM = $CSTR ;" ;
    }
   }
   print "Table $TBL,Row $ROW, $ITEM_LIST\n" ;
   $ROW ++ ;
 }
}


#============================================================================
# FUNKTION : compare_databases
#============================================================================
#Descr. : Databases von Verilog-Netzliste und mif-File vergleichen und 
#         Ergebnis ausgeben
#----------------------------------------------------------------------------
#Input : "VNL","MIF"
#Return : none
#Change : none


sub compare_databases {
  
 my $ref_db ; #für reingegangenen Wert "MIF"
 my $ver_db ; #für reingegangenen Wert "VNL"
 my $ref_ix ; #Nr. von MIF-CMP-DBs
 my $ver_ix ; #Nr. von Verilog-CMP-DBs
 my $A      ; #wenn $A=0:der von Netzliste entnommene Port existiert in MIF-
              #File nicht, wenn $A=1:er befindet sich auch in MIF-File.
 my $REF_PORT ; #ein von %CMP{"MIF"} entnommener Port
 my $VER_PORT ; #ein von %CMP{"VNL"} entnommener Port

 $ref_db = $_[0] ;
 $ver_db = $_[1] ;
 $ref_ix = 0     ;
 $ver_ix = 0     ;
 

 print "------------------------------------\n" ;
 print "Comparision:$ver_db versus $ref_db (reference)\n" ;
 print "------------------------------------\n" ;

 print "------------------------------------\n" ;
 print "Checking for non-existent ports in $ver_db:\n" ;
 print "------------------------------------\n" ;
 for $REF_PORT (sort(keys(%{$CMP{$ref_db}[$ref_ix]{port}}))) {
  $A = 0 ;
  if (!exists ($CMP{$ver_db}[$ver_ix]{port}{$REF_PORT})) {
   # Try to match bus ports intuitively
   for ( $AI = 0 ; $AI < 3 ; $AI++ ) {
     $ABUS_PORT[$AI] = $REF_PORT ;
   }

   if ( $REF_PORT =~ /\[[0-9]+\]$/ ) {
    $ABUS_PORT[0] =~ s/\[([0-9]+)\]$/$1/ ;
    $ABUS_PORT[1] =~ s/\[([0-9]+)\]$/_$1/ ;
    if ( $REF_PORT =~ /\_\[([0-9]+)\]$/ ) {
     $ABUS_PORT[2] =~ s/\_\[([0-9]+)\]$/$1/ ;
    } else {
     $ABUS_PORT[2] =~ s/\[[0-9]+\]$/_$&/ ;
    }
   } 

   if ( $REF_PORT =~ /[0-9]+$/ ) {
    $ABUS_PORT[0] =~ s/([0-9]+)$/[$1]/ ;  
    $ABUS_PORT[1] =~ s/([0-9]+)$/_[$1]/ ;  
    $ABUS_PORT[2] =~ s/_([0-9]+)$/[$1]/ ;  
   }


   for ( $AI = 0 ; $AI <= $#ABUS_PORT ; $AI++ ) {
    if (exists ($CMP{$ver_db}[$ver_ix]{port}{$ABUS_PORT[$AI]})) {
     print sprintf("$MI Reference Port %-20s converted to %-20s (autodetected)\n",$REF_PORT,$ABUS_PORT[$AI]) ; 
     $CMP{$ref_db}[$ref_ix]{port}{$REF_PORT}{ANAME} = $ABUS_PORT[$AI] ;
     $A = 1 ;
     last ;
    }
   }
   
   if (!$A) {
    print sprintf("$ME Reference Port %-20s does not exist, no auto-pattern matched !\n",$REF_PORT) ; 
   }
  }
 }
 print "\n" ;
 print "------------------------------------\n" ;
 print "Checking existent ports in $ver_db:\n" ;
 print "------------------------------------\n" ;
 for $REF_PORT (sort(keys(%{$CMP{$ref_db}[$ref_ix]{port}}))) {
  if (exists ($CMP{$ver_db}[$ver_ix]{port}{$REF_PORT}) || 
      exists ($CMP{$ref_db}[$ref_ix]{port}{$REF_PORT}{ANAME})) {
   $REF_DN = "not found" ;
   $VER_DN = "not found" ;
   $BF     = ""          ;
   if (exists ($CMP{$ver_db}[$ver_ix]{port}{$REF_PORT})) {
    $VER_PORT = $REF_PORT ;
   } else {
    $VER_PORT = $CMP{$ref_db}[$ref_ix]{port}{$REF_PORT}{ANAME} ;
   }
#'Direction' in MIF und in Netzliste suchen
#----------------------------------------------
   if (exists($CMP{$ref_db}[$ref_ix]{port}{$REF_PORT}{DN}))  {
    $REF_DN = $CMP{$ref_db}[$ref_ix]{port}{$REF_PORT}{DN} ;
   }
   if (exists($CMP{$ver_db}[$ver_ix]{port}{$VER_PORT}{DN}))  {
     $VER_DN = $CMP{$ver_db}[$ver_ix]{port}{$VER_PORT}{DN} ;
   }        
#Buffer in MIF und in Netzliste suchen und vergleichen
#---------------------------------------------------------
   for $BUFFER (sort(keys(%{$CMP{$ref_db}[$ref_ix]{port}{$REF_PORT}{BF}}))) {
    if (!exists($CMP{$ver_db}[$ver_ix]{port}{$VER_PORT}{BF}{$BUFFER})) {
     $BF = $BF . " ?$BUFFER?" ;
    } else {
     $BF = $BF . " $BUFFER" ;
    }
   }
#2 Directions vergleichen
#---------------------------
   if ($REF_DN ne $VER_DN) {
    $DN = "Direction Error : $REF_DN != $VER_DN" ;
   } else {
    $DN = $REF_DN ;
   }
# Ergebnis ausgeben
#-------------------
    print sprintf("Reference Port %-15s Verified Port %-15s : %-10s : %s\n",
             $REF_PORT,$VER_PORT,$DN,$BF); 
  }
 }
}

######################################################################
#
#
#
#   MAIN Program
#
#
#

 open (LOG_FP,">$LOG") ;

 print "$MI (c) Lucent Technologies  c/o tschuering\@lucent.com \n" ; 
 print "$MI Execution started  at  $DATE" ;
 print LOG_FP "$MI Execution started  at  $DATE" ;
 
 command_line() ;

 if (exists($PCB{"SCRIPT_FILE"}) && $PCB{"SCRIPT_FILE"} ne "") {
  open(PSH_FILE,"<$PCB{SCRIPT_FILE}") ;
 } 

 read_verilog_netlist($PCB{"VERILOG_FILE"})    ;
 compress_modules($PCB{"VERILOG_FILE"})        ;
 process_verilog_netlist($PCB{"VERILOG_FILE"},$toplevel) ;
 
 print "$MI Preparing MIF ...\n" ; 
 system "$PDIR/rmmifcomment < $PCB{MIFSPEC_FILE} > $PCB{MIFSPEC_FILE}.stripped" ;
 print "$MI Learning  MIF ...\n" ;
 learn_mif_structure() ;
 print "$MI Storing   MIF ...\n" ;
 store_mif_content()   ;
 # traverse_DB (\%MIF_DB,0) ;
 if (exists($PCB{"SCRIPT_FILE"}) && $PCB{"SCRIPT_FILE"} ne "") {
  print "$MI Executing Script $PCB{SCRIPT_FILE} ...\n" ;
  PSH_INTERPRETER(PSH_FILE);
 } else { 
 # open simple perl shell interpreter
  open(PSH_FILE,"-") ;
  PSH_INTERPRETER(PSH_FILE);
 }

 print "$MI Execution finished at  $DATE"      ;
 print LOG_FP "$MI Execution finished at  $DATE" ;