-- File StaticImpl.Mesa
-- Last changed: December 19, 1982 by CPT
--Stored on [indigo]<chipmonk>static>

DIRECTORY IODefs,Time,StreamDefs,StringDefs,SystemDefs,SegmentDefs, --from [ivy]<mesa>system>
		Real, --from [indigo]<cedarlib>real>alto>
		CWF,CWFReal; --from [indigo]<cedarlib>wf>dstar


StaticImpl: PROGRAM IMPORTS IODefs,Time,StreamDefs,StringDefs,SegmentDefs,Real,CWF,CWFReal = BEGIN
  OPEN io:IODefs,seg:SegmentDefs;

--PURPOSE and HISTORY: This program performs some consistency and 
--	validity checks on a circuit produced by a circuit extractor
--	from a layout of an NMOS chip.  It is called STATIC since the
--	checks are static checks on the structure and shape of the
--	circuit rather than checks on the dynamics of the circuit
--	that one might get from a simulator.  This program was originally
--	written by Forest Baskett and was based on an eariler similar
--	program done by Clark M. Baker.  This version is more
--	thorough, checks more conditions, is faster, and uses dynamic
--	storage allocation.

--DEFINITIONS and NOTES:
-- 	An equivalence class is a collection of nodes excluding VDD and GND that
-- 	would be electrically connected if all gates were on.
-- 	A node belongs to exactly one equivalence class.
-- 	A gate belongs to exactly one equivalance class.
-- 	The node controlling that gate is an input to that equivalence class.
-- 	That equivalence class is an output class of the class containing
-- 	the node controlling that gate.

MAXIDLENGTH:CARDINAL = 256;
HASHSIZE:	CARDINAL = 731;  --May be small for big circuits
MAXPDL:	CARDINAL = 7;

nameIndex:	TYPE = [0..MAXIDLENGTH);
hashIndex:	TYPE = [0..HASHSIZE);
pdlIndex:	TYPE = [1..MAXPDL];

nodeLink:	TYPE = LONG POINTER TO node;
eTransLink:	TYPE = LONG POINTER TO eTrans;
dTransLink:	TYPE = LONG POINTER TO dTrans;

node:	TYPE = RECORD
	[ PU,PD,IPU,GATE,MARK,INPUT,MANY: BOOLEAN, --GATE means that this node contains one or more gates.
	next:	nodeLink,    --next node
	equiv:	nodeLink,    --The exemplar of the class has equiv = NIL, and all other members of the class are linked (through equiv) to the exemplar.
	igates:	eTransLink,  --List of transistors whose gates control this node
	name:	PACKED ARRAY[0..0) OF CHARACTER ];

eTrans:	TYPE = RECORD
	[gate, source, drain:	nodeLink,
	igate:	eTransLink,  --all gates controlling an equivalence class are linked through this field.
	elength,ewidth:	LONG CARDINAL,
	x, y: LONG INTEGER,
	next:	eTransLink];

dTrans:	TYPE = RECORD
	[gate, source:nodeLink,
	dlength,dwidth:	LONG CARDINAL,
	x, y: LONG INTEGER,
	next:	dTransLink];

eBase:	eTransLink;
dBase:	dTransLink;
blockPointer:	LONG POINTER;
blockCount:	CARDINAL ← 0;

in:		StreamDefs.StreamHandle;
out:		StreamDefs.StreamHandle;
line:	STRING ← [MAXIDLENGTH];
fname:	STRING ← [MAXIDLENGTH];
inname:	STRING ← [MAXIDLENGTH];
eol:	BOOLEAN;
lowLimit,highLimit:	REAL; -- limits on L/W (set by user)
infactor, ipufactor:	REAL;  -- amount by which to multiply the L/W
--of a transistor connected to an input or indirectly
--pulled up (i.e. , driven by a passgate) (set by user) 

hash:	ARRAY hashIndex OF nodeLink;
pd0:	dTransLink;
pd:		ARRAY pdlIndex OF eTransLink;

nnodes,netrans,ndtrans,ndfunny:	LONG CARDINAL;
vdd,gnd:	nodeLink;




TimeStamp: PROCEDURE = BEGIN
	timeString: STRING = [MAXIDLENGTH];
	Time.Append[timeString, Time.Unpack[Time.Current[]]];
	CWF.WF["%s*n", timeString];
END;

WriteName: PROCEDURE [a: nodeLink, form: STRING, wp: PROCEDURE[CHARACTER]] = BEGIN
	i:	nameIndex;
	i←0; WHILE a.name[i] # 0C DO {wp[a.name[i]]; i←i+1} ENDLOOP;
END;

RdID: PROCEDURE [id: STRING] = BEGIN
	char:	CHARACTER;
	i:	nameIndex;
	i ← 0;
	char ← io.ReadChar[];
	WHILE char = io.SP OR char = io.TAB OR char = io.CR OR char = io.LF DO
		char ← io.ReadChar[];
		ENDLOOP;
	WHILE char # io.SP AND char # io.CR AND char # io.LF AND char # io.TAB DO
		id[i] ← char; i ← i+1; char←io.ReadChar[]
		ENDLOOP;
	id.length ← i; eol ← (char = io.CR OR char = io.LF);
END;

ReadLine: PROCEDURE [id: STRING] = BEGIN
	char:	CHARACTER;
	i:	nameIndex;
	i ← 0;
	IF NOT eol THEN BEGIN
		char←io.ReadChar[];
		WHILE char # io.CR AND char # io.LF DO
			id[i] ← char; i ← i+1; char←io.ReadChar[];
			ENDLOOP;
		id.length ← i;
	END;
	eol ← FALSE;
END;

ReadDecimal: PROCEDURE RETURNS [LONG INTEGER] = BEGIN
	s:	STRING ← [MAXIDLENGTH];
	RdID[s];
	RETURN[StringDefs.StringToLongNumber[s,10]];
END;

sscanf: PROCEDURE [line,g,s,d: STRING] RETURNS [l, w: LONG CARDINAL, x, y: LONG INTEGER] = BEGIN
	RdID[g]; RdID[s]; RdID[d];
	l ← ReadDecimal[]; w ← ReadDecimal[];
	x ← ReadDecimal[]; y ← ReadDecimal[];
	ReadLine[line];
END;

WriteCoords: PROCEDURE [x, y: LONG INTEGER] = BEGIN
	CWF.WF["%ld %ld ", @x, @y];
  END;


eq: PROCEDURE [n: eTransLink, a,b: nodeLink] RETURNS [BOOLEAN] = BEGIN
	RETURN[(n.source=a AND n.drain=b) OR (n.source=b AND n.drain=a)];
END;

other: PROCEDURE [n: eTransLink, a: nodeLink] RETURNS [nodeLink] = BEGIN
	IF n.source = a THEN RETURN[n.drain];
	IF n.drain = a THEN RETURN[n.source];
	RETURN[NIL];
END;

hashcode: PROCEDURE [name: STRING] RETURNS [hashIndex] = BEGIN
	j:	nameIndex;
	i:	INTEGER ← 0;
	FOR j IN [0..name.length) DO
		i ← i*10 + (name[j] - '0);
		IF name[j] >= 'a THEN i ← i - 32;  --hash on upper case only
		ENDLOOP;
	i ← i MOD HASHSIZE;
	RETURN[IF i<0 THEN i+HASHSIZE ELSE i];
END;

strcmp: PROCEDURE [s: STRING, n: nodeLink] RETURNS [BOOLEAN] = BEGIN
	i:	INTEGER;
	j:	nameIndex;
	FOR j←0, j+1 UNTIL j=s.length DO
		i ← n.name[j] - s[j];  --check for equality regardless of case
		IF i = 0 THEN LOOP;
		IF i = 32 AND s[j] >= 'A THEN LOOP;
		IF i = -32 AND s[j] >= 'a THEN LOOP;
		RETURN[FALSE];
		REPEAT
		FINISHED => RETURN[n.name[j] = 0C]
		ENDLOOP;
END;

AllocateNode:  PROCEDURE[size:  CARDINAL] RETURNS [p:  LONG POINTER] = BEGIN
	IF size > blockCount THEN BEGIN
		blockPointer ← seg. LongDataSegmentAddress[seg.NewDataSegment
		[seg.DefaultANYBase, 1]];
		blockCount ← 256;
		END;
	blockCount ← blockCount - size;
	p ← blockPointer; blockPointer ← blockPointer + size;
END;

lookup:  PROCEDURE [s: STRING] RETURNS [nodeLink] =BEGIN
-- returns the nodeLink corresponding to the string name.  
-- Makes a new node and initializes it if there is no such node.
	n:	nodeLink;
	j:	CARDINAL;
	h:	hashIndex;
	h ← hashcode[s];
	FOR n←hash[h], n.next UNTIL n = NIL DO
		IF strcmp[s,n] THEN { n.MANY ← TRUE; RETURN[n] }
		ENDLOOP;
	n ← AllocateNode[SIZE[node]+(s.length+2)/2];
	n.PU ← n.PD ← n.IPU ← n.GATE ← n.MARK ← n.INPUT ← FALSE;
	n.MANY ← FALSE;
	n.equiv ← NIL;
	n.igates ← NIL;
	n.next ← hash[h];
	hash[h] ← n;
	FOR j IN [0..s.length) DO n.name[j] ← s[j] ENDLOOP;
	n.name[s.length] ← 0C;
	nnodes ← nnodes+1;
	RETURN[n];
END;

findRoot:  PROCEDURE [n:  nodeLink] RETURNS [m:  nodeLink] = BEGIN -- find the node
--that is the exemplar of the equivalence class of which the given node is a member.
	FOR m ← n, m.equiv UNTIL m.equiv = NIL DO ENDLOOP;
END;

isEquiv: PROCEDURE [m,n: nodeLink] RETURNS [BOOLEAN] = BEGIN
	RETURN[findRoot[n] = findRoot[m]];
END;

makeEquiv: PROCEDURE [m,n: nodeLink] = BEGIN
-- puts two nodes into the same equivalence class by finding the exemplars of both classes,
-- and making one the exemplar of the other's class.  The ability to be pulled up (indirectly) is
-- inherited.
	k,l: nodeLink;
	k ← findRoot[m];
	l ← findRoot[n];
	IF k # l THEN BEGIN
		k.equiv ← l;
		IF k.PU OR k.IPU THEN l.IPU ← TRUE;
		IF k.PD THEN l.PD ← TRUE;
	END;
END;

pullup: PROCEDURE [n: nodeLink] = BEGIN
	m:	nodeLink;
	m ← findRoot[n];
	m.IPU ← TRUE;
END;

pulldown: PROCEDURE [n: nodeLink] = BEGIN
	m:	nodeLink;
	m ← findRoot[n];
	m.PD ← TRUE;
END;

doPullups:  PROCEDURE [] = BEGIN --  called once in main
	a, b, c:	nodeLink;
	w, x:	dTransLink;
	y, z:	eTransLink;
	--looks for pullups of the form:
	--d A VDD A (W)
	pullups: LONG CARDINAL ← 0;	-- number of pullups
	-- looks for inverting superbuffers of the form:
	--d B VDD B (X)
	--e C B GN D (Y)
	--e C A GN D (Z)
	nisbuffers: LONG CARDINAL ← 0;		-- number of inverting superbuffers
	-- looks for non-inverting superbuffers of the form:
	--d B VDD A (W)
	--e B C GND (Y)
	--d C VDD C (X)
	--e C A GND (Z)
	nsbuffers: LONG CARDINAL ← 0;	-- number of non-inverting superbuffers
	unknowns: LONG CARDINAL;		-- number on unrecognizable depletion mode transistors


	FOR w ← dBase, w.next UNTIL w = NIL DO
		a ← w.source;
		b ← w.gate;
		IF a.PU THEN CWF.WF["Node pulled up more than once:  %n*n",a];
		pullup[a];  -- no matter what, this node is pulled up.
		a.PU ← TRUE;
		IF a = b THEN BEGIN
			pullups ← pullups+1;
			LOOP;
		END;

		FOR y ← b.igates, y.igate UNTIL y = NIL DO
			IF eq[y , b, gnd] THEN BEGIN
				c ← y.gate;
				FOR z ← a.igates, z.igate UNTIL z = NIL DO
					IF z.gate = c AND eq [z, a, gnd] THEN
					FOR x ← dBase, x.next UNTIL x = NIL DO
						IF x.source = b AND x.gate = b THEN BEGIN
							nisbuffers ← nisbuffers+1;
							GOTO quit1;
							END
					ENDLOOP
				ENDLOOP
			END
		REPEAT quit1 => LOOP;
		ENDLOOP;

		FOR z ← a.igates, z.igate UNTIL z = NIL DO
			IF eq[z, a, gnd] THEN BEGIN
				c ← z.gate;
				FOR y ← c.igates, y.igate UNTIL y = NIL DO
					IF y.gate = b AND eq[ y, c, gnd] THEN
					FOR x ← dBase, x.next UNTIL x = NIL DO
						IF x.gate = c AND x.source = c THEN BEGIN
							nsbuffers ← nsbuffers+1;
							GOTO quit2;
							END
					ENDLOOP
				ENDLOOP
			 END
		REPEAT quit2 => LOOP;
		ENDLOOP;

		WriteCoords[w.x,w.y];
		CWF.WF["depletion transitor not a pullup or a superbuffer:  d %n %n %n *n",
		    w.gate , w.source, vdd];
	ENDLOOP;
	CWF.WF["pullups and non-inverting superbuffers:  %7ld %7ld*n", @pullups, @ nsbuffers];
	unknowns ← ndtrans - pullups - nsbuffers - nisbuffers;
	CWF.WF["inverting superbuffers and unknowns:  %7ld %7ld*n",  @nisbuffers,  @unknowns];
END;

findInputs:  PROCEDURE [ ] = BEGIN		-- called once in main
--looks for eTrans with gate = drain|source = gnd (lightning arrester)
	e:	eTransLink;
	n:	nodeLink;
	FOR e ← eBase, e.next UNTIL e = NIL DO
		IF e.gate = gnd THEN
			IF e.source = gnd AND NOT e.drain.INPUT THEN BEGIN
				WriteCoords[e.x,e.y];
				CWF.WF["Assuming lightning arrested node is an Input:  %n*n", e.drain];
				e.drain.PU ← e.drain.PD ←  e.drain.INPUT ← TRUE;
				n ← findRoot [e.drain];
				n.IPU ← TRUE
			END
		ELSE IF e.drain = gnd AND NOT e.source.INPUT THEN BEGIN
			WriteCoords[e.x,e.y];
			CWF.WF["Assuming lightning arrested node is an Input: %n*n", e.source];
			e.source.PU← e.source.PD ← e.source.INPUT←TRUE;
			n ← findRoot[e.source];
			n.IPU←TRUE
		END;
	ENDLOOP;
END;

checkThresholds:  PROCEDURE [ ] = BEGIN           -- called once in main
	e:	eTransLink;
	FOR e ← eBase, e. next UNTIL e = NIL DO
-- IF neither the gate nor the source are directly pulled up .  .  .
-- AND the drain drives at least one gate .  .  .
-- AND the gate and the source are not connected.  .  .
-- AND the gate # gnd .  .  .
-- AND the source # gnd
-- AND both the drain and source of the driven transistor are not inputs (if either one is, then
-- this is a bootstrap)
-- THEN this is a pass transistor driven by another pass transistor
-- and it is an error.

		IF NOT (e.gate.PU OR e.source.PU) AND e.drain.GATE AND e.gate # e.source AND e.gate # gnd AND e.source # gnd THEN {
			WriteCoords[e.x,e.y];
			CWF.WF["Pass transistor driven by pass transistor:  %n %n %n*n",e.gate,e.source,e.drain]
			};

-- Same check as above, with source and drain interchanged.

		IF NOT (e.gate.PU OR e.drain.PU) AND e.source.GATE AND e.gate # e.drain AND e.gate # gnd AND e.drain # gnd THEN {
			WriteCoords[e.x,e.y];
			CWF.WF["Pass transistor driven by pass transistor:  %n %n %n*n",e.gate,e.source,e.drain]
			};
	ENDLOOP;
END;


makeETrans:  PROCEDURE [t0, t1, t2: nodeLink, l,w: LONG CARDINAL,x,y: LONG INTEGER]  = BEGIN 
	e: eTransLink← AllocateNode[SIZE[eTrans]];
	e.next←eBase;
	eBase ← e;
	e.gate ←  t0;
	IF t0 # vdd AND t0 # gnd THEN e.gate.GATE ← TRUE;
	e.source ← t1;
	e.drain ← t2;
	e.igate ← NIL;
	e.elength ← l;
	e.ewidth ← w;
	e.x ← x;
	e.y ← y;
	IF e.source # vdd AND e.source # gnd AND e.drain # gnd AND e.drain # vdd AND e.gate # gnd THEN --if neither source nor drain are vdd or gnd, put
--the source and drain nodes in the same equivalence class
	makeEquiv[e.source,e.drain];
	IF e.source = vdd THEN pullup[e.drain];
	IF e.drain = vdd THEN pullup[e.source];
	IF e.source = gnd THEN pulldown [e.drain];
	IF e.drain  = gnd THEN pulldown[e.source];
	IF e.gate = gnd AND e.source # gnd AND e.drain # gnd THEN  --not a lightning arrester
		{ WriteCoords[e.x,e.y]; CWF.WF["Gate is GND: e %n %n %n*n", e.gate,e.source,e.drain] };
	IF e.gate # gnd AND (e.gate = e.source OR e.gate =  e.drain) THEN {
		WriteCoords[e.x,e.y];
		CWF.WF[ "gate and source or drain equality: e %n %n %n *n", e.gate, e.source, e.drain]
		};
	netrans← netrans+1;
END;

checkRatios: PROCEDURE [] = BEGIN	-- called once in main
	d:	dTransLink;
	n:	nodeLink;
	FOR d ← dBase, d.next UNTIL d = NIL DO
		n ← d.source;
		IF n # gnd AND n # vdd AND n.PU AND NOT n.INPUT THEN BEGIN
			pd0 ← d;
			doPulldowns[n,1];
		END
	ENDLOOP;
END;

doPulldowns: PROCEDURE [n: nodeLink, depth: pdlIndex] = BEGIN  --recursive and called once in CheckRatios 
--On initial entry, pd0 has the dTransLink for the pullup  under consideration,
--and n  has the nodeLink for the node pulled up by this transistor

	e:	eTransLink;
	o:	nodeLink;
	IF n = gnd THEN BEGIN
--		CWF.WF["x"];
		bottom[depth];
--		CWF.WF["y"];
		RETURN;
	END;

	n.MARK ←  TRUE;
	FOR e ← n.igates, e.igate UNTIL e = NIL DO --look at all the transistors that control node n
		IF (o ← other[e,n]) # NIL THEN
		IF NOT ((o.MARK OR o.PU OR o.GATE) AND o # gnd) THEN
--examine more of a path if...
--the node at the other end of the transistor under consideration is ground, OR
--the node is not MARKed  (examined earlier) AND not pulled up
--AND does not drive a GATE. The reason
-- for excluding nodes that drive gates is to keep from chasing down a path that consists of
--a pullup driving a passgate multiplexer.  If the examination is not stopped at the node
--that drives the passgate, the ratio will almost always be too high, and will produce
--spurious error messages (since the gates of the pass transistors almost always have
--mutally exclusive control signals).  This will miss some valid paths, but life is hard.
		IF depth < MAXPDL THEN BEGIN 
			pd[depth] ← e;
			doPulldowns[o,depth+1];
		END
	ENDLOOP;
	n.MARK ← FALSE;
END;

bottom:  PROCEDURE [depth: pdlIndex] = BEGIN	  --called once in do Pulldowns
	i:	pdlIndex;
	bad:	BOOLEAN ← FALSE;
	n:	nodeLink;
	sum:	REAL ← 0.0;
	ratio: 	REAL;
	type:	REAL;
	IF pd0.dwidth = 0 THEN bad ← TRUE;
	FOR  i← 1, i+1  UNTIL i=depth DO
		IF pd[i].ewidth = 0 THEN bad ← TRUE
		ELSE sum ← sum + Real.Float[pd[i].elength] / pd[i].ewidth* (IF pd[i].gate.INPUT THEN infactor ELSE IF pd[i].gate.IPU THEN ipufactor ELSE 1.0);
	ENDLOOP;
	IF bad THEN ratio ← 0.0
	ELSE ratio ← pd0.dlength / (pd0.dwidth* sum);
	IF ratio < lowLimit OR ratio > highLimit THEN BEGIN
		WriteCoords[pd0.x,pd0.y];
		CWF.WF["Pullup/pulldown ratio = %5.2f: Node %n pulled up thru %ld by %ld*n",@ratio, pd0.source, @pd0.dlength, @pd0.dwidth];
		n ← pd0.source;
		FOR i←1, i+1 UNTIL  i=depth DO
			n←other[pd[i],n];
			type ← IF pd[i].gate.INPUT THEN infactor ELSE IF pd[i].gate.IPU THEN ipufactor ELSE 1.0;
			WriteCoords[pd[i].x,pd[i].y];
			CWF.WF["*tpulled down by node %n thru %ld by %ld (x%5.2f)", pd[i].gate,@pd[i].elength,@pd[i].ewidth,@type];
			CWF.WF[" to node %n*n",n]
		ENDLOOP;

	END;
END;


checkValues:  PROCEDURE [] = BEGIN	--called once in main
	i:	hashIndex;
	m,n:	nodeLink;
	e:	eTransLink;
	d:	dTransLink;

	FOR i IN hashIndex DO
		FOR n ← hash[i], n.next UNTIL n = NIL DO
			m ←findRoot[n];
			n.IPU ←m.IPU;
			n.PD ← m.PD;
			IF NOT n.MANY THEN CWF.WF["Node name only occurs once: %n*n",n];
			IF NOT (n.PU OR n.IPU OR n.PD) THEN CWF.WF["Node can never be given a value: %n*n",n]
				ELSE IF NOT (n.PU OR n.IPU) AND n # gnd THEN CWF.WF["Node can never be set to 1: %n*n",n]
					ELSE IF NOT n.PD AND n # vdd THEN CWF.WF["Node can never be set to 0: %n*n", n]
		ENDLOOP
	ENDLOOP;

	FOR d ← dBase, d.next UNTIL d = NIL DO --start at each pullup, and make sure
--that some node in the class drives a gate.
		FOR e ← d.source.igates, e.igate UNTIL e=NIL DO
			IF e.source.GATE OR e.drain.GATE THEN EXIT;
		REPEAT
		FINISHED => {WriteCoords[d.x,d.y];CWF.WF["Value not used: %n*n", d.source]};
		ENDLOOP
	ENDLOOP;
END;


initStatic:  PROCEDURE [] = BEGIN  --called once in main
	line:	STRING← [MAXIDLENGTH];
	g:	STRING← [MAXIDLENGTH];
	s:	STRING← [MAXIDLENGTH];
	dr:	STRING← [MAXIDLENGTH];
	t0,t1,t2:  	nodeLink;
	l,w:	LONG CARDINAL;
	x,y: LONG INTEGER;
	d:	dTransLink;
	m,n: 	nodeLink;
	e:	eTransLink;
	i:	hashIndex;
	echo:	BOOLEAN;
	nnodes ← netrans ← ndtrans ← ndfunny ← 0;
	FOR i  IN hashIndex DO hash[i] ← NIL ENDLOOP;
	eBase ← NIL;
	dBase ← NIL;
	eol ← FALSE;
	gnd ←  lookup["gnd"];
	vdd← lookup["vdd"];
	vdd.PU ←  gnd.PD ← TRUE;
	echo ← io.SetEcho[FALSE];
	WHILE NOT in.endof [in] DO
		eol ← FALSE;
		SELECT io.ReadChar[ ] FROM
			= 015C  => LOOP;  -- blank line
			='  => LOOP; --leadingblanks
			='e, 'z => BEGIN  -- enhancement transistor
				[l, w, x, y] ← sscanf[line,g,s,dr];
				t0 ← lookup[g];
				t1 ← lookup[s];
				t2 ← lookup[dr];
				makeETrans[t0,t1,t2,l,w,x,y];
				IF t0 = vdd THEN { WriteCoords[x,y]; CWF.WF["Gate is VDD:  e %n %n %n*n", t0, t1, t2]};
			END;
			='d, ='x => BEGIN -- depletion transistor
				[l, w, x, y] ← sscanf[line,g,s,dr];
				t0 ← lookup[g];
				t1 ← lookup[s];
				t2 ← lookup[dr];
				IF t1 # vdd AND t2 # vdd THEN BEGIN -- nonstandard use of dTrans
						ndfunny ← ndfunny+1;
						IF t1 = t2 AND t1 # t0 THEN BEGIN -- capacitor
							WriteCoords[x,y];
							CWF.WF["depletion capacitor - ignored:  d %n %n %n*n", t0, t1, t2,];
							LOOP;
						END;
						IF (t0 = t1) OR (t0 = t2) THEN BEGIN  --resistor
							WriteCoords[x,y];
							CWF.WF["depletion resistor: d %n %n %n*n", t0, t1, t2];
							makeETrans[vdd, t1,t2,l,w, x, y];
							netrans ← netrans-1;
							LOOP;
						END;
						WriteCoords[x,y];
						CWF.WF["yellow transistor:  d %n %n %n *n", t0, t1, t2,];
						makeETrans[vdd, t1, t2, l,w,x,y];
						netrans ← netrans-1;
						LOOP;
					END;
				d ← AllocateNode[SIZE[dTrans]];
				d.next ← dBase;
				dBase ← d;
				d.gate ← t0;
				IF (t1 = vdd) = (t2 = vdd) THEN { WriteCoords[x,y]; CWF.WF["depletion error: d %n %n %n*n", t0, t1, t2]};
				d.source ← (IF t1= vdd THEN t2 ELSE t1);
				d.dlength ← l;
				d.dwidth ← w;
				d.x ← x;
				d.y ← y;
				ndtrans ← ndtrans+1;
				IF t0 # d.source THEN t0.GATE ← TRUE;
			END;

			= 'N => ReadLine[line]; -- node characteristics
			= '| => ReadLine[line]; -- comment character
			= '= => ReadLine[line]; -- node equivalence (extractor has already
-- assigned a common name for all nodes
			ENDCASE => BEGIN
				ReadLine[line];
				CWF.WF ["syntax error:  %s*n",line];
			END

 	ENDLOOP;

-- link together (starting at the exemplar's igates field) all gates for transistors in each equivalence class
	FOR e ← eBase, e.next UNTIL e = NIL DO
		IF e.source # vdd AND e.source # gnd THEN
			n ← findRoot [e.source]  --find the node that is the exemplar of the equivalence
--class of which this node is a part
		    ELSE  n ← findRoot [e.drain];
		IF n = gnd THEN {WriteCoords[e.x,e.y]; CWF.WF["funny eTrans: e %n %n %n*n", e.gate, e.source, e.drain]};
		e.igate ← n.igates; --put this transistor on the list of the gates that affect
--the class of which the transistor is a part.
		n.igates ← e;
	ENDLOOP;

-- copy the igates field of the exemplary node for a class into the igates field of each 
--member of the class.
	FOR i IN hashIndex DO
		FOR n ← hash [i], n.next UNTIL n= NIL DO
			m ← findRoot[n];
			n.igates ← m.igates;
	 	ENDLOOP
	ENDLOOP;

	CWF.WF["Nodes, Etrans, Dtrans, FunnyDtrans:  %7ld %7ld %7ld %7ld*n", @nnodes, @netrans, @ndtrans,@ndfunny];

END;

--the body
	Real.InitReals[ ];
	CWFReal.InitCWFReals[ ];
	CWF.SetCode['n, WriteName];
	CWF.WF["Name of the file to be checked (no extension): "];
	io.ReadID[fname];
	StringDefs.AppendString[inname,fname];
	StringDefs.AppendString[inname,".sim"];
	StringDefs.AppendString[fname,".erclog"];
	in ← StreamDefs.NewByteStream[inname, StreamDefs.Read];
	out ← StreamDefs.NewByteStream[fname,StreamDefs.Write+StreamDefs.Append];
	CWF.WF["*nLow Ratio:  "];
	io.ReadID[line];
	lowLimit ← Real.StringToReal[line];
	CWF.WF["*nHigh Ratio:  "];
	io.ReadID[line];
	highLimit ← Real.StringToReal[line];
	CWF.WF["*nL/W multiplier for input transistors:  "];
	io.ReadID[line];
	infactor ← Real.StringToReal[line];
	CWF.WF["*nL/W multiplier for transistors with indirectly pulled up gates:  "];
	io.ReadID[line];
	ipufactor ← Real.StringToReal[line];
	io.SetInputStream[in];
	io.SetOutputStream[out];
	CWF.WF["*n"];
	TimeStamp[ ];
	initStatic[ ];
	doPullups[ ];
	findInputs[ ];
	checkValues[ ];
	checkThresholds[ ];
	checkRatios[ ];
	CWF.ResetCode['n];
	out.destroy[out];
END.