netgen/tcltk/netgen.tcl.in

# Wishrc startup for ToolScript (netgen)
#
# For installation:  Put this file and also tclnetgen.so into
# directory ${CAD_ROOT}/netgen/tcl/, and set the "load" line below
# to point to the location of tclnetgen.so.  Also see comments
# in shell script "netgen.sh".
#

# Check namespaces for existence of other applications
set UsingMagic 0
set UsingXCircuit 0
set UsingIRSIM 0
set batchmode 0
set nlist [namespace children]
foreach i $nlist {
   switch $i {
      ::magic { set UsingMagic 1 }
      ::xcircuit { set UsingXCircuit 1 }
      ::irsim { set UsingIRSIM 1 }
   }
}

if {${tcl_version} >= 8.6} {
   load -lazy TCL_DIR/tclnetgenSHDLIB_EXT
} else {
   load TCL_DIR/tclnetgenSHDLIB_EXT
}

#----------------------------------------------------------------
# Define the "lvs" command as a way of calling the netgen options
# for standard compare, essentially the same as the old "netcomp"
# standalone program.
#
# Use the "canonical" command to parse the file and cell names,
# although if the cells have not been read in yet, then the
# original syntax of filename or {filename cellname} is required.
#
# "args" is passed to verify and may therefore contain only the
# value "-list" or nothing.  If "-list", then output is returned
# as a nested list.
#----------------------------------------------------------------

proc netgen::lvs { name1 name2 {setupfile setup.tcl} {logfile comp.out} args} {
   set dolist 0
   puts stdout "Diagnostic version"
   foreach arg $args {
      if {$arg == "-list"} {
	 puts stdout "Generating list result"
	 set dolist 1
	 set lvs_final {}
      }
   }

   # Allow name1 or name2 to be a list of {filename cellname},
   # A single <filename>, or any valid_cellname form if the
   # file has already been read.

   if {[catch {set flist1 [canonical $name1]}]} {
      if {[llength $name1] == 2} {
         set file1 [lindex $name1 0]
         set cell1 [lindex $name1 1]
      } else {
         set file1 $name1
         set cell1 $name1
      }
      puts stdout "Reading netlist file $file1"
      set fnum1 [netgen::readnet $file1]
   } else {
      set cell1 [lindex $flist1 0]
      set fnum1 [lindex $flist1 1]
      set flist1 [canonical $fnum1]
      set file1 [lindex $flist1 0]
   }

   if {[catch {set flist2 [canonical $name2]}]} {
      if {[llength $name2] == 2} {
         set file2 [lindex $name2 0]
         set cell2 [lindex $name2 1]
      } else {
         set file2 $name2
         set cell2 $name2
      }
      puts stdout "Reading netlist file $file2"
      set fnum2 [netgen::readnet $file2]
   } else {
      set cell2 [lindex $flist2 0]
      set fnum2 [lindex $flist2 1]
      set flist2 [canonical $fnum2]
      set file2 [lindex $flist2 0]
   }

   if {$fnum1 == $fnum2} {
      puts stderr "Both cells are in the same netlist:  Cannot compare!"
      return
   }

   set clist1 [cells list $fnum1]
   set cidx [lsearch -regexp $clist1 ^$cell1$]
   if {$cidx < 0} {
      puts stderr "Cannot find cell $cell1 in file $file1"
      return
   } else {
      set cell1 [lindex $clist1 $cidx]
   }
   set clist2 [cells list $fnum2]
   set cidx [lsearch -regexp $clist2 ^$cell2$]
   if {$cidx < 0} {
      puts stderr "Cannot find cell $cell2 in file $file2"
      return
   } else {
      set cell2 [lindex $clist2 $cidx]
   }

   netgen::compare assign "$fnum1 $cell1" "$fnum2 $cell2"

   if {[file exists $setupfile]} {
      puts stdout "Reading setup file $setupfile"
      # Instead of sourcing the setup file, run each line so we can
      # catch individual errors and not let them halt the LVS process
      set perrors 0
      if {![catch {open $setupfile r} fsetup]} {
	 set sline 0
	 set command {}
	 while {[gets $fsetup line] >= 0} {
	    incr sline
	    append command $line "\n"
	    if {[info complete $command]} {
	       if {[catch {uplevel 1 [list namespace eval netgen $command]} msg]} {
		  set msg [string trimright $msg "\n"]
		  puts stderr "Error $setupfile:$sline (ignoring), $msg"
		  incr perrors
	       }
	       set command {}
	    }
	 }
	 close $fsetup
      } else {
	 puts stdout "Error:  Cannot read the setup file $setupfile"
      }
	
      if {$perrors > 0} {
	 puts stdout "Warning:  There were errors reading the setup file"
      }
   } else {
      netgen::permute default	;# transistors and resistors
      netgen::property default
   }

   puts stdout "Comparison output logged to file $logfile"
   netgen::log file $logfile
   netgen::log start
   netgen::log echo off
   if {$dolist == 1} {
      set endval [netgen::compare -list hierarchical "$fnum1 $cell1" "$fnum2 $cell2"]
   } else {
      set endval [netgen::compare hierarchical "$fnum1 $cell1" "$fnum2 $cell2"]
   }
   if {$endval == {}} {
      netgen::log put "No cells in queue!\n"
      return
   }
   set properr {}
   while {$endval != {}} {
      if {$dolist == 1} {
         netgen::run -list converge
      } else {
         netgen::run converge
      }
      netgen::log echo on
      if {[verify equivalent]} {
	 # Resolve automorphisms by pin and property
	 if {$dolist == 1} {
            netgen::run -list resolve
	 } else {
            netgen::run resolve
	 }
	 set uresult [verify unique]
         if {$uresult == 0} {
	    netgen::log put "   Networks match locally but not globally.\n"
	    netgen::log put "   Probably connections are swapped.\n"
	    netgen::log put "   Check the end of logfile ${logfile} for implicated nodes.\n"
	    if {$dolist == 1} {
	       verify -list nodes
	    } else {
	       verify nodes
	    }

	    # Flatten the non-matching subcircuit (but not the top-level cells)
            if {[netgen::print queue] != {}} {
	       netgen::log put "  Flattening non-matched subcircuits $endval"
	       netgen::flatten class "[lindex $endval 0] $fnum1"
	       netgen::flatten class "[lindex $endval 1] $fnum2"
	    }
	 } else {
	    # Match pins
            netgen::log echo off
	    set result [equate pins "$fnum1 [lindex $endval 0]" \
			"$fnum2 [lindex $endval 1]"]
	    if {$result != 0} {
		equate classes "$fnum1 [lindex $endval 0]" \
			 "$fnum2 [lindex $endval 1]"
	    }
            netgen::log echo on
	 }
	 if {$uresult == 2} {lappend properr [lindex $endval 0]}
      } else {
	 # Flatten the non-matching subcircuit (but not the top-level cells)
         if {[netgen::print queue] != {}} {
	    netgen::log put "  Flattening non-matched subcircuits $endval"
	    netgen::flatten class "[lindex $endval 0] $fnum1"
	    netgen::flatten class "[lindex $endval 1] $fnum2"
	 }
      }
      netgen::log echo off
      if {$dolist == 1} {
         catch {lappend lvs_final $lvs_out}
         set lvs_out {}
         set endval [netgen::compare -list hierarchical]
      } else {
         set endval [netgen::compare hierarchical]
      }
   }
   netgen::log echo off
   puts stdout "Result: " nonewline
   netgen::log echo on
   verify only
   if {$properr != {}} {
      netgen::log put "The following cells had property errors: $properr\n"
   }
   netgen::log end
   puts stdout "LVS Done."
   if {$dolist == 1} {
      return $lvs_final
   }
}

# It is important to make sure no netgen commands overlap with Tcl built-in
# commands, because otherwise the namespace import will fail.

proc pushnamespace { name } {

   set y [namespace eval ${name} info commands ::${name}::*]
   set z [info commands]

   foreach v $y {
      regsub -all {\*} $v {\\*} i
      set x [namespace tail $i]
      if {[lsearch $z $x] < 0} {
         namespace import $i
      } else {
            puts "Warning: ${name} command '$x' use fully-qualified name '$v'"
      }
   }
}

proc popnamespace { name } {
   set z [info commands]
   set l [expr [string length ${name}] + 5]

   while {[set v [lsearch $z ${name}_tcl_*]] >= 0} {
      set y [lindex $z $v]
      set w [string range $y $l end]
      interp alias {} ::$w {}
      rename ::$y ::$w
      puts "Info: replacing ::$w with ::$y"
   }
   namespace forget ::${name}::*
}

set auto_noexec 1       ;# don't EVER call UNIX commands w/o "shell" in front

#----------------------------------------------------------------------
# Cross-Application section
#----------------------------------------------------------------------

# Setup IRSIM assuming that the Tcl version is installed.
# We do not need to rename procedure irsim to NULL because it is
# redefined in a script, which simply overwrites the original.

proc irsim { args } {
   global CAD_ROOT
   set irsimscript [glob -nocomplain ${CAD_ROOT}/irsim/tcl/irsim.tcl]
   if { ${irsimscript} == {} } {
      puts stderr "\"irsim\" requires Tcl-based IRSIM version 9.6 or newer."
      puts stderr "Could not find script \"irsim.tcl\".  If IRSIM is installed in a"
      puts stderr "place other than CAD_ROOT (=${CAD_ROOT}), use the command"
      puts stderr "\"source <path>/irsim.tcl\" before doing \"irsim\"."
   } else {
      source $irsimscript
      eval {irsim} $args
   }
}

# Setup Xcircuit assuming that the Tcl version is installed.

proc xcircuit { args } {
   global CAD_ROOT
   global argc
   global argv
   set xcircscript [glob -nocomplain ${CAD_ROOT}/xcircuit*/xcircuit.tcl]
   if { ${xcircscript} == {} } {
      puts stderr "\"xcircuit\" requires Tcl-based XCircuit version 3.1 or newer."
      puts stderr "Could not find script \"xcircuit.tcl\".  If XCircuit is installed in a"
      puts stderr "place other than CAD_ROOT (=${CAD_ROOT}), use the command"
      puts stderr "\"source <path>/xcircuit.tcl\"."
   } else {
      # if there are multiple installed versions, choose the highest version.
      if {[llength $xcircscript] > 1} {
        set xcircscript [lindex [lsort -decreasing -dictionary $xcircscript] 0]
      }
      set argv $args
      set argc [llength $args]
      uplevel #0 source $xcircscript
   }
}

# Setup Magic assuming that the Tcl version is installed.

proc magic { args } {
   global CAD_ROOT
   global argc
   global argv
   set magicscript [glob -nocomplain ${CAD_ROOT}/magic/tcl/magic.tcl]
   if { ${magicscript} == {} } {
      puts stderr "\"magic\" requires Tcl-based Magic version 7.2 or newer."
      puts stderr "Could not find script \"magic.tcl\".  If Magic is installed in a"
      puts stderr "place other than CAD_ROOT (=${CAD_ROOT}), use the command"
      puts stderr "\"source <path>/magic.tcl\"."
   } else {
      set argv $args
      set argc [llength $args]
      uplevel #0 source $magicscript
   }
}

#----------------------------------------------------------------------------
# Have we called netgen from tkcon or a clone thereof?  If so, set NetgenConsole
#----------------------------------------------------------------------------

if {! $UsingMagic } {
   if {[lsearch [interp aliases] tkcon] != -1} {
      set NetgenConsole tkcon
      wm withdraw .
   }
}

pushnamespace netgen

#----------------------------------------------------------------------------
# For now, if we are standalone, pop down the default Tk window.
# Sometime later we may wish to provide a standalone GUI frontend in Tk
# to improve upon the original X11 "xnetgen" frontend.  If so, its
# definitions would go below.

if {! $UsingMagic } {
   if {[lsearch [interp aliases] tkcon] != -1} {
      if {[string range [wm title .] 0 3] == "wish"} {
	 wm withdraw .
      }
   }
}

#----------------------------------------------------------------------------
# No-console mode drops "--" in front of the argument list and "-noc"
# is retained, so remove them.  Internally, the console will be determined
# by checking for a slave interpreter, so there is no need for any
# action here other than removing the argument.

if {[lindex $argv 0] == "--"} {
   incr argc -1
   set argv [lrange $argv 1 end]
}

if {[string range [lindex $argv 0] 0 3] == "-noc"} {
   incr argc -1
   set argv [lrange $argv 1 end]
}

if {[string range [lindex $argv 0] 0 3] == "-bat"} {
   incr argc -1
   set argv [lrange $argv 1 end]
   set batchmode 1
}

#----------------------------------------------------------------------------
# Anything on the command line is assumed to be a netgen command to evaluate

if {[catch {eval $argv}]} {
   puts stdout "$errorInfo"
}
if {$batchmode == 1} {quit}

#----------------------------------------------------------------------------
# Netgen start function drops back to interpreter after initialization & setup