# 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 }
   }
}

# -lazy option not needed if stubs libraries are handled correctly
# load -lazy TCL_DIR/tclnetgenSHDLIB_EXT

load TCL_DIR/tclnetgenSHDLIB_EXT

#----------------------------------------------------------------
# Convert LVS list result into a JSON file 
#----------------------------------------------------------------

proc netgen::convert_to_json {filename lvs_final} {
   set pidx [string last . $filename]
   set jsonname [string replace $filename $pidx end ".json"]
   if {![catch {open $jsonname w} fjson]} {
      puts $fjson "\["
      # Outer list is of each cell compared
      set clen [llength $lvs_final]
      set cidx 0
      foreach circuit $lvs_final {
         incr cidx
         puts $fjson "  \{"
         set nkeys [llength $circuit]
         set kidx 0
	 foreach {key value} $circuit {
            incr kidx 2
	    switch $key {
	       name {
	          puts $fjson "   \"${key}\": \["
		  set cktval [lindex $value 0]
		  puts $fjson "      \"${cktval}\","
		  set cktval [lindex $value 1]
		  puts $fjson "      \"${cktval}\""
		  if {$kidx == $nkeys} {
		     puts $fjson "   \]"
		  } else {
		     puts $fjson "   \],"
		  }
	       }
	       pins {
	          puts $fjson "   \"${key}\": \["
	          puts $fjson "      \["
		  set cktval [lindex $value 0]
		  foreach pin [lrange $cktval 0 end-1] {
		     set pinstr [string map {"\\" "\\\\"} $pin]
		     puts $fjson "        \"$pinstr\","
		  }
		  set pin [string map {"\\" "\\\\"} [lindex $cktval end]]
		  puts $fjson "        \"$pin\""
	          puts $fjson "      \], \["
		  set cktval [lindex $value 1]
		  foreach pin [lrange $cktval 0 end-1] {
		     set pinstr [string map {"\\" "\\\\"} $pin]
		     puts $fjson "        \"$pinstr\","
		  }
		  set pin [string map {"\\" "\\\\"} [lindex $cktval end]]
		  puts $fjson "        \"$pin\""
	          puts $fjson "      \]"
		  if {$kidx == $nkeys} {
		     puts $fjson "   \]"
		  } else {
		     puts $fjson "   \],"
		  }
	       }
               nets {
	          puts $fjson "   \"${key}\": \["
		  set cktval [lindex $value 0]
		  puts $fjson "    $cktval,"
		  set cktval [lindex $value 1]
		  puts $fjson "    $cktval"
		  if {$kidx == $nkeys} {
		     puts $fjson "   \]"
		  } else {
		     puts $fjson "   \],"
		  }
               }
	       devices {
	          puts $fjson "   \"${key}\": \["
	          puts $fjson "       \["
		  set cktval [lindex $value 0]
		  foreach dev [lrange $cktval 0 end-1] {
		     set devname [lindex $dev 0]
		     set devnum  [lindex $dev 1]
		     puts $fjson "         \[\"${devname}\", ${devnum}\],"
		  }
		  set dev [lindex $cktval end]
		  set devname [lindex $dev 0]
		  set devnum  [lindex $dev 1]
		  puts $fjson "         \[\"${devname}\", ${devnum} \]"
	          puts $fjson "       \], \["
		  set cktval [lindex $value 1]
		  foreach dev [lrange $cktval 0 end-1] {
		     set devname [lindex $dev 0]
		     set devnum  [lindex $dev 1]
		     puts $fjson "         \[\"${devname}\", ${devnum} \],"
		  }
		  set dev [lindex $cktval end]
		  set devname [lindex $dev 0]
		  set devnum  [lindex $dev 1]
		  puts $fjson "         \[\"${devname}\", ${devnum} \]"
	          puts $fjson "       \]"
		  if {$kidx == $nkeys} {
		     puts $fjson "   \]"
		  } else {
		     puts $fjson "   \],"
		  }
	       }
	       goodnets -
	       badnets {
	          puts $fjson "   \"${key}\": \["
		  set glen [llength $value]
		  set gidx 0
		  foreach group $value {
		     incr gidx
	             puts $fjson "      \["
	             puts $fjson "        \["
		     set cktval [lindex $group 0]
		     set nlen [llength $cktval]
		     set nidx 0
		     foreach net $cktval {
			incr nidx
	                puts $fjson "          \["
			set netname [string map {"\\" "\\\\"} [lindex $net 0]]
		        puts $fjson "            \"$netname\","
		        puts $fjson "            \["
			set netconn [lindex $net 1]
			foreach fanout [lrange $netconn 0 end-1] {
			   set devname [lindex $fanout 0]
			   set pinname [lindex $fanout 1]
			   set count [lindex $fanout 2]
			   if {$count == {}} {set count 0}
		           puts $fjson "              \[ \"$devname\", \"$pinname\", $count \],"
			}
			set fanout [lindex $netconn end]
			set devname [lindex $fanout 0]
			set pinname [lindex $fanout 1]
			set count [lindex $fanout 2]
			if {$count == {}} {set count 0}
		        puts $fjson "              \[ \"$devname\", \"$pinname\", $count \]"
		        puts $fjson "            \]"
			if {$nidx == $nlen} {
	                   puts $fjson "          \]"
			} else {
	                   puts $fjson "          \],"
			}
		     }
	             puts $fjson "        \], \["
		     set cktval [lindex $group 1]
		     set nlen [llength $cktval]
		     set nidx 0
		     foreach net $cktval {
			incr nidx
	                puts $fjson "          \["
			set netname [string map {"\\" "\\\\"} [lindex $net 0]]
		        puts $fjson "            \"$netname\","
		        puts $fjson "            \["
			set netconn [lindex $net 1]
			foreach fanout [lrange $netconn 0 end-1] {
			   set devname [lindex $fanout 0]
			   set pinname [lindex $fanout 1]
			   set count [lindex $fanout 2]
			   if {$count == {}} {set count 0}
		           puts $fjson "              \[ \"$devname\", \"$pinname\", $count \],"
			}
			set fanout [lindex $netconn end]
			set devname [lindex $fanout 0]
			set pinname [lindex $fanout 1]
			set count [lindex $fanout 2]
			if {$count == {}} {set count 0}
		        puts $fjson "              \[ \"$devname\", \"$pinname\", $count \]"
		        puts $fjson "            \]"
			if {$nidx == $nlen} {
	                   puts $fjson "          \]"
			} else {
	                   puts $fjson "          \],"
			}
		     }
	             puts $fjson "        \]"
		     if {$gidx == $glen} {
	                puts $fjson "      \]"
		     } else {
	                puts $fjson "      \],"
		     }
		  }
		  if {$kidx == $nkeys} {
		     puts $fjson "   \]"
		  } else {
		     puts $fjson "   \],"
		  }
	       }
	       goodelements -
	       badelements {
	          puts $fjson "   \"${key}\": \["
		  set glen [llength $value]
		  set gidx 0
		  foreach group $value {
		     incr gidx
	             puts $fjson "      \["
	             puts $fjson "        \["
		     set cktval [lindex $group 0]
		     set ilen [llength $cktval]
		     set iidx 0
		     foreach inst $cktval {
			incr iidx
	                puts $fjson "          \["
			set instname [string map {"\\" "\\\\"} [lindex $inst 0]]
		        puts $fjson "            \"$instname\","
		        puts $fjson "            \["
			set instpins [lindex $inst 1]
			foreach fanout [lrange $instpins 0 end-1] {
			   set pinname [lindex $fanout 0]
			   set count [lindex $fanout 1]
			   if {$count == {}} {set count 0}
		           puts $fjson "              \[ \"$pinname\", $count \],"
			}
			set fanout [lindex $instpins end]
			set pinname [lindex $fanout 0]
			set count [lindex $fanout 1]
			if {$count == {}} {set count 0}
		        puts $fjson "              \[ \"$pinname\", $count \]"
		        puts $fjson "            \]"
			if {$iidx == $ilen} {
	                   puts $fjson "          \]"
			} else {
	                   puts $fjson "          \],"
			}
		     }
	             puts $fjson "        \], \["
		     set cktval [lindex $group 1]
		     set ilen [llength $cktval]
		     set iidx 0
		     foreach inst $cktval {
			incr iidx
	                puts $fjson "          \["
			set instname [string map {"\\" "\\\\"} [lindex $inst 0]]
		        puts $fjson "            \"$instname\","
		        puts $fjson "            \["
			set instpins [lindex $inst 1]
			foreach fanout [lrange $instpins 0 end-1] {
			   set pinname [lindex $fanout 0]
			   set count [lindex $fanout 1]
			   if {$count == {}} {set count 0}
		           puts $fjson "              \[ \"$pinname\", $count \],"
			}
			set fanout [lindex $instpins end]
			set pinname [lindex $fanout 0]
			set count [lindex $fanout 1]
			if {$count == {}} {set count 0}
		        puts $fjson "              \[ \"$pinname\", $count \]"
		        puts $fjson "            \]"
			if {$iidx == $ilen} {
	                   puts $fjson "          \]"
			} else {
	                   puts $fjson "          \],"
			}
		     }
	             puts $fjson "        \]"
		     if {$gidx == $glen} {
	                puts $fjson "      \]"
		     } else {
	                puts $fjson "      \],"
		     }
		  }
		  if {$kidx == $nkeys} {
		     puts $fjson "   \]"
		  } else {
		     puts $fjson "   \],"
		  }
	       }
	       properties {
	          puts $fjson "   \"${key}\": \["
		  set plen [llength $value]
                  set pidx 0
		  foreach instance $value {
		     incr pidx
	             puts $fjson "      \["
		     set instnames [string map {"\\" "\\\\"} [lindex $instance 0]]
		     set instname0 [string map {"\\" "\\\\"} [lindex $instnames 0]]
	             puts $fjson "         \["
		     puts $fjson "           \"${instname0}\","
	             puts $fjson "           \["
		     foreach property [lrange $instance 1 end-1] {
		        set prop0 [lindex $property 0]
			set propname [lindex $prop0 0]
			set propval [lindex $prop0 1]
		        puts $fjson "             \[\"${propname}\", \"${propval}\"\],"
		     }
		     set property [lindex $instance end]
		     set prop0 [lindex $property 0]
		     set propname [lindex $prop0 0]
		     set propval [lindex $prop0 1]
		     puts $fjson "             \[\"${propname}\", \"${propval}\"\]"
	             puts $fjson "           \]"
	             puts $fjson "         \],"
		     set instname1 [string map {"\\" "\\\\"} [lindex $instnames 1]]
	             puts $fjson "         \["
		     puts $fjson "           \"${instname1}\","
	             puts $fjson "           \["
		     foreach property [lrange $instance 1 end-1] {
		        set prop1 [lindex $property 1]
			set propname [lindex $prop1 0]
			set propval [lindex $prop1 1]
		        puts $fjson "             \[\"${propname}\", \"${propval}\"\],"
		     }
		     set property [lindex $instance end]
		     set prop1 [lindex $property 1]
		     set propname [lindex $prop1 0]
		     set propval [lindex $prop1 1]
		     puts $fjson "             \[\"${propname}\", \"${propval}\"\]"
	             puts $fjson "           \]"
	             puts $fjson "         \]"
		     if {$pidx == $plen} {
	                puts $fjson "      \]"
		     } else {
	                puts $fjson "      \],"
		     }
		  }
		  if {$kidx == $nkeys} {
		     puts $fjson "   \]"
		  } else {
		     puts $fjson "   \],"
		  }
	       }
	    }
	 }
         if {$cidx == $clen} {
            puts $fjson "  \}"
	 } else {
            puts $fjson "  \},"
	 }
      }
      puts $fjson "\]"
   }
   close $fjson
}

#-----------------------------------------------------------------------
# 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" may be "-list", "-json", or "-blackbox".
#    "-list" returns output as a nested list.
#    "-json" creates a .json-format output file in addition to stdout.
#    "-blackbox" treats empty cells as black-box entries.
#    "-noflatten={list}" is a list of cells not to flatten if mismatched.
#    i.e., the cells are expected to match and any mismatch cannot be
#    expected to be resolved by flattening the contents of the mismatched
#    cells.
#-----------------------------------------------------------------------

proc netgen::lvs { name1 name2 {setupfile setup.tcl} {logfile comp.out} args} {
   set dolist 0
   set dojson 0
   set noflat {}
   foreach arg $args {
      if {$arg == "-list"} {
	 puts stdout "Generating list result"
	 set dolist 1
	 set lvs_final {}
      } elseif {$arg == "-json"} {
	 puts stdout "Generating JSON file result"
	 set dolist 1
	 set dojson 1
	 set lvs_final {}
      } elseif {$arg == "-blackbox"} {
	 puts stdout "Treating empty subcircuits as black-box cells"
	 netgen::model blackbox on
      } elseif {[string first "-noflatten=" $arg] == 0} {
	 set value [string range $arg 11 end]
	 # If argument is a filename then read the list of cells from it;
	 # otherwise, argument is the list of files itself in quotes or
	 # braces.
	 if {[file exists $value]} {
	    if {![catch {open $value r} fnf]} {
	       while {[gets $fnf line] >= 0} {
		  if {[lindex $line 0] != "#"} {
		     foreach cell $line {
		    	lappend noflat $cell
		     }
		  }
	       }
	       close $fnf
	    } else {
	       puts stderr "Cannot open file $value for reading cell list."
	    }
	 } else {
	    set noflat [string trim $value \"\{\}]
	 }
	 if {[llength $noflat] > 0} {
	    puts stdout "Will not flatten these subcells: $noflat"
	 }
      }
   }

   # 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]
   }

   # The "noflat" list is non-file-specific, so run on each file.
   foreach cell $noflat {
      set cidx [lsearch -regexp $clist1 ^$cell$]
      if {$cidx >= 0} {
          netgen::flatten prohibit "$fnum1 $cell"
      }
      set cidx [lsearch -regexp $clist2 ^$cell$]
      if {$cidx >= 0} {
          netgen::flatten prohibit "$fnum2 $cell"
      }
   }

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

   if {$setupfile == ""} {
      puts stdout "\nNo setup file specified.  Using trivial default setup.\n"
      netgen::permute default	;# transistors and resistors
      netgen::property default
   } elseif {[file exists $setupfile]} {
      puts stdout "\nReading setup file $setupfile\n"
      # 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"
      }
   } elseif {[string first nosetup $setupfile] < 0} {
      puts stderr "\nError:  Setup file $setupfile does not exist.\n"
      return
   } else {
      puts stderr "\nNo setup file specified.  Continuing without a setup.\n"
   }

   if {[string first nolog $logfile] < 0} {
      puts stdout "Comparison output logged to file $logfile"
      netgen::log file $logfile

      netgen::log start
      netgen::log echo off
      set dolog true
   } else {
      set dolog false
   }

   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 {}
   set matcherr {}
   set childMismatch 0		;# 1 indicates black-box child subcircuit mismatch
   while {$endval != {}} {
      if {$dolist == 1} {
         netgen::run -list converge
      } else {
         netgen::run converge
      }
      set pinMismatch 0		;# indicates pin mismatch in top cell
      set doCheckFlatten 0
      set doFlatten 0
      if {[netgen::print queue] == {}} {
	 set doEquatePins 1 	;# run equate pins on top cell
      } else {
	 set doEquatePins 0	;# don't run equate pins unless unique match
      }
      set forceMatch 0		;# for pin matching
      netgen::log echo off

      if {[verify equivalent]} {
	 # Resolve automorphisms by pin and property
	 if {$dolist == 1} {
            netgen::run -list resolve
	 } else {
            netgen::run resolve
	 }
	 set uresult [verify unique]
	 # uresult:  -3 : unique with property error
	 #	     -2 : equivalent with port errors
	 #	     -1 : black box
	 #	      0 : equivalent but not unique
	 #	      1 : unique
         if {$uresult == 0} {
	    netgen::log echo on
	    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"
	    netgen::log echo off
	    if {$dolist == 1} {
	       verify -list nodes
	    } else {
	       verify nodes
	    }
	    set doCheckFlatten 1
	 } else {
	    # Equate pins for black boxes, unique matches (possibly with property
	    # errors), and unique with port errors
	    set doEquatePins 1
	 }
	 if {$uresult == -1} {		;# black box
	    set forceMatch 1
	 } elseif {$uresult == -3} {	;# property error
	    lappend properr [lindex $endval 0]
	 } elseif {$uresult == -2} {	;# unmatched pins
	    set doCheckFlatten 1
	 } elseif {$uresult == -4} {	;# unmatched pins and properties
	    lappend properr [lindex $endval 0]
	    set doCheckFlatten 1
	 }
      } else {
	 # not equivalent
	 netgen::log echo on
	 # netgen::log put "  DEBUG: not equivalent $endval\n"
	 netgen::log echo off
	 set doCheckFlatten 1
      }
      if {$doCheckFlatten} {
	 # Flatten the non-matching subcircuit (but not the top-level cell,
	 # or cells explicitly prohibited from flattening)
	 if {[netgen::print queue] != {}} {
	    if {([lsearch $noflat [lindex $endval 0]] == -1) &&
			([lsearch $noflat [lindex $endval 1]] == -1)} {
	       set doFlatten 1
	    } else {	
	       netgen::log echo on
	       netgen::log put "  Continuing with black-boxed subcircuits $endval\n"
	       netgen::log echo off
	       lappend matcherr [lindex $endval 0]"($fnum1)"
	       lappend matcherr [lindex $endval 1]"($fnum2)"
	       netgen::flatten prohibit "[lindex $endval 0] $fnum1"
	       netgen::flatten prohibit "[lindex $endval 1] $fnum2"
	       set doEquatePins 1
	       set childMismatch 1
	       set forceMatch 1
	    }
	 }
      }
      if {$doEquatePins} {
	 # Match pins
	 if {$dolist == 1} {
	    if {$forceMatch} {
	       set result [equate -list -force pins "$fnum1 [lindex $endval 0]" \
				"$fnum2 [lindex $endval 1]"]
	    } else {
	       set result [equate -list pins "$fnum1 [lindex $endval 0]" \
				"$fnum2 [lindex $endval 1]"]
	    }
	 } else {
	    if {$forceMatch} {
	       set result [equate -force pins "$fnum1 [lindex $endval 0]" \
				"$fnum2 [lindex $endval 1]"]
	    } else {
	       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]"
	 }
	 # Do not set pinMismatch for black boxes
	 if {$result < 0} {
	    if {$result == -1 && [netgen::print queue] != {} && $forceMatch != 1} {
               # flatten pin mismatch, but not empty cells (-2) or top cell or
	       # cells prohibited from flattening.
	       set doFlatten 1
	    }
	 } elseif {[netgen::print queue] == {} && $result == 0} {
	    set pinMismatch 1
	 } else {
	    # This assumes that proxy pins are added correctly.  Previously,
	    # that was not trusted, and so an initial pin mismatch would
	    # always force subcells to be flattened.
	    set doFlatten 0
	 }
      }
      if {$doFlatten} {
	 netgen::log echo on
	 netgen::log put "  Flattening non-matched subcircuits $endval\n"
	 netgen::log echo off
	 netgen::flatten class "[lindex $endval 0] $fnum1"
	 netgen::flatten class "[lindex $endval 1] $fnum2"
      }

      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 on
   netgen::log put "\nFinal result: "
   if {$pinMismatch || $childMismatch} {
      if {$childMismatch} {
	 netgen::log put "Subcell(s) failed matching.\n"
      }
      if {$pinMismatch} {
	 netgen::log put "Top level cell failed pin matching.\n"
      }
   } else {
      verify only
   }
   if {$properr != {}} {
      netgen::log put "\nThe following cells had property errors:\n " [regsub -all { } $properr "\n "] "\n"
   }
   if {$matcherr != {}} {
      netgen::log put "\nThe following subcells failed to match:\n " [regsub -all { } $matcherr "\n "] "\n"
   }
   if {$dolog} {
      netgen::log end
   }
   puts stdout "LVS Done."
   if {$dojson == 1} {
      netgen::convert_to_json $logfile $lvs_final
   } elseif {$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
#----------------------------------------------------------------------

# For use with open_pdks, set PDK_ROOT from the environment.  If no
# such environment variable exists, check some common locations.

if {[catch {set PDK_ROOT $::env(PDK_ROOT)}]} {
    if {[file isdir /usr/local/share/pdk] == 1} {
	set PDK_ROOT /usr/local/share/pdk
    } elseif {[file isdir /usr/share/pdk] == 1} {
	set PDK_ROOT /usr/share/pdk
    } elseif {[file isdir /foss/pdk] == 1} {
	set PDK_ROOT /foss/pdk
    }
}

# 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