/*----------------------------------------------------------------------*/
/* netlist.c --- xcircuit routines specific to schematic capture and	*/
/*		 netlist generation					*/
/*----------------------------------------------------------------------*/
/*  Copyright (c) 2002 Tim Edwards, Johns Hopkins University		*/
/*  Written April 1998 to January 2000				   	*/
/*  Original version for Pcb netlisting 3/20/98 by Chow Seong Hwai,	*/
/*			Leeds University, U.K.				*/
/*----------------------------------------------------------------------*/

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#if defined(DARWIN)
#include <sys/malloc.h>
#else
#include <malloc.h>
#endif

#ifdef HAVE_PYTHON
#include <Python.h>
#endif

#include <X11/Intrinsic.h>
#include <X11/StringDefs.h>

/*----------------------------------------------------------------------*/
/* Local includes							*/
/*----------------------------------------------------------------------*/

#include "xcircuit.h"
#include "colordefs.h"

/*----------------------------------------------------------------------*/
/* Function prototype declarations                                      */
/*----------------------------------------------------------------------*/
#include "prototypes.h"

#ifdef HAVE_PYTHON
extern PyObject *PyGetStringParts(stringpart *);
#endif

/*----------------------------------------------------------------------*/
/* Externally declared global variables					*/
/*----------------------------------------------------------------------*/

extern Display  *dpy;
extern int *appcolors;
extern float version;

/*----------------------------------------------------------------------*/
#ifdef SCHEMA

extern char _STR[150];
extern char _STR2[250];
extern Clientdata areastruct;
extern objectpair *pushlist;

NetlistPtr globallist;
struct Ptab *ptable;

u_int subindex;		/* count for labeling spice subcircuits	       */
u_int flatindex;	/* count for labeling devices in a flattened file */

#define EndPoint(n)	(((n == 1) ? 1 : (int)(n - 1)))
#define NextPoint(n)	(((n == 1) ? 0 : 1))

/*----------------------------------------------------------------------*/
/* Check whether two line segments attach to or cross each other	*/
/* Return 1 if attached, 0 if not (INLINE code)				*/
/* int onsegment(XPoint *a, XPoint *b, XPoint *x) {}			*/
/*----------------------------------------------------------------------*/

#define ONDIST 4  /* "slack" in algorithm for almost-touching lines */
#define onsegment(a, b, x) (finddist(a, b, x) <= ONDIST)

/*------------------------------------------------------------------*/
/* Check proximity of two points (within roundoff tolerance ONDIST) */
/*------------------------------------------------------------------*/

Boolean proximity(XPoint *point1, XPoint *point2)
{
   int dx, dy;

   dx = point1->x - point2->x;
   dy = point1->y - point2->y;

   if ((abs(dx) < ONDIST) && (abs(dy) < ONDIST)) return True;
   else return False;
}

/*----------------------------------------------------------------------*/
/* createnets(): Generate netlist structures				*/
/*									*/
/* Result is the creation of three linked lists inside each object in   */
/* the circuit hierarchy:						*/
/*									*/
/*    1) the netlist:  assigns a number to each network of polygons and	*/
/*	 	pin labels on the object.				*/
/*    2) the portlist:  a list of every network which is connected from	*/
/*		objects above this one in the hierarchy.		*/
/*    3) the calllist: a list of calls made from the object to all sub-	*/
/*		circuits.  Each calllist indicates the object and/or	*/
/*		instance being called, and a port list which must match */
/*		the portlist of the object being called (the port lists */
/*		are not reflexive, as the caller does not have to call	*/
/*		all of the instance's ports, but the instance must have	*/
/*		a port defined for every connection being called).	*/ 
/*    (see structure definitions in xcircuit.h).	   		*/
/*----------------------------------------------------------------------*/

void createnets()
{
   if (setobjecttype(objectdata)) {
      Wprintf("Generating netlists");
      gennetlist(objectdata, NORMINST);
      gencalllist(objectdata);
      Wprintf("Finished netlists");
   }
   else
      Wprintf("Error:  attempt to generate netlist for a symbol.");
}

/*----------------------------------------------------------------------*/
/* Free all memory associated with the netlists.			*/
/*----------------------------------------------------------------------*/

void destroynets()
{
   freetemplabels(objectdata);
   freenets(objectdata);
   freeglobals();
}

/*----------------------------------------------------------------------*/
/* Generate netlist, write information according to mode, and then	*/
/* destroy the netlist (this will be replaced eventually with a dynamic	*/
/* netlist model in which the netlist changes according to editing of	*/
/* individual elements, not created and destroyed wholesale)		*/
/*----------------------------------------------------------------------*/

void gennet(char *mode, char *suffix)
{
   /* Run cleartraversed() on all types.  The traversed flag allows a	*/
   /* check for infinite recursion when creating calllists.		*/

   if (checkvalid(objectdata) == -1) {
      if (cleartraversed(objectdata, 0) == -1) {
         Wprintf("Error:  Check for recursion in circuit!");
         return;
      }
      destroynets(objectdata);
      createnets();
   }
   
   if (objectdata->netlist != NULL)
      writenet(objectdata, mode, suffix);
   else
      Wprintf("Error generating netlist: no file written");
}

/*----------------------------------------------------------------------*/
/* Polygon types which are ignored when considering if a polygon	*/
/* belongs to a circuit network:					*/ 
/* 	Closed polygons (boxes)						*/
/*	Bounding box polygons						*/
/*	Filled polygons							*/
/*	Dashed and dotted line-style polygons				*/
/*----------------------------------------------------------------------*/

Boolean nonnetwork(polyptr cpoly)
{
   if (!(cpoly->style & UNCLOSED)) return True;
   if (cpoly->style & (DASHED | DOTTED | FILLSOLID | BBOX))
      return True;
   return False;
}

/*----------------------------------------------------------------------*/
/* Return the largest (most negative) net number in the global netlist	*/
/*----------------------------------------------------------------------*/

int globalmax()
{
   NetlistPtr gptr;
   int smin = 0;

   for (gptr = globallist; gptr != NULL; gptr = gptr->next)
      if (gptr->netid < smin)
	 smin = gptr->netid;

   return smin;
}

/*----------------------------------------------------------------------*/
/* Return the largest net number in an object's netlist			*/
/*----------------------------------------------------------------------*/

int netmax(objectptr cschem)
{
   NetlistPtr nptr;
   int smax = 0;

   for (nptr = cschem->netlist; nptr != NULL; nptr = nptr->next)
      if (nptr->netid > smax)
	 smax = nptr->netid;

   return smax;
}

/*----------------------------------------------------------------------*/
/* Resolve nets and pins for the indicated object			*/
/*									*/
/* When encountering object instances, call gennetlist() on the object  */
/* if it does not have a valid netlist, then recursively call		*/
/* gennetlist().  Ignore "info" labels, which are not part of the	*/
/* network.								*/
/*									*/
/*----------------------------------------------------------------------*/

void gennetlist(objectptr cschem, objinstptr thisinst)
{
   genericptr *cgen;
   labelptr olabel, clab;
   polyptr cpoly, tpoly;
   objectptr callobj;
   int netid, tmpid, resolved_net;

   XPoint *tpt, *tpt2, *endpt, *endpt2;
   int i, nextnet;
   NetlistPtr tnet;
   PolylistPtr plist;
   LabellistPtr lseek;

   /* Determine the type of object being netlisted */
   setobjecttype(cschem);

   /* Make sure that schematics are netlisted before their symbols */
   if (cschem->schemtype == SYMBOL && cschem->symschem != NULL &&
		cschem->symschem->netlist == NULL)
      gennetlist(cschem->symschem, NORMINST);

   nextnet = netmax(cschem) + 1;

   for (i = 0; i < cschem->parts; i++) {
      cgen = cschem->plist + i;

      /* Schematic pages and symbols acting as their own schematics are the	*/
      /* two types on which we recurse to find all sub-schematics.		*/

      if (cschem->schemtype == SCHEMATIC || (cschem->schemtype == SYMBOL &&
		cschem->symschem == NULL)) {

         /* Part 1:  Recursion */

         if ((*cgen)->type == OBJECT) {
	    objinstptr cinst, geninst;
	    cinst = TOOBJINST(cgen);
	
	    if (cinst->thisobject->symschem != NULL) {
	       callobj = cinst->thisobject->symschem;
	       geninst = NORMINST;
	    }
	    else {
	       callobj = cinst->thisobject;
	       geninst = cinst;
	    }
	
	    /* object on its own schematic */
	    if (callobj == cschem) continue;

	    if (callobj->netlist == NULL)
	       gennetlist(callobj, geninst);

	    /* Also generate netlist for pins in the corresponding symbol */
	    if (cinst->thisobject->symschem != NULL
			&& cinst->thisobject->netlist == NULL)
	       gennetlist(cinst->thisobject, cinst);
         }

         /* Part 2: Polygon ennumeration				*/ 
         /* Assign network numbers to all polygons in the object.	*/

         else if ((*cgen)->type == POLYGON) {
 	    cpoly = TOPOLY(cgen);

	    /* Ignore non-network (closed, bbox, filled) polygons */
	    if (nonnetwork(cpoly)) continue;

	    resolved_net = 0;

            for (tnet = cschem->netlist; tnet != NULL; tnet = tnet->next) {

	       /* Check for attachment of each segment of this polygon	*/
	       /* to position of every recorded pin label.		*/

	       for (lseek = tnet->labels; lseek != NULL; lseek = lseek->next) {
		  olabel = lseek->label;
	          for (endpt = cpoly->points; endpt < cpoly->points
		   		+ EndPoint(cpoly->number); endpt++) {
	             endpt2 = endpt + NextPoint(cpoly->number);
		     if (onsegment(endpt, endpt2, &olabel->position)) {
		        tmpid = pintonet(cschem, thisinst, olabel);
			if (resolved_net != 0) {
			   mergenets(cschem, resolved_net, tmpid);
		        }
		        else {
		           addpoly(cschem, cpoly, tmpid);
		        }
		        resolved_net = tmpid;
		        break;
		     }
		  }
	       }

	       /* Check for attachment of each segment of this polygon */
	       /* to endpoints of every recorded network polygon.      */

	       for (plist = tnet->polygons; plist != NULL; plist = plist->next) { 
	          if ((tpoly = plist->poly) == cpoly) continue;
		  tpt = tpoly->points;
		  tpt2 = tpoly->points + tpoly->number - 1;

	          for (endpt = cpoly->points; endpt < cpoly->points
		   		+ EndPoint(cpoly->number); endpt++) {
	             endpt2 = endpt + NextPoint(cpoly->number);

		     if (onsegment(endpt, endpt2, tpt) ||
				onsegment(endpt, endpt2, tpt2)) {
			if (resolved_net != 0) {
		           /* Nets previously counted distinct have    */
		           /* been connected together by this polygon. */
			   mergenets(cschem, resolved_net, tnet->netid);
		        }
		        else {
		           addpoly(cschem, cpoly, tnet->netid);
		        }
		        resolved_net = tnet->netid;
		        break;
		     }
		  }

	          /* Check for attachment of the endpoints of this polygon	*/
	          /* to each segment of every recorded network polygon.	*/

		  endpt = cpoly->points;
		  endpt2 = cpoly->points + cpoly->number - 1;
	          for (tpt = tpoly->points; tpt < tpoly->points
			   + EndPoint(tpoly->number); tpt++) {
		     tpt2 = tpt + NextPoint(tpoly->number);

	     	     if (onsegment(tpt, tpt2, endpt) ||
			   	onsegment(tpt, tpt2, endpt2)) {
		        if (resolved_net != 0) {
		           /* Nets previously counted distinct have    */
		           /* been connected together by this polygon. */
			   mergenets(cschem, resolved_net, tnet->netid);
		        }
		        else {
		           addpoly(cschem, cpoly, tnet->netid);
		        }
		        resolved_net = tnet->netid;
		        break;
		     }
		  }
	       }
	    }

	    if (resolved_net == 0) {

	       /* This polygon belongs to an unvisited network. */
	       /* Give this polygon a new net number and add to */
	       /* the net list.				     */

	       addpoly(cschem, cpoly, nextnet++);
	    }
	 }
      }

      /* Part 3:  Match pin labels to nets, and add to list of globals	*/
      /* if appropriate.						*/

      if ((*cgen)->type == LABEL) {
	 clab = TOLABEL(cgen);
	 if (clab->pin != False && clab->pin != INFO) {

	    /* Check if this pin's position is on an existing net  */
	    /* Do this before pintonet(), because pointtonet() can */
	    /* renumber the nets, thus invalidating the result of  */
	    /* any prior call to pintonet().			   */

	    netid = pointtonet(cschem, &clab->position);

	    /* Check if this pin has the same name as an existing pin		*/
	    /* (The schematic is netlisted before the symbol, so the netlist	*/
	    /* should be there)							*/

            if (cschem->symschem != NULL && cschem->schemtype == SYMBOL) {
	       tmpid = 0;
	       for (tnet = cschem->symschem->netlist; tnet != NULL; tnet = tnet->next) {
	          for (lseek = tnet->labels; lseek != NULL; lseek = lseek->next) {
		     olabel = lseek->label;
                     if (!stringcomprelaxed(olabel->string, clab->string,
				thisinst)) {
		        tmpid = pintonet(cschem->symschem, thisinst, olabel);
		        break;
		     }
	          }
	          if (tmpid != 0) break;
	       }
	       /* There is always the possibility that the symbol pin does */
	       /* not correspond to anything in the schematic.  If so, it  */
	       /* gets its own unique net number.			   */

	       if (tmpid == 0) tmpid = nextnet++;
	    }
	    else
	       tmpid = pintonet(cschem, thisinst, clab);

	    if (clab->pin == LOCAL) {
	       if (tmpid != 0) {
	          addpin(cschem, clab, tmpid);
	          if (netid != 0)
	             mergenets(cschem, netid, tmpid);
	       }
	       else {
	          if (netid == 0)
		     netid = nextnet++;
	          addpin(cschem, clab, netid);
	       }
	    }
	    else if (clab->pin == GLOBAL) {
	       if (tmpid == 0)
	          tmpid = globalmax() - 1;
	       addglobal(clab, tmpid);
	       addpin(cschem, clab, tmpid);
	       if (netid != 0)
	          mergenets(cschem, netid, tmpid);
            }
         }
      }
   }
   if (cschem->symschem != NULL)
      mergecleanup(cschem->symschem);
   mergecleanup(cschem);
}

/*--------------------------------------------------------------*/
/* Search a sibling of object instance "cinst" for connections	*/
/* between the two.  Recurse through the schematic hierarchy of	*/
/* the sibling object.						*/
/*--------------------------------------------------------------*/

void search_on_siblings(objinstptr cinst, objinstptr isib, objectpair *schemtop,
	short llx, short lly, short urx, short ury)
{
   XPoint *tmppts, sbbox[2];
   int i;
   labelptr olabel;
   polyptr tpoly;
   NetlistPtr nseek;
   PolylistPtr pseek;
   LabellistPtr lseek;

   genericptr *iseek;
   objinstptr subsibinst;
   objectpair *psearch, *newpair;
   objectptr  sibling = isib->thisobject;
   
   tmppts = (XPoint *)malloc(sizeof(XPoint));

   /* If the sibling is a symbol or fundamental or trivial object, then */
   /* we just look at pin labels from the parts list and return.	*/

   if (sibling->symschem != NULL || sibling->schemtype == FUNDAMENTAL
		|| sibling->schemtype == TRIVIAL) {
      for (nseek = sibling->netlist; nseek != NULL; nseek = nseek->next) {
	 for (lseek = nseek->labels; lseek != NULL; lseek = lseek->next) {
	    olabel = lseek->label;

	    tmppts = (XPoint *)realloc(tmppts, sizeof(XPoint));
	    UTransformPoints(&(olabel->position), tmppts, 1,
			isib->position, isib->scale, isib->rotation);

	    /* Transform all the way up to the level above cinst */
	    for (psearch = schemtop; psearch != NULL; psearch = psearch->nextpair) {
	       subsibinst = psearch->thisinst;
	       UTransformPoints(tmppts, tmppts, 1, subsibinst->position,
				subsibinst->scale, subsibinst->rotation);
	    }
	    searchconnect(tmppts, 1, cinst);
	 }
      }
   }

   /* If the sibling is a schematic, we look at connections to pins and */
   /* polygons, and recursively search subschematics of the sibling.	*/

   else {

      /* check polygon ends and label positions (from netlist) */

      for (nseek = sibling->netlist; nseek != NULL; nseek = nseek->next) {

         /* Look for pins connecting to pins in the object */

         for (lseek = nseek->labels; lseek != NULL; lseek = lseek->next) {
	    olabel = lseek->label;
	    tmppts = (XPoint *)realloc(tmppts, sizeof(XPoint));
	    UTransformPoints(&(olabel->position), tmppts, 1,
			isib->position, isib->scale, isib->rotation);

	    /* Transform all the way up to the level above cinst */
	    for (psearch = schemtop; psearch != NULL; psearch = psearch->nextpair) {
	       subsibinst = psearch->thisinst;
	       UTransformPoints(tmppts, tmppts, 1, subsibinst->position,
			subsibinst->scale, subsibinst->rotation);
	    }
	    searchconnect(tmppts, 1, cinst);
	 }

         /* Look for polygon ends connecting into the object */

         for (pseek = nseek->polygons; pseek != NULL; pseek = pseek->next) {
	    tpoly = pseek->poly;
	    tmppts = (XPoint *)realloc(tmppts, tpoly->number * sizeof(XPoint));
	    UTransformPoints(tpoly->points, tmppts, tpoly->number,
				isib->position, isib->scale, isib->rotation);

	    /* Transform all the way up to the level above cinst */
	    for (psearch = schemtop; psearch != NULL; psearch = psearch->nextpair) {
	       subsibinst = psearch->thisinst;
	       UTransformPoints(tmppts, tmppts, 1, subsibinst->position,
				subsibinst->scale, subsibinst->rotation);
	    }
	    searchconnect(tmppts, tpoly->number, cinst);
         }
      }

      /* Recursively search all schematic children of the sibling */

      for (i = 0; i < sibling->parts; i++) {
	 iseek = sibling->plist + i;
	 if ((*iseek)->type == OBJECT) {

	    /* Don't search this instance unless the bounding box 	*/
	    /* overlaps the bounding box of the calling object.		*/

	    calcinstbbox(iseek, &sbbox[0].x, &sbbox[0].y, &sbbox[1].x, &sbbox[1].y);
	    for (psearch = schemtop; psearch != NULL; psearch = psearch->nextpair) {
	       subsibinst = psearch->thisinst;
	       UTransformPoints(sbbox, sbbox, 2, subsibinst->position,
			subsibinst->scale, subsibinst->rotation);
	    }
	    if ((llx > sbbox[1].x) || (urx < sbbox[0].x) || (lly > sbbox[1].y)
			|| (ury < sbbox[0].y))
	       continue;

	    subsibinst = TOOBJINST(iseek);

	    /* push stack */
	    newpair = (objectpair *)malloc(sizeof(objectpair));
	    newpair->thisinst = isib;
	    newpair->thisobject = sibling;
	    newpair->nextpair = schemtop;
	    schemtop = newpair;

	    search_on_siblings(cinst, subsibinst, schemtop, llx, lly, urx, ury);

	    /* pop stack */

	    newpair = schemtop;
	    schemtop = schemtop->nextpair;
	    free(newpair);
	 }
      }
   }
   free(tmppts);
}

/*--------------------------------------------------------------*/
/* Generate ports from pin labels for all objects:		*/
/* For each pin-label in the subcircuit or symbol, generate	*/
/* a port in the object or instance's object.			*/
/* Translate the pin position to the level above and search	*/
/* for & link in any connecting nets.				*/
/*								*/
/* Generate calls to object instances.				*/
/* Pick up any other nets which might be formed by		*/
/* juxtaposition of object instances on different levels of the */
/* schematic hierarchy (e.g., pin-to-pin connections).		*/
/*--------------------------------------------------------------*/
	
void gencalllist(objectptr cschem)
{
   genericptr *cgen, *iseek;
   Matrix locctm;
   objinstptr cinst, isib;
   objectptr callobj, callsymb;
   XPoint xpos;
   short ibllx, iblly, iburx, ibury, sbllx, sblly, sburx, sbury;
   int i, j, netfrom, netto;
   labelptr olabel;
   polyptr tpoly;
   NetlistPtr nseek;
   PolylistPtr pseek;
   LabellistPtr lseek;
   
   cschem->traversed = True;	/* This object has been dealt with */
   cschem->valid = True;	/* This object has a valid netlist */

   for (i = 0; i < cschem->parts; i++) {
      cgen = cschem->plist + i;
      if ((*cgen)->type == OBJECT) {
	 cinst = TOOBJINST(cgen);

	 /* Determine where the hierarchy continues downward */

	 if (cinst->thisobject->symschem != NULL)
	    callobj = cinst->thisobject->symschem;
	 else
	    callobj = cinst->thisobject;

	 /* Ignore any object on its own schematic */

	 if (callobj == cschem) continue;

	 callsymb = cinst->thisobject;

	 /* Note:  callobj is the next schematic in the hierarchy.	*/
	 /* callsymb is the next visible object in the hierarchy, 	*/
	 /* which may be either a schematic or a symbol.		*/

	 /*-------------------------------------------------------------*/
	 /* For object instances which are their own schematics (i.e.,	*/
	 /* have netlist elements), don't rely on any pin list but make	*/
	 /* a survey of how polygons connect into the object.		*/
	 /*-------------------------------------------------------------*/

	 if (callsymb->symschem == NULL
		&& callobj->schemtype != FUNDAMENTAL
		&& callobj->schemtype != TRIVIAL) {

            /* printf("*** Analyzing connections from %s"
		" to instance of %s\n", cschem->name, cinst->thisobject->name); */

	    for (nseek = cschem->netlist; nseek != NULL; nseek = nseek->next) {

	       /* Look for pins connecting to pins in the object */

	       for (lseek = nseek->labels; lseek != NULL; lseek = lseek->next) {
	 	  olabel = lseek->label;
	          searchconnect(&(olabel->position), 1, cinst);
	       }

	       /* Look for polygon ends connecting into the object */

	       for (pseek = nseek->polygons; pseek != NULL; pseek = pseek->next) {
		  tpoly = pseek->poly;
	          searchconnect(tpoly->points, tpoly->number, cinst);
	       }
	    }

	    /* For each call to a schematic or symbol which is NOT the	*/
	    /* one under consideration, see if it touches or overlaps	*/
	    /* the object under consideration.  Search for connections	*/
	    /* between the two objects.					*/

	    calcinstbbox(cgen, &ibllx, &iblly, &iburx, &ibury);

	    /* Only need to look forward from the current position. */
   	    for (j = i + 1; j < cschem->parts; j++) {

	       iseek = cschem->plist + j;
	       if ((*iseek)->type == OBJECT) {
		  calcinstbbox(iseek, &sbllx, &sblly, &sburx, &sbury);

		  /* Check intersection of the two object instances;	*/
		  /* don't do a search if they are disjoint.		*/

		  if ((ibllx <= sburx) && (iburx >= sbllx) &&
				(iblly <= sbury) && (ibury >= sblly)) {
		     isib = TOOBJINST(iseek);
		     search_on_siblings(cinst, isib, NULL,	
				ibllx, iblly, iburx, ibury);
		  }
	       }
	    }
	 }

	 /*-------------------------------------------------------------*/
	 /* Recursively call gencalllist() on the schematic.		*/
	 /*-------------------------------------------------------------*/

	 if (callobj->traversed == False)
	    gencalllist(callobj);

	 /*-------------------------------------------------------------*/
	 /* Create a call to the object callsymb from object cschem	*/
	 /*-------------------------------------------------------------*/

	 addcall(cschem, callobj, cinst);

	 /*-------------------------------------------------------------*/
	 /* Search again on symbol pins to generate calls to ports.  	*/ 
	 /*-------------------------------------------------------------*/

	 UResetCTM(&locctm);
	 UPreMultCTM(&locctm, cinst->position, cinst->scale, cinst->rotation);

	 for (nseek = callsymb->netlist; nseek != NULL; nseek = nseek->next) {
	    for (lseek = nseek->labels; lseek != NULL; lseek = lseek->next) {
	       olabel = lseek->label;
	       netto = nseek->netid;

	       /* Translate pin position back to object cschem */
	       UTransformbyCTM(&locctm, &(olabel->position), &xpos, 1);  

	       /* What net in the calling object connects to this point? */
	       netfrom = pointtonet(cschem, &xpos);

	       /* If there's no net, we make one */
	       if (netfrom == 0)
		  netfrom = make_tmp_pin(cschem, &xpos);

	       /* Pass global net up the hierarchy without making a call. */
	       if (netto < 0)
		  mergenets(cschem, netfrom, netto);

	       else {
		  LabellistPtr slab;
		  labelptr slabel;
		  int othernet;

		  /* Attempt to generate a port in the object.  If the  */
		  /* object already has a port for this net, find which */
		  /* (other) pin connects to that port, find which net  */
		  /* in the calling object connects to that pin, and	*/
		  /* merge the nets together.				*/

		  if (!addport(callobj, netto)) {
		     if (nseek->labels->next != NULL) {  /* net has > 1 label */
			for (slab = nseek->labels; slab != NULL; slab = slab->next) {
			   if (slab == lseek) continue;
			   slabel = slab->label;
		  	   UTransformbyCTM(&locctm, &(slabel->position),
						&xpos, 1);
			   othernet = pointtonet(cschem, &xpos);
			   if (othernet != 0) {
			      if (othernet < 0) {
				 mergenets(cschem, netfrom, othernet);
				 netfrom = othernet;
			      }
			      else
				 mergenets(cschem, othernet, netfrom);
			   }
			}
		     }
		  }

		  /* Generate a call to that port in the	*/
		  /* calling instance's call list.		*/

		  addportcall(cschem, cinst, callobj, netfrom, netto);
	       }
	    }
	 }

	 /*---------------------------------------------------------------------*/
	 /* If after all that, no ports were called, then remove the call to	*/
	 /* this object instance 						*/
	 /*---------------------------------------------------------------------*/

	 if (cschem->calllist->ports == NULL)
	    removecall(cschem, cschem->calllist);
      }
   }
   if (cschem->symschem != NULL)
      mergecleanup(cschem->symschem);
   mergecleanup(cschem);
}

/*----------------------------------------------------------------------*/
/* Translate a net number down in the calling hierarchy			*/
/*----------------------------------------------------------------------*/

int translatedown(int rnet, int portid, CalllistPtr thiscall)
{
   PortlistPtr nport;
   objectptr nextobj = thiscall->callobj;
   int downnet = 0;

   for (nport = nextobj->portlist; nport != NULL; nport = nport->next) {
      if (nport->portid == portid) {
	 downnet = nport->netid;
	 break;
      }
   }
   return downnet;
}

/*----------------------------------------------------------------------*/
/* Translate a net number up in the calling hierarchy			*/
/*----------------------------------------------------------------------*/

int translateup(int rnet, objectptr thisobj, objectptr nextobj, objinstptr nextinst)
{
   PortlistPtr nport;
   CalllistPtr ccall;
   int portid = 0;
   int upnet = 0;

   for (nport = nextobj->portlist; nport != NULL; nport = nport->next) {
      if (nport->netid == rnet) {
	 portid = nport->portid;
	 break;
      }
   }

   for (ccall = thisobj->calllist; ccall != NULL; ccall = ccall->next) {
      if (ccall->callinst == nextinst) {
	 for (nport = ccall->ports; nport != NULL; nport = nport->next) {
	    if (nport->portid == portid) {
	       upnet = nport->netid;
	       break;
	    }
	 }
	 if (nport != NULL) break;
      }
   }
   return upnet;
}

/*----------------------------------------------------------------------*/
/* Check whether the indicated polygon is already resolved into the	*/
/* netlist of the object hierarchy described by seltop.			*/
/* Return the net ID if resolved, 0 otherwise.  The net ID returned is  */
/* referred (translated) upward through the calling hierarchy to the 	*/
/* topmost object containing that net.  This topmost object is returned	*/
/* in parameter topobj.							*/
/*----------------------------------------------------------------------*/

int is_resolved(genericptr *rgen, objectpair *seltop, objectptr *topobj)
{
   objectptr thisobj = seltop->thisobject;
   NetlistPtr netlist;
   PolylistPtr pseek;
   LabellistPtr lseek;
   int tmpnet;
   int rnet = 0;

   /* Recursively call self, since we have to back out from the bottom of  */
   /* the stack.							   */

   if (seltop->nextpair != NULL) {
      rnet = is_resolved(rgen, seltop->nextpair, topobj);

      /* Translate network ID up the hierarchy to the topmost object in which */
      /* the network exists.						   */
   
      tmpnet = translateup(rnet, thisobj, seltop->nextpair->thisobject,
			seltop->nextpair->thisinst);
      if (tmpnet == 0)
         /* Net does not exist upwards of this object.  Pass net ID	*/
         /* upward with "topobj" unchanged.				*/
	 return rnet;
      else
	 rnet = tmpnet;
   }
   else {

      /* Find the net ID for the listed object, which should be in the object */
      /* on the bottom of the objectpair stack.				   */

      for (netlist = thisobj->netlist; netlist != NULL; netlist = netlist->next) {
         if ((*rgen)->type == POLYGON) {
	    for (pseek = netlist->polygons; pseek != NULL; pseek = pseek->next) {
               if (pseek->poly == TOPOLY(rgen)) {
 	          rnet = netlist->netid;
	       }
	    }
	 }
         else if ((*rgen)->type == LABEL) {
	    for (lseek = netlist->labels; lseek != NULL; lseek = lseek->next) {
               if (lseek->label == TOLABEL(rgen)) {
 	          rnet = netlist->netid;
	       }
	    }
	 }
      }

      if (rnet == 0) {
         *topobj = NULL;
         return 0;
      }
   }

   *topobj = seltop->thisobject;
   return rnet;
}


/*--------------------------------------------------------------*/
/* Highlight all the polygons and pin labels in a network	*/
/* (recursively, downward).  Pin labels are drawn only on the	*/
/* topmost schematic object.					*/
/*--------------------------------------------------------------*/

void highlightnet(objectptr cschem, objinstptr cinst, int netid)
{
   NetlistPtr netlist;
   CalllistPtr calllist;
   PortlistPtr portlist;
   PolylistPtr plist;
   LabellistPtr llist;
   polyptr cpoly;
   labelptr clabel;
   objinstptr ccinst;
   int netto;

   XcSetFunction(GXcopy);
   XSetForeground(dpy, areastruct.gc, AUXCOLOR);

   for (netlist = cschem->netlist; netlist != NULL; netlist = netlist->next) {
      if (netlist->netid == netid) {
	 for (plist = netlist->polygons; plist != NULL; plist = plist->next) {
            cpoly = plist->poly;
	    /* printf(" >> Found polygon belonging to net %d at (%d, %d)\n",
	       		netid, cpoly->points[0].x, cpoly->points[0].y); */
            UDrawPolygon(cinst, cpoly);
	 }
	 if (cschem == objectdata) {
	    for (llist = netlist->labels; llist != NULL; llist = llist->next) {
	       clabel = llist->label;
	       if (clabel->string->type == FONT_NAME) {  /* don't draw temp labels */
	          UDrawString(cinst, clabel, DOFORALL);
	          /* printf(" >> Found label belonging to net %d at (%d, %d)\n",
	       		netid, clabel->position.x, clabel->position.y); */
	       }
	    }
	 }
	 break;
      }
   }

   for (calllist = cschem->calllist; calllist != NULL; calllist = calllist->next) {
      for (portlist = calllist->ports; portlist != NULL; portlist = portlist->next) {
         if (portlist->netid == netid) {
	    ccinst = calllist->callinst;

	    /* Recurse only on objects for which network polygons are visible	*/
	    /* from the calling object:  i.e., non-trivial, non-fundamental	*/
	    /* objects acting as their own schematics.				*/

	    if (ccinst->thisobject->symschem == NULL &&
			ccinst->thisobject->schemtype != FUNDAMENTAL &&
			ccinst->thisobject->schemtype != TRIVIAL) {
	       UPushCTM();
	       UPreMultCTM(DCTM, ccinst->position, ccinst->scale, ccinst->rotation);

	       netto = translatedown(netid, portlist->portid, calllist);

	       /* printf(" > Calling object %s at (%d, %d)\n",
	          calllist->callobj->name, ccinst->position.x, ccinst->position.y); */
	       /* printf(" > Net translation from %d to %d\n", netid, netto); */

	       highlightnet(calllist->callobj, calllist->callinst, netto);
	       UPopCTM();
	    }
	 }
      }
   }
}

/*----------------------------------------------------------------------*/
/* Push the matrix stack for each object (instance) until the indicated	*/
/* object is reached.  This works similarly to highlightnet() above, 	*/
/* but makes calls according to the hierarchy described by the 		*/
/* objectpairptr parameter.						*/
/* Returns the number of stack objects to pop after we're done.		*/
/*----------------------------------------------------------------------*/

int pushnetwork(objectpair *seltop, objectptr nettop)
{
   objectpair *cursel = seltop;
   objinstptr sinst;
   int rno = 0;

   while ((cursel->thisobject != nettop) && (cursel->nextpair != NULL)) {
      cursel = cursel->nextpair;
      sinst = cursel->thisinst;
      UPushCTM();
      UPreMultCTM(DCTM, sinst->position, sinst->scale, sinst->rotation);
      rno++;
   }

   if (cursel->thisobject != nettop) {
      fprintf(stderr, "Error:  object does not exist in calling stack!\n");
      rno = 0;
   }

   return rno;
}

/*----------------------------------------------------------------------*/
/* Create a temporary I/O pin (becomes part of netlist and also part of	*/
/* the object itself)							*/
/*----------------------------------------------------------------------*/

int make_tmp_pin(objectptr cschem, XPoint *pinpt)
{
   NetlistPtr nseek;
   LabellistPtr lseek;
   labelptr *newlabel;
   stringpart *strptr;
   char *pinstring = NULL;
   int netid;

   /* Determine a net number for this pin */

   netid = pointtonet(cschem, pinpt);
   if (netid == 0)
      netid = netmax(cschem) + 1;

   /* If there is already a temporary pin associated with the net,	*/
   /* or any pin at this location, don't make another one.		*/

   else {
      for (nseek = cschem->netlist; nseek != NULL; nseek = nseek->next) {
         if (nseek->netid == netid) {
	    for (lseek = nseek->labels; lseek != NULL; lseek = lseek->next) {
	       if (proximity(&(lseek->label->position), pinpt))
		  return netid;
	       else if (lseek->label->string->type == TEXT_STRING)
	          pinstring = lseek->label->string->data.string;
	    }
	 }
      }
   }

   /* Create a new label object for the pin */

   NEW_LABEL(newlabel, cschem);
   labeldefaults(*newlabel, LOCAL, pinpt->x, pinpt->y);
   (*newlabel)->justify = 0;
   (*newlabel)->color = DEFAULTCOLOR;
   strptr = (*newlabel)->string;
   /* This label is never drawn, so it doesn't need font info. */
   strptr->type = TEXT_STRING;
   if (pinstring == NULL) {
      strptr->data.string = (char *)malloc(12);
      sprintf(strptr->data.string, "ext%d", netid);
   }
   else {
      strptr->data.string = (char *)malloc(strlen(pinstring));
      strcpy(strptr->data.string, pinstring);
   }
   cschem->parts++;

   /* Add label to object's netlist */

   addpin(cschem, *newlabel, netid);
   return netid;
}

/*--------------------------------------------------------------*/
/* Search for connections into a non-symbol subcircuit, based	*/
/* on various combinations of polygon and pin label overlaps.	*/
/*--------------------------------------------------------------*/

Boolean searchconnect(XPoint *points, int number, objinstptr cinst)
{
   XPoint *tmppts, *tpt, *tpt2, *endpt, *endpt2, *pinpt, opinpt;
   objinstptr tinst;
   genericptr *cgen;
   polyptr tpoly;
   labelptr tlab;
   objectptr tobj, cobj = cinst->thisobject;
   NetlistPtr nseek;
   LabellistPtr tseek;
   PolylistPtr pseek;
   int i;
   Boolean found = False;

   /* Generate temporary polygon in the coordinate system of	*/
   /* the object instance in question			 	*/

   tmppts = (XPoint *)malloc(number * sizeof(XPoint));
   InvTransformPoints(points, tmppts, number,
		cinst->position, cinst->scale, cinst->rotation);
   /* printf("Info: translated polygon w.r.t. object %s\n",	*/
   /* 		cinst->thisobject->name);			*/

   /* Recursion on all appropriate sub-schematics. */
   /* (Use parts list, not call list, as call list may not have created yet) */

   for (i = 0; i < cobj->parts; i++) {
      cgen = cobj->plist + i;
      if ((*cgen)->type == OBJECT) {
	 tinst = TOOBJINST(cgen);
	 if (tinst->thisobject->symschem == NULL) {
            tobj = tinst->thisobject;
	    if (tobj->schemtype != FUNDAMENTAL && tobj->schemtype != TRIVIAL)
	       if (searchconnect(tmppts, number, tinst)) found = True;
	 }
      }
   }

   for (endpt = tmppts; endpt < tmppts + EndPoint(number); endpt++) {
      endpt2 = endpt + NextPoint(number);
      for (i = 0; i < cobj->parts; i++) {
	 cgen = cobj->plist + i;
         if ((*cgen)->type != OBJECT) continue;
	 tinst = TOOBJINST(cgen);

	 /* Look at the object only (symbol, or schematic if it has no symbol) */
         tobj = tinst->thisobject;

	 /* Search for connections to pin labels */

	 for (nseek = tobj->netlist; nseek != NULL; nseek = nseek->next) {
	    for (tseek = nseek->labels; tseek != NULL; tseek = tseek->next) {
	       tlab = tseek->label;
	       UTransformPoints(&(tlab->position), &opinpt, 1, tinst->position,
				tinst->scale, tinst->rotation);
	       if (onsegment(endpt2, endpt, &opinpt)) {
		  /* printf("%s connects to pin %s of %s in %s\n",   */
		  /*	((number > 1) ? "Polygon" : "Pin"),		*/
		  /*	tlab->string + 2, tinst->thisobject->name,	*/
		  /* 	cinst->thisobject->name);		*/
		  make_tmp_pin(cobj, &opinpt);
		  found = True;
		  break;
	       }
	    }
	 }
      }

      for (nseek = cobj->netlist; nseek != NULL; nseek = nseek->next) {
	 for (pseek = nseek->polygons; pseek != NULL; pseek = pseek->next) {
	    tpoly = pseek->poly;

	    /* Search for connections from segments passed to this	*/
	    /* function to endpoints of polygons in the netlist.	*/

	    pinpt = NULL;
	    tpt = tpoly->points;
	    tpt2 = tpoly->points + tpoly->number - 1;
	    if (onsegment(endpt2, endpt, tpt)) pinpt = tpt;
	    if (onsegment(endpt2, endpt, tpt2)) pinpt = tpt2;

	    /* Create new pinlabel (only if there is not one already there) */

	    if (pinpt != NULL) {
	       make_tmp_pin(cobj, pinpt);
	       found = True;
	    }
         }
      }
   }

   endpt = tmppts;
   endpt2 = tmppts + EndPoint(number) - 1;

   /* Search for connections from endpoints passed to this	*/
   /* function to segments of polygons in the netlist.		*/

   for (nseek = cobj->netlist; nseek != NULL; nseek = nseek->next) {
      for (pseek = nseek->polygons; pseek != NULL; pseek = pseek->next) {

	 tpoly = pseek->poly;
	 for (tpt = tpoly->points; tpt < tpoly->points
			+ EndPoint(tpoly->number); tpt++) {
	    tpt2 = tpt + NextPoint(tpoly->number);

  	    pinpt = NULL;
	    if (onsegment(tpt2, tpt, endpt)) pinpt = endpt;
	    if (onsegment(tpt2, tpt, endpt2)) pinpt = endpt2;

	    /* Create new pinlabel (only if there is not one already there) */

	    if (pinpt != NULL) {
	       make_tmp_pin(cobj, pinpt);
	       found = True;
	    }
	 }
      }
   }
   free(tmppts);
   return(found);
}

/*----------------------------------------------------------------------*/
/* Insert given polygon into netlist 				   	*/
/* Associate polygon with given net id					*/ 
/*----------------------------------------------------------------------*/

void addpoly(objectptr cschem, polyptr poly, int netid)
{
   NetlistPtr netptr;
   PolylistPtr newpoly;

   for (netptr = cschem->netlist;  netptr != NULL; netptr = netptr->next) {
      if (netptr->netid == netid) {
	 /* Link poly to polygon list for this existing network */
	 newpoly = (PolylistPtr) malloc(sizeof(Polylist));
	 newpoly->poly = poly;
	 newpoly->next = netptr->polygons;
	 netptr->polygons = newpoly;
	 return;
      }
   }

   /* Net ID doesn't exist yet, so create a new Netlist for it */
	
   netptr = (NetlistPtr) malloc(sizeof(Netlist));
   netptr->polygons = (PolylistPtr) malloc(sizeof(Polylist));
   netptr->polygons->poly = poly;
   netptr->polygons->next = NULL;
   netptr->netid = netid;
   netptr->next = cschem->netlist;
   netptr->labels = NULL;
   netptr->localpin = NULL;
   cschem->netlist = netptr;
}

/*-------------------------------------------------------------------------*/

long zsign(long a, long b)
{
   if (a > b) return 1;
   else if (a < b) return -1;
   else return 0; 
}

/*----------------------------------------------------------------------*/
/* Remove nets with netid 0 (created by mergenets()) from the netlist   */
/*----------------------------------------------------------------------*/

void mergecleanup(objectptr cschem)
{
   NetlistPtr netlist = cschem->netlist, nullnet;

   while ((netlist != NULL) && (netlist->netid == 0)) {
      nullnet = netlist;
      cschem->netlist = netlist->next;
      netlist = netlist->next;
      free(nullnet);
   }
   while ((netlist != NULL) && (netlist->next != NULL)) {
      if (netlist->next->netid == 0) {
	 nullnet = netlist->next;
	 netlist->next = netlist->next->next;
	 free(nullnet);
      }
      netlist = netlist->next;
   }
}  

/*----------------------------------------------------------------------*/
/* Combine two networks in an object's linked-list Netlist 		*/
/* Parameters: cschem - pointer to object containing netlist		*/
/*	       orignet - original id to be changed			*/
/*	       newnet - new id to be changed to				*/	
/*----------------------------------------------------------------------*/

void netmerge(objectptr cschem, int orignet, int newnet)
{
   NetlistPtr origlist, newlist;
   PolylistPtr plist;
   LabellistPtr llist;
   CalllistPtr calllist;
   PortlistPtr portlist;

   if (orignet == newnet) return;

   for (origlist = cschem->netlist; origlist != NULL; origlist = origlist->next)
      if (origlist->netid == orignet) break;
      
   for (newlist = cschem->netlist; newlist != NULL; newlist = newlist->next)
      if (newlist->netid == newnet) break;

   if ((origlist != NULL) && (newlist == NULL) && newnet < 0) /* Global */
      origlist->netid = newnet;

   else if ((origlist != NULL) && (newlist == NULL)) { /* Symbol */
      origlist->netid = newnet;
      return;
   }

   else if (origlist == NULL) {
      /* fprintf(stderr, "Bad net number passed to mergenets()!\n"); */
      return;
   }

   else if ((origlist != NULL) && (newlist != NULL)) {

      /* merge the polygon list */

      if (newlist->polygons == NULL)
         newlist->polygons = origlist->polygons;
      else {
         for (plist = newlist->polygons; plist->next != NULL; plist = plist->next);
         plist->next = origlist->polygons;
      }

      /* merge the label list */

      if (newlist->labels == NULL)
         newlist->labels = origlist->labels;
      else {
         for (llist = newlist->labels; llist->next != NULL; llist = llist->next);
         llist->next = origlist->labels;
      }
      origlist->polygons = NULL;
      origlist->labels = NULL;
      origlist->netid = 0;
   }

   /* Remove the original netid's netlist from the list and free any memory	*/
   /* associated with it.							*/
   /* This is also done for global networks, where the name will come from the	*/
   /* globallist entry.								*/

   freelabel(origlist->localpin);  /* free memory for local pin, if allocated	*/

   /* Reflect the net change in the object's call list, if it has one.	*/

   for (calllist = cschem->calllist; calllist != NULL; calllist = calllist->next)
      for (portlist = calllist->ports; portlist != NULL; portlist = portlist->next)
         if (portlist->netid == orignet)
	    portlist->netid = newnet;
}

/*----------------------------------------------------------------------*/
/* Wrapper to netmerge() to make sure change is made both to the symbol	*/
/* and schematic, if both exist.					*/
/*----------------------------------------------------------------------*/

void mergenets(objectptr cschem, int orignet, int newnet)
{
   if (cschem->symschem != NULL)
      netmerge(cschem->symschem, orignet, newnet);
   netmerge(cschem, orignet, newnet);
}

/*----------------------------------------------------------------------*/
/* Remove a call to an object instance from the call list of cschem	*/
/*----------------------------------------------------------------------*/

void removecall(objectptr cschem, CalllistPtr dontcallme)
{
   CalllistPtr lastcall, seeklist;
   PortlistPtr portlist, savelist;

   /* find the instance call before this one and link it to the one following */

   lastcall = NULL;
   for (seeklist = cschem->calllist; seeklist != NULL; seeklist = seeklist->next) {
      if (seeklist == dontcallme)
	 break;
      lastcall = seeklist;
   }

   if (seeklist == NULL) {
      fprintf(stderr, "Error in removecall():  Call does not exist!\n");
      return;
   }

   if (lastcall == NULL)
      cschem->calllist = dontcallme->next;
   else
      lastcall->next = dontcallme->next;

   portlist = dontcallme->ports;
   while (portlist != NULL) {
      savelist = portlist;
      portlist = portlist->next;
      free (savelist);
   }
   free(dontcallme);
}

/*----------------------------------------------------------------------*/
/* Add a pin label to the netlist					*/
/* If cschem == NULL, add the pin to the list of global pins.		*/
/*----------------------------------------------------------------------*/

void addpin(objectptr cschem, labelptr pin, int netid)
{
   NetlistPtr netlist;
   LabellistPtr pinptr;

   netlist = (cschem == NULL) ? globallist : cschem->netlist;
      
   for (; netlist != NULL; netlist = netlist->next) {
      if (netlist->netid == netid) {
         pinptr = (LabellistPtr) malloc(sizeof(Labellist));
	 pinptr->label = pin;
	 pinptr->next = netlist->labels;
	 netlist->labels = pinptr;
	 return;
      }
   }
	 
   netlist = (NetlistPtr) malloc(sizeof(Netlist));
   netlist->polygons = NULL;
   netlist->netid = netid;

   if (cschem == NULL) {
      netlist->next = globallist;
      globallist = netlist;
   }
   else {
      netlist->next = cschem->netlist;
      cschem->netlist = netlist;
   }

   netlist->labels = (LabellistPtr) malloc(sizeof(Labellist));
   netlist->labels->label = pin;
   netlist->labels->next = NULL;
   netlist->localpin = NULL;
}
		
/*----------------------------------------------------------------------*/
/* Wrapper for addpin() for global networks				*/
/*----------------------------------------------------------------------*/

void addglobal(labelptr pin, int netid)
{
   if (netid >= 0) return;
   addpin(NULL, pin, netid);
}

/*----------------------------------------------------------------------*/
/* Allocate memory for the new call list element             		*/
/* Define the values for the new call list element		   	*/
/* Insert new call into call list					*/
/* Preferable to keep the list in order of I/O port calls		*/ 
/*----------------------------------------------------------------------*/

void addcall(objectptr cschem, objectptr callobj, objinstptr callinst)
{
   CalllistPtr newcall;

   newcall = (CalllistPtr) malloc(sizeof(Calllist));
   newcall->callobj = callobj;
   newcall->callinst = callinst;
   newcall->devindex = 0;
   newcall->ports = NULL;
   newcall->next = cschem->calllist;
   cschem->calllist = newcall;
}
		
/*----------------------------------------------------------------------*/
/* Add a port to the object cschem which connects net "netid" to	*/
/* the calling object. 	This port contains the net ID in the object.	*/
/* Return True if the port was added, False if a port already existed	*/
/* for this network.							*/
/*----------------------------------------------------------------------*/

Boolean addport(objectptr cschem, int netid)
{
   PortlistPtr newport, seekport;
   int portid = 0;
   
   /* If a port already exists for this net, don't add another one! */
   for (seekport = cschem->portlist; seekport != NULL; seekport = seekport->next) {
      if (seekport->netid != netid) {
	 if (seekport->portid > portid)
            portid = seekport->portid;
      }
      else
	 return False;
   }
   portid++;

   newport = (PortlistPtr)malloc(sizeof(Portlist));
   newport->netid = netid;
   newport->portid = portid;

   if (cschem->portlist != NULL)
      newport->next = cschem->portlist;
   else
      newport->next = NULL;

   cschem->portlist = newport;
   return True;
}

/*------------------------------------------------------------------------*/
/* Add a specific port connection from object cschem into the instance	  */
/* cinst.  This equates a net number in the calling object cschem 	  */
/* (netfrom) to a net number in the object instance being called (netto). */
/*------------------------------------------------------------------------*/

void addportcall(objectptr cschem, objinstptr cinst, objectptr instobj,
	int netfrom, int netto)
{
   CalllistPtr ccall;
   PortlistPtr seekport, sp, newport;

   for (ccall = cschem->calllist; ccall != NULL; ccall = ccall->next) {
      if (ccall->callinst == cinst) {
	 for (seekport = instobj->portlist; seekport != NULL;
		seekport = seekport->next) {
	    if (seekport->netid == netto) {

	       /* First see if there is already an entry for this call */
	       for (sp = ccall->ports; sp != NULL; sp = sp->next)
		  if (sp->portid == seekport->portid)
		     if (sp->netid == netfrom) return;

	       newport = (PortlistPtr)malloc(sizeof(Portlist));
	       newport->netid = netfrom;
	       newport->portid = seekport->portid;
	       newport->next = ccall->ports;
	       ccall->ports = newport;
	       break;
	    }
	 }
	 break;
      }
   }
}

/*----------------------------------------------------------------------*/
/* Find the net ID corresponding to the indicated port ID in the 	*/
/* indicated object.							*/
/*----------------------------------------------------------------------*/

int porttonet(objectptr cschem, int portno)
{
   PortlistPtr plist;

   for (plist = cschem->portlist; plist != NULL; plist = plist->next) {
      if (plist->portid == portno)
	 return plist->netid;
   }
   return 0;
}

/*----------------------------------------------------------------------*/
/* Traverse netlist and return netid of polygon or pin on which the	*/
/*   indicated point is located.					*/
/* If point is not on any polygon or does not match any pin position,	*/
/*   return 0.								*/
/* This routine checks to see if more than one net crosses the point	*/
/*   of interest, and merges the nets if found.				*/ 
/*----------------------------------------------------------------------*/

int pointtonet (objectptr cschem, XPoint *testpoint)
{
   XPoint *tpt, *tpt2;
   NetlistPtr loclist;
   PolylistPtr ppoly;
   LabellistPtr plab;
   int netid = 0;

   for (loclist = cschem->netlist; loclist != NULL; loclist = loclist->next) {
      for (ppoly = loclist->polygons; ppoly != NULL; ppoly = ppoly->next) {
         for (tpt = ppoly->poly->points; tpt < ppoly->poly->points
		+ EndPoint(ppoly->poly->number); tpt++) {
	    tpt2 = tpt + NextPoint(ppoly->poly->number);

	    if (onsegment(tpt, tpt2, testpoint)) {
	       if ((netid != 0) && (netid != loclist->netid))
		  mergenets(cschem, netid, loclist->netid);
	       netid = loclist->netid;
	    }
	 }
      }
      for (plab = loclist->labels; plab != NULL; plab = plab->next) {
	 tpt = &(plab->label->position);
	 if (proximity(tpt, testpoint)) {
	    if ((netid != 0) && (netid != loclist->netid))
	       mergenets(cschem, netid, loclist->netid);
	    netid = loclist->netid;
	 }
      }
   }
   return netid;
}

/*----------------------------------------------------------------------*/
/* localpin keeps track of temporary pin labels when flattening the	*/
/* hierarchy without destroying the original pin names.			*/
/*----------------------------------------------------------------------*/

void makelocalpins(objectptr cschem, CalllistPtr clist, char *prefix)
{
   NetlistPtr netlist;
   PortlistPtr portlist, plist;
   stringpart *locpin;
   int locnet, callnet;
   objectptr callobj = clist->callobj;

   /* First copy all pin names which are passed from above as parameters */

   for (portlist = clist->ports; portlist != NULL; portlist = portlist->next) {
      callnet = portlist->netid;
      for (plist = callobj->portlist; plist != NULL; plist = plist->next) {
	 if (plist->portid == portlist->portid) {
	    locnet = plist->netid;
            locpin = nettopin(portlist->netid, cschem, prefix);
	    break;
	 }
      }
      for (netlist = callobj->netlist; netlist != NULL; netlist = netlist->next) {
         if (netlist->netid == locnet) {
	    if (netlist->localpin != NULL) free(netlist->localpin);
	    netlist->localpin = stringcopy(locpin);
	    break;
	 }
      }
   }
}

/*----------------------------------------------------------------------*/
/* Find a pin name for the given net number				*/
/* Either take the last pin name with the net, or generate a new pin,	*/
/* assigning it a net number for a string.				*/
/* prefix = NULL indicates spice netlist, but is also used for PCB-type	*/
/* netlists because the calling hierarchy is generated elsewhere.	*/
/*----------------------------------------------------------------------*/

stringpart *nettopin(int netid, objectptr cschem, char *prefix)
{
   NetlistPtr netlist = cschem->netlist;
   LabellistPtr netlabel;
   labelptr newlabel;
   stringpart *newpart;
   stringpart *newstring;
   char *newtext, *snew = NULL;

   if (prefix == NULL) {   	/* hierarchical (spice) netlist */
      if (netid < 0)
         netlist = globallist;

      netlabel = NULL;
      for (; netlist != NULL; netlist = netlist->next) {
         if (netlist->netid == netid) {
	    /* Preferably choose a non-temporary label, if one exists */
	    for (netlabel = netlist->labels; netlabel != NULL;
			netlabel = netlabel->next) {
	       if (netlabel->label->string->type == FONT_NAME)
	          return(netlabel->label->string);
	    }
	    /* Otherwise, choose any label for this network */
	    if (netlist->labels != NULL)
	       return (netlist->labels->label->string);
	 }
      }

      /* If there's no label associated with this network, make one	*/
      /* called "intn" where n is the net number (netid).  This is a	*/
      /* temp label (denoted by lack of a font specifier).		*/

      newlabel = (labelptr) malloc(sizeof(label));
      newlabel->type = LABEL;
      newlabel->pin = False;
      sprintf(_STR, "int%d", netid);
      newlabel->string = NULL;
      newpart = makesegment(&newlabel->string, NULL);
      newpart->type = TEXT_STRING;
      newpart->data.string = (char *)malloc(1 + strlen(_STR));
      strcpy(newpart->data.string, _STR);
      addpin(cschem, newlabel, netid);
      return (newlabel->string);
   }

   /* flattened (sim) netlists */

   if (netid < 0)
      netlist = globallist;

   for (; netlist != NULL; netlist = netlist->next) {
      if (netlist->netid == netid) {
	 if (netlist->localpin != NULL)
	    return netlist->localpin;
	 else if (netlist->labels && netlist->labels->label->pin == GLOBAL)
	    return (netlist->labels->label->string);
	 else 
	    break;
      }
   }

   /* Generate the string for the local instantiation of this pin	*/
   /* If this node does not have a pin, create one using the current	*/
   /* hierarchy prefix as the string.					*/

   if ((netlist != NULL) && (netlist->labels != NULL)) {
      /* Like above, for hierarchical nets, choose a non-temp label if 	*/
      /* one exists.							*/
      for (netlabel = netlist->labels; netlabel != NULL; netlabel = netlabel->next) {
	 if (netlabel->label->string->type == FONT_NAME) {
	    newstring = netlabel->label->string;
	    break;
	 }
      }
      /* Otherwise, choose any label for this network */
      if (netlabel == NULL)
	 newstring = netlist->labels->label->string;

      snew = textprint(newstring, NULL);
   }
   else {
      snew = (char *)malloc(12);
      sprintf(snew, "int%d", netlist->netid);
   }

   newtext = (char *)malloc(1 + strlen(snew) + strlen(prefix));
   sprintf(newtext, "%s%s", prefix, snew);
   free(snew);

   newstring = (stringpart *)malloc(sizeof(stringpart));
   newstring->nextpart = NULL;
   newstring->type = TEXT_STRING;
   newstring->data.string = newtext;
   return newstring;
}

/*----------------------------------------------------------------------*/
/* Find the net which connects to the given pin label			*/
/* Return 0 (no net) if no match was found. 				*/
/*----------------------------------------------------------------------*/

int pintonet(objectptr cschem, objinstptr cinst, labelptr testpin)
{
   NetlistPtr netlist = cschem->netlist;
   LabellistPtr seeklabel;

   /* check against local pins, if this pin is declared local */

   if (testpin->pin == LOCAL) {
      for (netlist = cschem->netlist; netlist != NULL; netlist = netlist->next)
         for (seeklabel = netlist->labels; seeklabel != NULL;
		seeklabel = seeklabel->next)
            if (!stringcomprelaxed(seeklabel->label->string, testpin->string,
			cinst))
	       return (netlist->netid);
   }

   /* check global pins, if this pin is declared global */

   else if (testpin->pin == GLOBAL) {
      for (netlist = globallist; netlist != NULL; netlist = netlist->next)
         for (seeklabel = netlist->labels; seeklabel != NULL;
		seeklabel = seeklabel->next)
            if (!stringcomprelaxed(seeklabel->label->string, testpin->string,
			cinst))
	       return (netlist->netid);
   }
   return 0;
}

/*----------------------------------------------------------------------*/
/* Generate an index number for this device.  Count all devices having	*/
/* the same device name (as printed in the netlist) in the calllist of	*/
/* the calling object (cfrom)						*/
/*----------------------------------------------------------------------*/

u_int devindex(objectptr cfrom, CalllistPtr clist, Boolean do_update)
{
   CalllistPtr cptr, listfrom = cfrom->calllist;
   objectptr devobj = clist->callobj;
   u_int index = 1;
   char *devname, *cname;

   if (listfrom == NULL) return (u_int)0;
   if (clist->devindex != 0) return clist->devindex;

   devname = (devobj->devname == NULL) ? devobj->name : devobj->devname;

   for (cptr = listfrom; cptr != NULL; cptr = cptr->next) {
      if (cptr == clist) continue;
      cname = (cptr->callobj->devname == NULL) ? cptr->callobj->name :
		cptr->callobj->devname;
      if (!strcmp(cname, devname)) {
         if (cptr->devindex >= index)
	    index = cptr->devindex + 1;
      }
   }
   if (do_update) clist->devindex = index;
   return index;
}

/*----------------------------------------------------------------------*/
/* Look for information labels in the object parts list.  Parse the	*/
/* information labels and print results to specified output device.	*/
/* (This is not very robust to errors---needs work!)			*/
/*----------------------------------------------------------------------*/

char *parseinfo(objectptr cfrom, CalllistPtr clist, char *prefix, char *mode,
	Boolean update)
{
   genericptr *pgen;
   labelptr plabel;
   stringpart *strptr, *ppin, *optr;
   char *snew, *sout = NULL;
   u_char *strt, *fnsh;
   PortlistPtr portlist;
   oparamptr ops;
   objectptr cschem = clist->callobj;
   int portid, locpos, i, j, k, valid, *vlist, vmax, slen;
   int is_parameter = -1;
   u_int newindex;
   Boolean is_flat = False, is_symbol = False, is_iso = False, is_pcbidx = False;
   char *locmode;

   if (locmode = mode) {

      /* "sim" format files are flattened by definition */

      if (!strcmp(mode, "sim")) {
         is_flat = True;
      }

      /* Flattened spice has mode "flatspice" but needs to see a string "spice" */

      else if (!strncmp(mode, "flat", 4)) {
         locmode += 4;
         is_flat = True;
      }

      /* Auto-numbering of netlists has mode prefixed with "idx" */

      else if (!strncmp(mode, "idx", 3)) {
         locmode += 3;
         is_pcbidx = True;
      }

      /* PCB info labels occur on symbols */

      if (!strcmp(locmode, "pcb") && (clist->callobj->symschem != NULL))
         cschem = clist->callinst->thisobject;
   }

   /* 1st pass: look for valid labels;  see if more than one applies.	*/
   /* If so, order them correctly.  Labels may not be numbered in	*/
   /* sequence, and may begin with zero.  We allow a lot of flexibility	*/
   /* but the general expectation is that sequences start at 0 or 1 and	*/
   /* increase by consecutive integers.					*/

   valid = 0;
   vmax = 5;
   vlist = (int *)malloc(vmax * sizeof(int));
   for (i = 0; i < vmax; i++) vlist[i] = -1;
   for (pgen = cschem->plist; pgen < cschem->plist + cschem->parts; pgen++) {
      if ((*pgen)->type == LABEL) {
	 plabel = TOLABEL(pgen);
         if ((plabel->pin == INFO) && !textncomp(plabel->string, locmode,
		clist->callinst)) {
	    strptr = findstringpart(strlen(locmode), &locpos, plabel->string,
		clist->callinst);
	    if (locpos < 0) continue;  /* null after netlist type designator */
	    strt = strptr->data.string + locpos;
	    if ((*strt != ':') && sscanf(strt, "%d", &j) == 1) {
	       if (j >= vmax) {
	          vlist = (int *)realloc(vlist, (j + 1) * sizeof(int));
	          for (i = vmax; i <= j; i++) vlist[i] = -1;
		  vmax = j + 1;
	       }
	       if (j >= 0) {
	          vlist[j] = (int)(pgen - cschem->plist);
	          if (valid <= j) valid = j + 1;
	       }
	       else {
		  Wprintf("Info label has negative sequence number!");
	       }
	    }
	    else {
	       valid++;
	       if (valid >= vmax) {
	          vlist = (int *)realloc(vlist, (vmax + 5) * sizeof(int));
	          for (i = vmax; i < vmax + 5; i++) vlist[i] = -1;
	          vmax += 5;
	       }
	       vlist[valid - 1] = (int)(pgen - cschem->plist);
	    }
         }
      }
   }

   /* Now parse each label in sequence and output the result to */
   /* the return string.					*/ 

   sout = (char *)malloc(1);
   *sout = '\0';

   for (j = 0; j < valid; j++) {
      if (vlist[j] < 0) continue;
      plabel = TOLABEL(cschem->plist + vlist[j]);

      /* move to colon character */
      for (i = 1; i < stringlength(plabel->string, True, clist->callinst); i++) {
	 strptr = findstringpart(i, &locpos, plabel->string, clist->callinst);
	 if (locpos >= 0 && *(strptr->data.string + locpos) == ':') break;
      }

      /* interpret all characters after the colon */
      for (++i; i < stringlength(plabel->string, True, clist->callinst); i++) {
	 strptr = findstringpart(i, &locpos, plabel->string, clist->callinst);
	 if (locpos >= 0) {

	    /* Do for all text characters */
	    strt = strptr->data.string + locpos;
	    if (*strt == '%') {
	       strt++;
	       i++;
	       switch(*strt) {
		  case '%':
		     sout = (char *)realloc(sout, strlen(sout) + 2);
		     strcat(sout, "%");
		     break;
		  case 'r':
		     sout = (char *)realloc(sout, strlen(sout) + 2);
		     strcat(sout, "\n");
		     break;
		  case 't':
		     sout = (char *)realloc(sout, strlen(sout) + 2);
		     strcat(sout, "\t");
		     break;
		  case 'i':
		     if (cschem->devname == NULL)
			cschem->devname = strdup(sout);
		     if (is_flat)
		        newindex = flatindex++;
		     else
		        newindex = devindex(cfrom, clist, update);
		     sout = (char *)realloc(sout, strlen(sout) + 10);
		     sprintf(sout + strlen(sout), "%u", newindex);
		     break;
		  case 'n':
		     sout = (char *)realloc(sout, strlen(sout)
				+ strlen(cschem->name) + 1);
		     strcat(sout, cschem->name);
		     break;
		  case 'p':
		     /* Pin name either has no spaces or is in quotes */
		     strt++;
		     if (*strt == '"') {
			strt++;
			i++;
		     }
		     if (*strt == '"' || *strt == '\0') break;
		     fnsh = strt + 1;
		     while (*fnsh != '\0' && !isspace(*fnsh) && 
					*fnsh != '"') fnsh++; 
		     strncpy(_STR, strt, (int)(fnsh - strt));
		     _STR[(int)(fnsh - strt)] = '\0';
		     i += (fnsh - strt);
		     if (!(isspace(*fnsh) || *fnsh == '\0')) i++;

		     /* Find the port which corresponds to this pin name */
		     /* in the called object (cschem).		    */

		     for (portlist = cschem->portlist; portlist != NULL;
				portlist = portlist->next) {
			ppin = nettopin(portlist->netid, cschem, NULL);
			if (!textcomp(ppin, _STR, NULL)) {
			   portid = portlist->portid;
			   break;
			}
		     }
		     if (portlist != NULL) {

		        /* Find the matching port in the calling object instance */

			for (portlist = clist->ports; portlist != NULL;
				portlist = portlist->next)
			   if (portlist->portid == portid) break;

		        if (portlist != NULL) {

			   ppin = nettopin(portlist->netid, cfrom, prefix);
			   snew = textprint(ppin, clist->callinst);
			   sout = (char *)realloc(sout, strlen(sout) +
					strlen(snew) + 1);
	            	   strcat(sout, snew);
			   free(snew);
			   break;
			}
			else {
			   fprintf(stderr, "Error: called non-existant port\n");
			}
		     }
		     else {
			sprintf(_STR2, "No pin named %s in device %s",
				  _STR, cschem->name);
			Wprintf(_STR2);
		     }
		     break;
		  case 'v':
		     /* Parameter name either has no spaces or is in quotes */
		     strt++;
		     if (*strt == '"')  {
			strt++;
			i++;
		     }
		     if (*strt == '"' || *strt == '\0') break;
		     fnsh = strt + 1;
		     while (*fnsh != '\0' && !isspace(*fnsh) && 
				*fnsh != '"') fnsh++; 
		     strncpy(_STR, strt, (int)(fnsh - strt));
		     _STR[(int)(fnsh - strt)] = '\0';
		     i += (fnsh - strt);
		     if (!(isspace(*fnsh) || *fnsh == '\0')) i++;

		     /* Compare this name against the parameter defaults */
		     for (k = 0; k < cschem->num_params; k++) {
		        ops = *(cschem->params + k);
		        if (ops->type == XC_STRING) {
			   if (!textcomp(ops->parameter.string, _STR, NULL)) {
			      /* substitute the parameter or default */
			      if ((clist->callinst->thisobject->num_params > k) &&
				  (clist->callinst->params != NULL) &&
				      *(clist->callinst->params + k) != NULL)
				 optr = (*(clist->callinst->params
						+ k))->parameter.string;
			      else
				 optr = ops->parameter.string;
			      if (stringlength(optr, True, clist->callinst) > 0) {
				 snew = textprint(optr, clist->callinst);
			         sout = (char *)realloc(sout, strlen(sout)
						+ strlen(snew) + 1);
			         strcat(sout, snew);
				 free(snew);
			      }
			      break;
			   }
			}
		     }
		     if (k == cschem->num_params) {
		        sprintf(_STR, "No parameter named %s in device %s",
				  _STR, cschem->name);
		        Wprintf(_STR);
		     }
		     break;
		  default:
		     sout = (char *)realloc(sout, strlen(sout) + 2);
		     *(sout + strlen(sout) - 1) = *strt;
		     *(sout + strlen(sout)) = '\0';
	       }
	    }
	    else {

	       /* Parameters with unresolved question marks are treated */
	       /* like a "%i" string.					*/

	       if ((is_parameter >= 0) && !textncomp(strptr, "?", clist->callinst)) {
		  if (cschem->devname == NULL)
			cschem->devname = strdup(sout);
		  sout = (char *)realloc(sout, strlen(sout) + 10);
		  newindex = devindex(cfrom, clist, update);
		  k = strlen(sout);
		  sprintf(sout + k, "%u", newindex);

		  /* When called with mode = "pcbidx", generate a parameter	*/
		  /* instance, replacing the question mark with the new index	*/
		  /* number.							*/

		  if (is_pcbidx) {
		     copyparams(clist->callinst, clist->callinst);
		     optr = clist->callinst->params[is_parameter]->parameter.string;
		     if (!textncomp(optr, "?", clist->callinst)) {
		        optr->data.string = (char *)realloc(optr->data.string,
				strlen(sout + k) + 1);
		        strcpy(optr->data.string, sout + k);
			clist->devindex = newindex;
		     }
		     else Wprintf("Error while auto-numbering parameters");
		     resolveparams(clist->callinst);
		  }
	       }
	       else {
		  /* A "?" default parameter that has a (different)	*/
		  /* instance value becomes the device number.		*/
		  if ((is_parameter >= 0) && (clist->devindex == 0)) {
		     oparamptr ops = *(cschem->params + is_parameter);
		     if (ops->type == XC_STRING) {
			CalllistPtr plist;
			if (!textcomp(ops->parameter.string, "?", NULL)) {
			   newindex = (u_int) strtol(strt, NULL, 10);
			   clist->devindex = newindex;
			   for (plist = cfrom->calllist; plist; plist = plist->next) {
			      if ((plist == clist) ||
					(plist->callobj != clist->callobj)) continue;

			      /* Two parts have been named the same.  Flag it, but */
			      /* don't try to do anything about it.		   */
			      if (plist->devindex == newindex) {
				 fprintf(stderr, "Error: duplicate part number"
					" %s%s and %s%s\n", sout, strt, sout, strt);
				 break;
			      }
			   }
			}
		     }
	          }
	          slen = strlen(sout);
	          sout = (char *)realloc(sout, slen + 2);

		  /* By convention, greek "mu" becomes ASCII "u", NOT "m",	*/
		  /* otherwise we get, e.g., millifarads instead of microfarads */

		  if ((is_symbol && (*strt == 'm')) || (is_iso && (*strt == 0265)))
		     *(sout + slen) = 'u';
		  else
	             *(sout + slen) = *strt;
	          *(sout + slen + 1) = '\0';
	       }
	    }
	 }

	 /* Some label controls are interpreted.  Most are ignored */
	 else {
	    switch(strptr->type) {
	       case PARAM_START:
		  is_parameter = strptr->data.paramno;
		  break;
	       case PARAM_END:
		  is_parameter = -1;
		  break;
	       case RETURN:
		  sout = (char *)realloc(sout, strlen(sout) + 2);
		  strcat(sout, "\n");
		  break;
	       case TABFORWARD:
		  sout = (char *)realloc(sout, strlen(sout) + 2);
		  strcat(sout, "\t");
		  break;
	       case FONT_NAME:
		  is_symbol = issymbolfont(strptr->data.font);
		  is_iso = isisolatin1(strptr->data.font);
		  break;
	    }
	 }
      }
   }
   free(vlist);
   if (*sout == '\0') {
      free(sout);
      return NULL;
   }
   return sout;
}

/*----------------------------------------------------------------------*/
/* Write a low-level device						*/
/*----------------------------------------------------------------------*/

int writedevice(FILE *fp, char *mode, objectptr cfrom, CalllistPtr clist,
	char *prefix)
{
   char *sout;

   if (clist == NULL) {
      if (fp != NULL) fprintf(fp, "error: null device\n");
      return -1;
   }

   /* Look for information labels in the object parts list. */

   if ((sout = parseinfo(cfrom, clist, prefix, mode, True)) != NULL) {
      if (fp != NULL) {
	 fputs(sout, fp);
	 free(sout);
	 fprintf(fp, "\n");
      }
      return 0;
   }

   /* Information labels do not necessarily exist. */
   return -1;
}

/*-------------------------------------------------------------------------*/
/* Save netlist into a flattened sim or spice file			   */
/*-------------------------------------------------------------------------*/

void writeflat(objectptr cschem, CalllistPtr cfrom, char *prefix, FILE *fp, char *mode)
{
   CalllistPtr calllist = cschem->calllist;
   char *newprefix = (char *)malloc(sizeof(char));

   /* write all the subcircuits */

   for (calllist = cschem->calllist; calllist != NULL; calllist = calllist->next) {

      makelocalpins(cschem, calllist, prefix);

      if (writedevice(fp, mode, cschem, calllist, prefix) < 0) {
	 sprintf(_STR, "%s%u", calllist->callobj->name,
			devindex(cschem, calllist, True));
	 newprefix = (char *)realloc(newprefix, sizeof(char) * (strlen(prefix)
		   + strlen(_STR) + 2));
	 sprintf(newprefix, "%s%s/", prefix, _STR);
         writeflat(calllist->callobj, calllist, newprefix, fp, mode);
      }
   }
   clearpins(cschem);
   free(newprefix);
}

/*-------------------------------------------------------------------------*/
/* Write out the list of global nets and their pin names		   */
/*-------------------------------------------------------------------------*/

void writeglobals(objectptr cschem, FILE *fp)
{
   NetlistPtr gptr;
   labelptr gpin;
   char *snew;

   if (fp == NULL) return;

   for (gptr = globallist; gptr != NULL; gptr = gptr->next) {
      gpin = gptr->labels->label;	/* Only print first label in list */
      snew = textprint(gpin->string, NULL);
      fprintf(fp, ".GLOBAL %s\n", snew);		/* hspice format */
      /* fprintf(fp, "%s = %d\n", snew, -gptr->netid); */ /* generic format */
      free(snew);
   }
   fprintf(fp, "\n");
}

/*-------------------------------------------------------------------------*/
/* Save netlist into a hierarchical file				   */
/*-------------------------------------------------------------------------*/

void writehierarchy(objectptr cschem, CalllistPtr cfrom, FILE *fp)
{
   CalllistPtr calllist = cschem->calllist;
   PortlistPtr portlist, plist;
   int netid, pnet, portid, length, plen;
   char *stsave, *pstring;

   /* Subcircuits which make no calls or have no devices do not get written */

   if (calllist == NULL) return;

   /* Make sure that all the subcircuits have been written first */

   for (; calllist != NULL; calllist = calllist->next) {
      if (calllist->callobj->traversed == False) {
         calllist->callobj->traversed = True;
         writehierarchy(calllist->callobj, calllist, fp);
      }
   }

   /* write own subcircuit netlist */

   portlist = (cschem == NULL) ? NULL : cschem->portlist;

   if (cschem->schemtype == FUNDAMENTAL)
      return;

   else if ((portlist != NULL) && (fp != NULL)) {
      fprintf(fp, ".subckt %s", cschem->name);
      length = 9 + strlen(cschem->name);

      /* List of parameters in subcircuit. 			  */
      /* Each parameter connects to a net which may have multiple */
      /* names, so find the net associated with the parameter     */
      /* and convert it back into a pin name in the usual manner  */
      /* using nettopin().					  */

      for (; portlist != NULL; portlist = portlist->next) {
         netid = portlist->netid;
	 pstring = textprint(nettopin(netid, cschem, NULL), NULL);
	 plen = strlen(pstring) + 1;
	 if (length + plen > 78) {
            fprintf(fp, " \\\n");	/* Line break */
	    length = 0;
	 }
	 else length += plen;
         fprintf(fp, " %s", pstring);
	 free(pstring);
      }
      fprintf(fp, "\n");
   }

   /* Run through calllist once to resolve all fixed part assignments (devindex) */

   for (calllist = cschem->calllist; calllist != NULL; calllist = calllist->next) {
      if ((stsave = parseinfo(cschem, calllist, NULL, "spice", False)) != NULL)
	 free(stsave);
   }

   /* If the output file is NULL, then we're done */

   if (fp == NULL) return;

   for (calllist = cschem->calllist; calllist != NULL; calllist = calllist->next) {

      /* The call is to a fundamental device. . . */

      if (writedevice(fp, "spice", cschem, calllist, NULL) < 0) {

         /* . . . or else is a call to a subcircuit.  However, don't write  */
	 /* calls to non-functional subcircuits.			    */

	 if (calllist->callobj->calllist == NULL) continue;

         fprintf(fp, "X%d", subindex++);
	 stsave = calllist->callobj->name;
         length = 6;

	 /* The object's definition lists calls in the order of the object's	*/
	 /* port list.  Therefore, use this order to find the port list.  	*/
	 /* This will also deal with the fact that not every port has to be	*/
	 /* called by the instance (ports may be left disconnected).		*/

	 for (portlist = calllist->callobj->portlist; portlist != NULL;
			portlist = portlist->next) {
	    portid = portlist->portid;
	    for (plist = calllist->ports; plist != NULL; plist = plist->next)
	       if (plist->portid == portlist->portid)
		  break;

	    pnet = (plist == NULL) ?  netmax(cschem) + 1 : plist->netid;
	    pstring = textprint(nettopin(pnet, cschem, NULL), NULL);
	    plen = strlen(pstring) + 1;
	    if (length + plen > 78) {
               fprintf(fp, " \\\n");	/* Line break */
	       length = 0;
	    }
	    else length += plen;
	    fprintf(fp, " %s", pstring);
	    free(pstring);
         }
	 plen = 1 + strlen(stsave);
	 if (length + plen > 78) fprintf(fp, " \\\n");	/* Line break */
         fprintf(fp, " %s\n", stsave);
      }
   }
   if (cfrom == NULL)
      fprintf(fp, ".end\n");
   else
      fprintf(fp, ".ends\n\n");
}

/*----------------------------------------------------------------------*/
/* Create generic netlist in the Python interpreter variable space	*/
/*----------------------------------------------------------------------*/

#ifdef HAVE_PYTHON

static PyObject *pyparseinfo(objectptr cschem)
{
   genericptr *pgen;
   labelptr plabel;

   PyObject *rlist = PyList_New(0);

   for (pgen = cschem->plist; pgen < cschem->plist + cschem->parts; pgen++) {
      if ((*pgen)->type == LABEL) {
	 plabel = TOLABEL(pgen);
         if (plabel->pin == INFO)
	    PyList_Append(rlist, PyGetStringParts(plabel->string));
      }
   }
   return rlist;
}

/*----------------------------------------------------------------------*/
/* Write global variables to Python list "globalnets"			*/
/*----------------------------------------------------------------------*/

PyObject *pyglobals(objectptr cschem)
{
   NetlistPtr gptr;
   labelptr gpin;
   char *snew;
   PyObject *glist;
   int llen = 0;

   for (gptr = globallist; gptr != NULL; gptr = gptr->next, llen++);
   glist = PyList_New(llen);

   llen = 0;
   for (gptr = globallist; gptr != NULL; gptr = gptr->next, llen++) {
      gpin = gptr->labels->label;	/* Only print first label in list */
      PyList_SetItem(glist, llen, PyGetStringParts(gpin->string));
   }
   return glist;
}

/*----------------------------------------------------------------------*/
/* Write a generic hierarchical netlist into Python list "subcircuits"	*/
/*----------------------------------------------------------------------*/

void pyhierarchy(objectptr cschem, CalllistPtr cfrom, PyObject *cktlist)
{
   CalllistPtr calllist = cschem->calllist;
   PortlistPtr portlist, plist;
   int netid, pnet, portid, length, plen, i;
   PyObject *pyports, *pycalls, *pynewcall;
   PyObject *pydevs, *pyparams, *subckt, *newdev;
   oparamptr paramlist;

   /* Subcircuits which make no calls or have no devices do not get written */

   if (calllist == NULL) return;

   /* Make sure that all the subcircuits have been written first */

   for (; calllist != NULL; calllist = calllist->next) {
      if (calllist->callobj->traversed == False) {
         calllist->callobj->traversed = True;
	 pyhierarchy(calllist->callobj, calllist, cktlist);
      }
   }

   /* Write own subcircuit netlist */
   subckt = PyDict_New();

   /* Write the name */
   PyDict_SetItem(subckt, PyString_FromString("name"),
		PyString_FromString(cschem->name));

   /* Write the list of ports */
   if ((portlist = cschem->portlist) != NULL) {

      /* List of ports in subcircuit. 			  	  */
      /* Each parameter connects to a net which may have multiple */
      /* names, so find the net associated with the parameter     */
      /* and convert it back into a pin name in the usual manner  */
      /* using nettopin().					  */

      pyports = PyList_New(0);
      for (; portlist != NULL; portlist = portlist->next) {
         netid = portlist->netid;
	 PyList_Append(pyports, PyGetStringParts(nettopin(netid, cschem, NULL)));
      }
      PyDict_SetItem(subckt, PyString_FromString("ports"), pyports);
   }

   /* Write the list of parameters */

   if (cschem->params != NULL) {
      pyparams = PyList_New(0);

      for (i = 0; i < cschem->num_params; i++) {
	 paramlist = *(cschem->params + i);
	 if (paramlist->type == XC_INT)
	    PyList_Append(pyparams,
			PyInt_FromLong((long)paramlist->parameter.ivalue));
	 if (paramlist->type == XC_FLOAT)
	    PyList_Append(pyparams,
			PyFloat_FromDouble((double)paramlist->parameter.fvalue));
	 else if (paramlist->type == XC_STRING)
	    PyList_Append(pyparams,
			PyGetStringParts(paramlist->parameter.string));
      }
      PyDict_SetItem(subckt, PyString_FromString("parameters"), pyparams);
   }

   /* Write the list of calls to subcircuits */

   if ((calllist = cschem->calllist) != NULL) {
      pycalls = PyList_New(0);
      for (; calllist != NULL; calllist = calllist->next) {

         /* Don't write calls to non-functional subcircuits. */
	 if (calllist->callobj->calllist == NULL) continue;

         pynewcall = PyDict_New();
         PyDict_SetItem(pynewcall, PyString_FromString("name"),
		PyString_FromString(calllist->callobj->name));

         /* Log any local parameter instances */
         if (calllist->callinst->params != NULL) {
	    pyparams = PyList_New(0);

	    for (i = 0; i < calllist->callobj->num_params; i++) {
	       paramlist = *(calllist->callinst->params + i);
	       if (paramlist->type == XC_INT)
	          PyList_Append(pyparams,
			PyInt_FromLong((long)paramlist->parameter.ivalue));
	       else if (paramlist->type == XC_FLOAT)
	          PyList_Append(pyparams,
			PyFloat_FromDouble((double)paramlist->parameter.fvalue));
	       else if (paramlist->type == XC_STRING)
	          PyList_Append(pyparams,
			PyGetStringParts(paramlist->parameter.string));
	    }
	    PyDict_SetItem(pynewcall, PyString_FromString("parameters"),
			pyparams);
         }

         /* The object's definition lists calls in the order of the object's	*/
         /* port list.  Therefore, use this order to find the port list.  	*/
	 /* Unconnected ports will be NULL entries in the list (?).		*/

         if (calllist->callobj->portlist != NULL) {
            pyports = PyList_New(0);
	    for (portlist = calllist->callobj->portlist; portlist != NULL;
			portlist = portlist->next) {
	       portid = portlist->portid;
	       for (plist = calllist->ports; plist != NULL; plist = plist->next)
	          if (plist->portid == portlist->portid)
		     break;

	       pnet = (plist == NULL) ?  netmax(cschem) + 1 : plist->netid;

	       PyList_Append(pyports, 
			PyGetStringParts(nettopin(pnet, cschem, NULL)));
            }
	    PyDict_SetItem(pynewcall, PyString_FromString("ports"), pyports);
         }
         PyList_Append(pycalls, pynewcall);
      }
      PyDict_SetItem(subckt, PyString_FromString("calls"), pycalls);
   }

   /* If the object has info labels, write a device list.	*/
   /* Check both the schematic and its symbol for info labels.	*/

   pydevs = PyList_New(0);
   if (cschem->symschem != NULL) {
      newdev = pyparseinfo(cschem->symschem);
      PyList_Append(pydevs, newdev);
   }
   newdev = pyparseinfo(cschem);
   PyList_Append(pydevs, newdev);
   PyDict_SetItem(subckt, PyString_FromString("devices"), pydevs);

   PyList_Append(cktlist, subckt);
}

/*----------------------------------------------------------------------*/

PyObject *pytoplevel(objectptr cschem)
{
   PyObject *cktlist;

   cktlist = PyList_New(0);
   cleartraversed(cschem, 0);
   pyhierarchy(cschem, NULL, cktlist);
   return cktlist;
}

#endif	/* HAVE_PYTHON */

/*----------------------------------------------------------------------*/
/* Write a netlist depending on the mode chosen				*/
/*----------------------------------------------------------------------*/

void writenet(objectptr cschem, char *mode, char *suffix)
{
   char filename[100];
   char *prefix, *cpos, *locmode = mode;
   FILE *fp;

   prefix = (char *)malloc(sizeof(char));
   *prefix = '\0';
   subindex = 1;
   flatindex = 1;
 
   if ((cpos = strchr(cschem->name, ':')) != NULL) *cpos = '\0';
   sprintf(filename, "%s.%s", cschem->name, suffix);
   if (cpos != NULL) *cpos = ':';

   if (!strncmp(mode, "idx", 3)) {	/* This mode generates no output */
      locmode += 3;
      fp = (FILE *)NULL;
   }
   else if ((fp = fopen(filename, "w")) == NULL) {
      sprintf(_STR, "Could not open file %s for writing.", filename);
      Wprintf(_STR);
      free(prefix);
      return;
   }

   /* Handle different netlist modes */

   if (!strcmp(mode, "spice")) {
      fprintf(fp, "*SPICE circuit \"%s\" from XCircuit v%3.2f\n\n",
		cschem->name, version);
      writeglobals(cschem, fp);
      cleartraversed(cschem, 0);
      writehierarchy(cschem, NULL, fp);
   }
   else if (!strcmp(mode, "flatspice")) {
      fprintf(fp, "*SPICE (flattened) circuit \"%s\" from XCircuit v%3.2f\n\n",
		cschem->name, version);
      writeflat(cschem, NULL, prefix, fp, mode);
   }
   else if (!strcmp(mode, "sim")) {
      fprintf(fp, "| sim circuit \"%s\" from XCircuit v%3.2f\n",
		cschem->name, version);
      writeflat(cschem, NULL, prefix, fp, mode);
   }
   else if (!strcmp(locmode, "pcb")) {
      ptable = (struct Ptab *)NULL;
      writepcb(cschem, NULL, "", mode);
      outputpcb(cschem, fp);
      freepcb();
   }

   /* Finish up */

   if (fp != NULL) {
      fclose(fp);
      sprintf(_STR, "%s netlist saved as %s", mode, filename);
      Wprintf(_STR);
   }
   free(prefix);
}

/*----------------------------------------------------------------------*/
/* Flatten netlist and save into a table of pcb-style nets		*/
/*----------------------------------------------------------------------*/

void writepcb(objectptr cschem, CalllistPtr cfrom, char *prefix, char *mode)
{
   NetlistPtr netlist = cschem->netlist;
   CalllistPtr calllist;
   PortlistPtr portlist;
   int i, testnet, tmplen;
   char *newprefix = (char *)malloc(sizeof(char));
   char *sout, *snew;
   struct Ptab *hidx, *htmp;
   struct Pstr *tmpstr;
   struct Pnet *tmpnet;
   objinstptr cinst;
   int locnet;

   /* Step 1:  Go through the netlist of this object and add any new nets to	*/
   /* 		the table.							*/

   while (netlist != NULL) {
      testnet = netlist->netid;
      hidx = ptable;
      while (hidx != NULL) {
         if (hidx->nets != NULL) {
	    for (i = 0; i < hidx->nets->numnets; i++)
	       if (*(hidx->nets->netidx + i) == testnet) break;
	    if (i < hidx->nets->numnets) break;
	 }
	 hidx = hidx->next;
      }
      if (hidx == NULL) {	/* make new entry for net in table */
	 htmp = (struct Ptab *)malloc(sizeof(struct Ptab));
	 tmpnet = (struct Pnet *)malloc(sizeof(struct Pnet));
	 tmpnet->numnets = 1;
	 tmpnet->netidx = (int *)malloc(sizeof(int));
	 *(tmpnet->netidx) = testnet;
	 tmpnet->next = NULL;
	 htmp->nets = tmpnet;
	 htmp->pins = NULL;
	 htmp->next = ptable;
	 ptable = htmp;
	 /* printf("Added new index entry for net %d\n", testnet); */
      }
      netlist = netlist->next;
   }

   /* Step 1b: 1st pass through the calllist:  Generate part numbers */

   for (calllist = cschem->calllist; calllist != NULL; calllist = calllist->next) {
      if ((sout = parseinfo(cschem, calllist, prefix, mode, False)) != NULL)
	 free(sout);
   }

   /* Step 2:  Go through the list of calls to search for endpoints */

   for (calllist = cschem->calllist; calllist != NULL; calllist = calllist->next) {
      cinst = calllist->callinst;

      /* Step 3:  If call is to a bottom-most schematic, output the device connections */
      /* Info-label can provide an alternate name or specify the instance number */

      if ((sout = parseinfo(cschem, calllist, prefix, mode, True)) == NULL) {
	 if (cschem->devname == NULL)
	    cschem->devname = strdup(calllist->callinst->thisobject->name);
         sprintf(_STR, "%s%u", cschem->devname, devindex(cschem, calllist, True));
      }
      else {
	 strcpy(_STR, sout);
	 free(sout);
      }
      newprefix = (char *)realloc(newprefix, sizeof(char) * (strlen(prefix)
		+ strlen(_STR) + 2));
      sprintf(newprefix, "%s%s/", prefix, _STR);

      if (calllist->callobj->calllist == NULL) {
	 stringpart *ppin;

         /* printf("Reached lowest-level schematic:  Finding connections\n"); */
	 for (portlist = calllist->ports; portlist != NULL; portlist = portlist->next) {
	    locnet = translatedown(portlist->netid, portlist->portid, calllist);

	    /* Get the name of the pin in the called object with no prefix. */
	    ppin = nettopin(locnet, calllist->callobj, NULL);
	    hidx = ptable;
	    while (hidx != NULL) {
	       if (hidx->nets != NULL) {
		  for (i = 0; i < hidx->nets->numnets; i++)
	             if (*(hidx->nets->netidx + i) == portlist->netid)
		        break;
		  if (i < hidx->nets->numnets) break;
	       }
	       hidx = hidx->next;
	    }
	    if (hidx == NULL) {
	       snew = textprint(ppin, cinst);
	       printf("Warning:  Unconnected pin %s%s\n", newprefix, snew);
	       free(snew);
	    }
	    else {
	       tmpstr = (struct Pstr *)malloc(sizeof(struct Pstr));
	       tmpstr->string = (stringpart *)malloc(sizeof(stringpart));
	       tmpstr->string->type = TEXT_STRING;
	       tmpstr->string->nextpart = NULL;
	       snew = textprint(ppin, cinst);
	       tmpstr->string->data.string = (char *)malloc(strlen(newprefix)
			+ strlen(snew) + 2);
	       strcpy(tmpstr->string->data.string, newprefix);
	       /* Replace slash '/' with dash '-' at bottommost level */
	       if ((tmplen = strlen(newprefix)) > 0)
	          tmpstr->string->data.string[tmplen - 1] = '-';
	       strcat(tmpstr->string->data.string, snew);
	       free(snew);
	       tmpstr->next = hidx->pins;
	       hidx->pins = tmpstr;

	       /* diagnositic information */
	       {
		  struct Pnet *locnet = hidx->nets;
		  int ctr = 0;
		  while (locnet->next != NULL) {
		     locnet = locnet->next;
		     ctr++;
		  }
	          /* printf("Logged level-%d net %d (local net %d) pin %s\n",
			ctr, *(locnet->netidx), *(hidx->nets->netidx + i),
			tmpstr->string);			*/
	       }
            }
         }
      }
      else {

         /* Step 3a: Push current net translations */
	 /* (Don't push or pop global net numbers:  no translation needed!) */

         hidx = ptable;
         while (hidx != NULL) {
            if ((hidx->nets != NULL) && (((hidx->nets->numnets > 0) &&
			(*(hidx->nets->netidx) >= 0)) || (hidx->nets->numnets == 0))) {
               tmpnet = (struct Pnet *)malloc(sizeof(struct Pnet));
	       tmpnet->numnets = 0;
               tmpnet->netidx = NULL;
               tmpnet->next = hidx->nets;
               hidx->nets = tmpnet;
            }
            hidx = hidx->next;
         }

	 /* Step 3b: Generate net translation table for each subcircuit */

         for (portlist = calllist->ports; portlist != NULL; portlist = portlist->next) {
	    for (hidx = ptable; hidx != NULL; hidx = hidx->next) {
               if (hidx->nets != NULL) {
	          if (hidx->nets->next != NULL) {
		     for (i = 0; i < hidx->nets->next->numnets; i++)
		        if (*(hidx->nets->next->netidx + i) == portlist->netid)
			   break;
		     if (i < hidx->nets->next->numnets) break;
		  }
		  else if (portlist->netid < 0) {
		     if (hidx->nets->netidx != NULL)
			if (*(hidx->nets->netidx) == portlist->netid)
			   break;
		  }
	       }
            }
	    if (hidx != NULL) {
	       hidx->nets->numnets++;
	       if (hidx->nets->numnets == 1)
		  hidx->nets->netidx = (int *)malloc(sizeof(int));
	       else
		  hidx->nets->netidx = (int *)realloc(hidx->nets->netidx,
			hidx->nets->numnets * sizeof(int));

	       /* Translate net value */
	       locnet = translatedown(portlist->netid, portlist->portid, calllist);
	       *(hidx->nets->netidx + hidx->nets->numnets - 1) = locnet;

	       /* printf("Translation: net %d in object %s is net %d in object %s\n",
	          portlist->netid, cschem->name, locnet, calllist->callobj->name); */
	    }
         }

         /* Step 3c: Run routine recursively on the subcircuit */

	 /* printf("Recursive call of writepcb() to %s\n", calllist->callobj->name); */
         writepcb(calllist->callobj, calllist, newprefix, mode);

         /* Step 3d: Pop the translation table */
	 /* (Don't pop global nets (designated by negative net number)) */

         hidx = ptable;
         while (hidx != NULL) {
            if ((hidx->nets != NULL) && (((hidx->nets->numnets > 0) &&
			(*(hidx->nets->netidx) >= 0)) || (hidx->nets->numnets == 0))) {
	       tmpnet = hidx->nets->next;
	       if (hidx->nets->numnets > 0) free(hidx->nets->netidx);
	       free(hidx->nets);
	       hidx->nets = tmpnet;
            }
            hidx = hidx->next;
         }
      }
   }

   /* Step 4: Cleanup */

   clearpins(cschem);
   free(newprefix);
}

/*----------------------------------------------------------------------*/
/* Save PCB table into pcb-style file				   	*/
/*----------------------------------------------------------------------*/

void outputpcb(objectptr cschem, FILE *fp)
{
   int netidx = 1, ccol;
   struct Ptab *pseek;
   struct Pstr *sseek;
   char *snew;

   if (fp == NULL) return;

   for (pseek = ptable; pseek != NULL; pseek = pseek->next) {
      if (pseek->pins != NULL) {
	 if ((pseek->nets != NULL) && (pseek->nets->numnets > 0)) {
	     snew = textprint(nettopin(*(pseek->nets->netidx), cschem, ""), NULL);
	     strcpy(_STR, snew);
	     free(snew);
	 }
	 else
             sprintf(_STR, "NET%d ", netidx++);
         fprintf(fp, "%-11s ", _STR);
         ccol = 12;
         for (sseek = pseek->pins; sseek != NULL; sseek = sseek->next) {
	    ccol += stringlength(sseek->string, False, NULL) + 3;
	    if (ccol > 78) {
	       fprintf(fp, "\\\n              ");
      	       ccol = 18 + stringlength(sseek->string, False, NULL);
	    }
	    snew = textprint(sseek->string, NULL);
	    fprintf(fp, "%s   ", snew);
	    free(snew);
         }
         fprintf(fp, "\n");
      }
      /* else fprintf(fp, "NET%d	*UNCONNECTED*\n", netidx++);	*/
   }
}

/*----------------------------------------------*/
/* free memory allocated to PCB net tables	*/
/*----------------------------------------------*/

void freepcb()
{
   struct Ptab *pseek, *pseek2;
   struct Pstr *sseek, *sseek2;
   struct Pnet *nseek, *nseek2;

   pseek = ptable;
   pseek2 = pseek;

   while (pseek2 != NULL) {
      pseek = pseek->next;

      sseek = pseek2->pins;
      sseek2 = sseek;
      while (sseek2 != NULL) {
	 sseek = sseek->next;
	 freelabel(sseek2->string);
	 free(sseek2);
	 sseek2 = sseek;
      }

      nseek = pseek2->nets;
      nseek2 = nseek;
      while (nseek2 != NULL) {
	 nseek = nseek->next;
	 if (nseek2->numnets > 0) free(nseek2->netidx);
	 free(nseek2);
	 nseek2 = nseek;
      }

      free(pseek2);
      pseek2 = pseek;
   }
}

/*-------------------------------------------------------------------------*/
/* Free memory allocated for netlist 					   */
/*-------------------------------------------------------------------------*/

void freenetlist(objectptr cschem)
{
   NetlistPtr netlist, nptr;
   PolylistPtr polylist, plist;
   LabellistPtr labellist, llist;

   netlist = (cschem == NULL) ? globallist : cschem->netlist;

   for (; netlist != NULL;) {
      nptr = netlist->next;
      for (polylist = netlist->polygons; polylist != NULL;) {
	 plist = polylist->next;
	 free(polylist);
	 polylist = plist;
      }
      for (labellist = netlist->labels; labellist != NULL;) {
	 llist = labellist->next;
	 free(labellist);
	 labellist = llist;
      }
      freelabel(netlist->localpin);
      free (netlist);
      netlist = nptr;
   }

   if (cschem == NULL)
      globallist = NULL;
   else
      cschem->netlist = NULL;
}

/*----------------------------------------------------------------------*/
/* Clear the "traversed" flag in all objects of the hierarchy.		*/
/*----------------------------------------------------------------------*/

int cleartraversed(objectptr cschem, int level)
{
   genericptr *cgen;
   objinstptr cinst;
   objectptr callobj;
	
   /* Recursively call cleartraversed() on all subobjects, a la gennetlist()  */
   /* Use the parts list of the object, not the calllist, because calls */
   /* may have been removed.						*/

   if (level == HIERARCHY_LIMIT) return -1;

   for (cgen = cschem->plist; cgen < cschem->plist + cschem->parts; cgen++) {
      if ((*cgen)->type == OBJECT) {
 	 cinst = TOOBJINST(cgen);

	 if (cinst->thisobject->symschem != NULL)
	    callobj = cinst->thisobject->symschem;
	 else
	    callobj = cinst->thisobject;
	
	 /* Don't infinitely recurse if object is on its own schematic	  */
	 /* However, we need to take a stab at more subtle recursion, too */

	 if (callobj != cschem)
	    if (cleartraversed(callobj, level + 1) == -1)
	       return -1;
      }
   }
   cschem->traversed = False;

   return 0;
}

/*----------------------------------------------------------------------*/
/* If any part of the netlist is invalid, destroy the entire netlist 	*/
/*----------------------------------------------------------------------*/

int checkvalid(objectptr cschem)
{
   genericptr *cgen;
   objinstptr cinst;
   objectptr callobj;
	
   /* Stop immediately if the netlist is invalid */
   if (cschem->valid == False) return -1;

   /* Otherwise, recursively call checkvalid() on all subobjects.	*/
   /* Use the parts list of the object, not the calllist, because calls */
   /* may have been removed.						*/

   for (cgen = cschem->plist; cgen < cschem->plist + cschem->parts; cgen++) {
      if ((*cgen)->type == OBJECT) {
 	 cinst = TOOBJINST(cgen);

	 if (cinst->thisobject->symschem != NULL)
	    callobj = cinst->thisobject->symschem;
	 else
	    callobj = cinst->thisobject;
	
	 /* Don't infinitely recurse if object is on its own schematic	  */

	 if (callobj == cschem) continue;

	 /* If there is a symbol, don't check its parts, but check if 	*/
	 /* its netlist has been checkvalid.				*/

	 if ((cinst->thisobject->symschem != NULL) &&
		(cinst->thisobject->netlist == NULL) &&
		(cinst->thisobject->valid == False))
	    return -1;
	       
	 /* Recursive call on subschematic */
	 if (checkvalid(callobj) == -1)
	    return -1;
      }
   }
   return 0;	/* All subnetlists and own netlist are valid */
}

/*----------------------------------------------------------------------*/
/* Free memory allocated to temporary labels generated for the netlist	*/
/*----------------------------------------------------------------------*/

void freetemplabels(objectptr cschem)
{
   genericptr *cgen;
   objinstptr cinst;
   objectptr callobj;
	
   /* Recursively call freetemplabels() on all subobjects, a la gennetlist()  */
   /* Use the parts list of the object, not the calllist, because calls */
   /* may have been removed.						*/

   if (cschem->schemtype == SCHEMATIC || (cschem->schemtype == SYMBOL &&
		cschem->symschem == NULL)) {
      for (cgen = cschem->plist; cgen < cschem->plist + cschem->parts; cgen++) {
         if ((*cgen)->type == OBJECT) {

 	    cinst = TOOBJINST(cgen);
	    if (cinst->thisobject->symschem != NULL)
	       callobj = cinst->thisobject->symschem;
	    else
	       callobj = cinst->thisobject;
	
	    /* Don't infinitely recurse if object is on its own schematic */
	    if (callobj != cschem) freetemplabels(callobj);

	    /* Also free the temp labels of any associated symbol */
	    if (cinst->thisobject->symschem != NULL) freetemplabels(cinst->thisobject);
	 }

         /* Free any temporary labels which have been created	 */
         /* (All elements after the 1st temp label are temp labels) */

         else if ((*cgen)->type == LABEL) {
	    labelptr clab = TOLABEL(cgen);
	    int tmpval = (int)(cgen - cschem->plist);
	    if (clab->string->type != FONT_NAME) {
	       while (cgen < cschem->plist + cschem->parts) {
	          clab = TOLABEL(cgen);
	          freelabel(clab->string);
	          free(clab);
	          cgen++;
	       }
	       cschem->parts = tmpval;
	       break;
	    }
	 }
      }
   }
}

/*----------------------------------------------------------------------*/
/* Free memory allocated for netlists, portlists, and calllists		*/
/*----------------------------------------------------------------------*/

void freenets(objectptr cschem)
{
   CalllistPtr calllist, cptr;
   PortlistPtr portlist, pptr;
   genericptr *cgen;
   objinstptr cinst;
   objectptr callobj;
	
   /* Recursively call freenets() on all subobjects, a la gennetlist()  */
   /* Use the parts list of the object, not the calllist, because calls */
   /* may have been removed.						*/

   if (cschem->schemtype == SCHEMATIC || (cschem->schemtype == SYMBOL &&
		cschem->symschem == NULL)) {
      for (cgen = cschem->plist; cgen < cschem->plist + cschem->parts; cgen++) {
         if ((*cgen)->type == OBJECT) {

 	    cinst = TOOBJINST(cgen);
	    if (cinst->thisobject->symschem != NULL)
	       callobj = cinst->thisobject->symschem;
	    else
	       callobj = cinst->thisobject;
	
	    /* Don't infinitely recurse if object is on its own schematic */
	    if (callobj != cschem) freenets(callobj);

	    /* Also free the netlist of any associated symbol */
	    if (cinst->thisobject->symschem != NULL) freenets(cinst->thisobject);
	 }
      }
   }

   /* Free the allocated structures for this object */

   for (calllist = cschem->calllist; calllist != NULL;) {
      cptr = calllist->next;
      for (portlist = calllist->ports; portlist != NULL;) {
	 pptr = portlist->next;
	 free(portlist);
	 portlist = pptr;
      }
      free(calllist);
      calllist = cptr;
   }

   for (portlist = cschem->portlist; portlist != NULL;) {
      pptr = portlist->next;
      free(portlist);
      portlist = pptr;
   }

   if (cschem->devname != NULL) {
      free(cschem->devname);
      cschem->devname = NULL;
   }

   freenetlist(cschem);

   cschem->calllist = NULL;
   cschem->portlist = NULL;
   cschem->traversed = False;
   cschem->valid = False;
}

/*-------------------------------------------------------------------------*/
/* Free the global pin list 					   	   */
/*-------------------------------------------------------------------------*/

void freeglobals()
{
   freenetlist(NULL);
}

/*-------------------------------------------------------------------------*/
/* Get rid of locally-defined pin names	 				   */ 
/*-------------------------------------------------------------------------*/

void clearpins(objectptr cschem)
{
   NetlistPtr netlist;
  
   for (netlist = cschem->netlist; netlist != NULL; netlist = netlist->next) {
      if (netlist->localpin != NULL) {
         freelabel(netlist->localpin);
         netlist->localpin = NULL;
      }
   }
}

#endif
/*-------------------------------------------------------------------------*/