(FILECREATED "17-Sep-86 11:10:10" {ERIS}<TAMARIN>TSIM>SIM.;121 123630Q

      changes to:  (FNS getfile)

      previous date: "12-Sep-86 17:20:45" {ERIS}<TAMARIN>TSIM>SIM.;120)


(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT SIMCOMS)

(RPAQQ SIMCOMS ((* * Constants)
		  (CONSTANTS (NPOTS 13Q)
			     (nchannel 0)
			     (pchannel 1)
			     (INIT 0)
			     (DX 1)
			     (DHIGH 2)
			     (DLOW 3)
			     (CX 4)
			     (CHIGH 5)
			     (CLOW 6)
			     (PU 7)
			     (DXLOW 10Q)
			     (DXHIGH 11Q)
			     (CSHARE 12Q)
			     (PD 13Q)
			     (RESIST 0)
			     (ON 1)
			     (OFF 2)
			     (CAPMA .000026)
			     (CAPPA .00004)
			     (CAPDA .000054)
			     (CAPDP .000095)
			     (CAPGA .00004)
			     (CLAMBDA 2.5)
			     (CLAMBDA2 .00004)
			     (RSEG 1))
		  (* * Record Definitions)
		  (RECORDS node trans)
		  (* * Variables)
		  (VARS transtbllist gatetbllist inittbllist potto01list 01topotlist)
		  (GLOBALVARS VDDNode GNDNode)
		  (GLOBALVARS trancount netarray nodecount nodemax nodeoffset nion tracenumber 
			      tracelist)
		  (GLOBALVARS queuelist showdxs showreques doreques)
		  (GLOBALVARS numsteps warning warningdisplay log includetemps)
		  (GLOBALVARS netlist transtbllist ionodelist transtblarray gatetbllist gatetblarray 
			      potto01array pottoatom 01topotarray inittbllist inittblarray dxarray)
		  (* * Node linked lists)
		  (GLOBALVARS elist elast clist)
		  (* * Interface Functions)
		  (FNS steps etrans dtrans setinputh setinputl setinputx setnode getfile queueall 
		       setall qnode)
		  (* * Internal Interface Functions)
		  (FNS newtransstring setinputstring getnode findnode setin clrin queue)
		  (* * Stepping Functions)
		  (FNS stepsetup simstep calcval)
		  (* * Walknet functions)
		  (FNS walknet clearlinks cleartran clearnet clearinputs)
		  (* * chaining functions)
		  (FNS queued xenque enque chain)
		  (* * Initializations & Setup)
		  (FNS initsim maketransarray makegatearray makeinitarray makepotto01array 
		       makepottoatomarray make01topotarray makedxarray)
		  (* * Service functions)
		  (FNS outtrace transtbl transtblresist gatetbl inittbl ELTX)
		  (* * Macros)
		  (MACROS transtbl transtblresist gatetbl inittbl ELTX queued)))
(* * Constants)

(DECLARE: EVAL@COMPILE 

(RPAQQ NPOTS 13Q)

(RPAQQ nchannel 0)

(RPAQQ pchannel 1)

(RPAQQ INIT 0)

(RPAQQ DX 1)

(RPAQQ DHIGH 2)

(RPAQQ DLOW 3)

(RPAQQ CX 4)

(RPAQQ CHIGH 5)

(RPAQQ CLOW 6)

(RPAQQ PU 7)

(RPAQQ DXLOW 10Q)

(RPAQQ DXHIGH 11Q)

(RPAQQ CSHARE 12Q)

(RPAQQ PD 13Q)

(RPAQQ RESIST 0)

(RPAQQ ON 1)

(RPAQQ OFF 2)

(RPAQQ CAPMA .000026)

(RPAQQ CAPPA .00004)

(RPAQQ CAPDA .000054)

(RPAQQ CAPDP .000095)

(RPAQQ CAPGA .00004)

(RPAQQ CLAMBDA 2.5)

(RPAQQ CLAMBDA2 .00004)

(RPAQQ RSEG 1)

(CONSTANTS (NPOTS 13Q)
	   (nchannel 0)
	   (pchannel 1)
	   (INIT 0)
	   (DX 1)
	   (DHIGH 2)
	   (DLOW 3)
	   (CX 4)
	   (CHIGH 5)
	   (CLOW 6)
	   (PU 7)
	   (DXLOW 10Q)
	   (DXHIGH 11Q)
	   (CSHARE 12Q)
	   (PD 13Q)
	   (RESIST 0)
	   (ON 1)
	   (OFF 2)
	   (CAPMA .000026)
	   (CAPPA .00004)
	   (CAPDA .000054)
	   (CAPDP .000095)
	   (CAPGA .00004)
	   (CLAMBDA 2.5)
	   (CLAMBDA2 .00004)
	   (RSEG 1))
)
(* * Record Definitions)

[DECLARE: EVAL@COMPILE 

(DATATYPE node ((elink XPOINTER)
	   (nlink XPOINTER)
	   (ngate POINTER)
	   (nsource POINTER)
	   (ndrain POINTER)
	   (ncap POINTER)
	   (npot POINTER)
	   (name POINTER)
	   (xqueued FLAG)
	   (pullup FLAG)
	   (pulldown FLAG)
	   (input FLAG)
	   (warned FLAG))
	  elink ← NIL nlink ← NIL ngate ← NIL nsource ← NIL ndrain ← NIL npot ← CX ncap ← 0 name ←(
	    QUOTE Unnamed)
	  xqueued ← NIL pullup ← NIL pulldown ← NIL input ← NIL warned ← NIL)

(DATATYPE trans ((type POINTER)
		   (gate XPOINTER)
		   (source XPOINTER)
		   (drain XPOINTER)))
]
(/DECLAREDATATYPE (QUOTE node)
		  (QUOTE (XPOINTER XPOINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG 
				   FLAG FLAG FLAG))
		  [QUOTE ((node 0 XPOINTER)
			  (node 2 XPOINTER)
			  (node 4 POINTER)
			  (node 6 POINTER)
			  (node 10Q POINTER)
			  (node 12Q POINTER)
			  (node 14Q POINTER)
			  (node 16Q POINTER)
			  (node 16Q (FLAGBITS . 0))
			  (node 16Q (FLAGBITS . 20Q))
			  (node 16Q (FLAGBITS . 40Q))
			  (node 16Q (FLAGBITS . 60Q))
			  (node 16Q (FLAGBITS . 100Q]
		  (QUOTE 20Q))
(/DECLAREDATATYPE (QUOTE trans)
		  (QUOTE (POINTER XPOINTER XPOINTER XPOINTER))
		  (QUOTE ((trans 0 POINTER)
			  (trans 2 XPOINTER)
			  (trans 4 XPOINTER)
			  (trans 6 XPOINTER)))
		  (QUOTE 10Q))
(* * Variables)


(RPAQQ transtbllist (((INIT DX DXHIGH DXLOW CX CX CX DXHIGH DXLOW DXHIGH CX DXLOW)
			(DX DX DX DX DX DX DX DX DX DX DX DX)
			(DHIGH DX DHIGH DX DHIGH DHIGH DHIGH DHIGH DX DHIGH DHIGH DHIGH)
			(DLOW DX DX DLOW DLOW DLOW DLOW DLOW DLOW DX DLOW DLOW)
			(CX DX DXHIGH DXLOW CX CX CX DXHIGH DXLOW DXHIGH CX DXLOW)
			(CX DX DXHIGH DXLOW CX CHIGH CX DXHIGH DXLOW DXHIGH CX DXLOW)
			(CX DX DXHIGH DXLOW CX CX CLOW DXHIGH DXLOW DXHIGH CX DXLOW)
			(PU DX PU DXLOW PU PU PU PU DXLOW PU PU DX)
			(DXLOW DX DX DXLOW DXLOW DXLOW DXLOW DX DXLOW DX DXLOW DXLOW)
			(DXHIGH DX DXHIGH DX DXHIGH DXHIGH DXHIGH DXHIGH DX DXHIGH DXHIGH DX)
			(CX DX DXHIGH DXLOW CX CX CX DXHIGH DXLOW DXHIGH CSHARE DXLOW)
			(PD DX DXHIGH PD PD PD PD DX PD DXHIGH PD PD))
		       ((INIT DX DHIGH DLOW CX CHIGH CLOW PU DXLOW DXHIGH CSHARE PD)
			(DX DX DX DX DX DX DX DX DX DX DX DX)
			(DHIGH DX DHIGH DX DHIGH DHIGH DHIGH DHIGH DX DHIGH DHIGH DHIGH)
			(DLOW DX DX DLOW DLOW DLOW DLOW DLOW DLOW DX DLOW DLOW)
			(CX DX DHIGH DLOW CX CSHARE CSHARE PU DXLOW DXHIGH CSHARE PD)
			(CHIGH DX DHIGH DLOW CSHARE CHIGH CSHARE PU DXLOW DXHIGH CSHARE PD)
			(CLOW DX DHIGH DLOW CSHARE CSHARE CLOW PU DXLOW DXHIGH CSHARE PD)
			(PU DX DHIGH DLOW PU PU PU PU DXLOW DXHIGH PU DX)
			(DXLOW DX DX DLOW DXLOW DXLOW DXLOW DXLOW DXLOW DX DXLOW DXLOW)
			(DXHIGH DX DHIGH DX DXHIGH DXHIGH DXHIGH DXHIGH DX DXHIGH DXHIGH DXHIGH)
			(CSHARE DX DHIGH DLOW CSHARE CSHARE CSHARE PU DXLOW DXHIGH CSHARE PD)
			(PD DX DHIGH DLOW PD PD PD DX DXLOW DXHIGH PD PD))
		       ((INIT INIT INIT INIT INIT INIT INIT INIT INIT INIT INIT INIT)
			(DX DX DX DX DX DX DX DX DX DX DX DX)
			(DHIGH DHIGH DHIGH DHIGH DHIGH DHIGH DHIGH DHIGH DHIGH DHIGH DHIGH DHIGH)
			(DLOW DLOW DLOW DLOW DLOW DLOW DLOW DLOW DLOW DLOW DLOW DLOW)
			(CX CX CX CX CX CX CX CX CX CX CX CX)
			(CHIGH CHIGH CHIGH CHIGH CHIGH CHIGH CHIGH CHIGH CHIGH CHIGH CHIGH CHIGH)
			(CLOW CLOW CLOW CLOW CLOW CLOW CLOW CLOW CLOW CLOW CLOW CLOW)
			(PU PU PU PU PU PU PU PU PU PU PU PU)
			(DXLOW DXLOW DXLOW DXLOW DXLOW DXLOW DXLOW DXLOW DXLOW DXLOW DXLOW DXLOW)
			(DXHIGH DXHIGH DXHIGH DXHIGH DXHIGH DXHIGH DXHIGH DXHIGH DXHIGH DXHIGH DXHIGH 
				DXHIGH)
			(CSHARE CSHARE CSHARE CSHARE CSHARE CSHARE CSHARE CSHARE CSHARE CSHARE CSHARE 
				CSHARE)
			(PD PD PD PD PD PD PD PD PD PD PD PD))))

(RPAQQ gatetbllist ((RESIST RESIST ON OFF RESIST ON OFF ON RESIST RESIST RESIST OFF)
		      (RESIST RESIST OFF ON RESIST OFF ON OFF RESIST RESIST RESIST ON)))

(RPAQQ inittbllist (CX CX CHIGH CLOW CX CHIGH CLOW CHIGH CX CX CX CLOW))

(RPAQQ potto01list ((INIT 2)
		      (DX 2)
		      (DHIGH 1)
		      (DLOW 0)
		      (CX 2)
		      (CHIGH 1)
		      (CLOW 0)
		      (PU 1)
		      (DXLOW 2)
		      (DXHIGH 2)
		      (CSHARE 2)
		      (PD 2)))

(RPAQQ 01topotlist (l h x))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS VDDNode GNDNode)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS trancount netarray nodecount nodemax nodeoffset nion tracenumber tracelist)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS queuelist showdxs showreques doreques)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS numsteps warning warningdisplay log includetemps)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS netlist transtbllist ionodelist transtblarray gatetbllist gatetblarray potto01array 
	    pottoatom 01topotarray inittbllist inittblarray dxarray)
)
(* * Node linked lists)

(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS elist elast clist)
)
(* * Interface Functions)

(DEFINEQ

(steps
  [LAMBDA NIL                                                (* rtk " 6-Aug-86 19:42")
    (SETQ outlist NIL)
    (stepsetup)
    (PROG ((s (simstep)))
	    (PRINTOUT T "Step took: " s " events." T)
	    (RETURN s])

(etrans
  [LAMBDA (trantype gate source drain length width xpos ypos)
                                                             (* rtk "25-Jun-86 16:11")
    (newtransstring trantype NIL gate source drain length width xpos ypos])

(dtrans
  [LAMBDA (trantype gate source drain length width xpos ypos)
                                                             (* rtk "25-Jun-86 16:03")
    (newtransstring trantype T gate source drain length width xpos ypos])

(setinputh
  [LAMBDA (nodelist dontforceinput)                          (* edited: " 2-Sep-86 15:55")
    (setinputstring nodelist DHIGH dontforceinput])

(setinputl
  [LAMBDA (nodelist dontforceinput)                          (* edited: " 2-Sep-86 15:55")
    (setinputstring nodelist DLOW dontforceinput])

(setinputx
  [LAMBDA (nodelist dontforceinput)                          (* edited: " 2-Sep-86 15:56")
    (setinputstring nodelist CX dontforceinput])

(setnode
  [LAMBDA (nodename darea dperim parea pperim marea mperim)
                                                             (* edited: "26-Aug-86 15:16")
    (IF (NUMBERP nodename)
	THEN (SETQ nodename (IPLUS nodename nodeoffset)))
    (PROG (n)
	    (if (NOT mperim)
		then (PRINTOUT "Bad node record " nodename T)
		       (RETURN NIL))
	    (SETQ n (getnode nodename))
	    (replace (node ncap) of n with (PLUS (fetch (node ncap) of n)
							 (TIMES marea CAPMA CLAMBDA2)
							 (TIMES parea CAPPA CLAMBDA2)
							 (TIMES darea CAPDA CLAMBDA2)
							 (TIMES dperim CAPDP CLAMBDA])

(getfile
  [LAMBDA (filename secondfile)                              (* rtk "17-Sep-86 11:09")
    (if (NOT filename)
	then (SETQ filename LastTranSimFile))
    (IF (LISTP filename)
	THEN [FOR i IN filename do (getfile i (NEQ i (CAR filename]
      else (if (NOT secondfile)
		 then (SETQ nodeoffset 0)
			(SETQ nodemax 0)
			(PRINTOUT T "Initializing Net" T)
			(initsim)
	       else (SETQ nodeoffset (ADD1 nodemax)))
	     (PROG (file end symb Args i inputlist)
		     (CLOSEF? filename)
		     (SETQ file (OPENSTREAM filename (QUOTE INPUT)))
		     (SETQ LastTranSimFile filename)
		     (PRINTOUT T "Loading: " LastTranSimFile T)
		     (SETQ end (DIFFERENCE (GETEOFPTR file)
					       4))
		     (SETQ errorlist NIL)
		     (RATOM file)
		     (RATOM file)
		     (RATOM file)
		     (until (GEQ (GETFILEPTR file)
				     end)
			do (SETQ Args (for i from 1 to (SELECTQ (SETQ symb
									      (RATOM file))
									    (N 7)
									    (e 7)
									    (d 7)
									    (NEXTFILE 1)
									    (HELP))
					     collect (RATOM file)))
			     (SETQ inputlist (CONS symb Args))
			     (SELECTQ symb
					[N (setnode (CAR (NTH Args 1))
						      (CAR (NTH Args 2))
						      (CAR (NTH Args 3))
						      (CAR (NTH Args 4))
						      (CAR (NTH Args 5))
						      (CAR (NTH Args 6))
						      (CAR (NTH Args 7]
					[d (dtrans (QUOTE nchannel)
						     (CAR (NTH Args 1))
						     (CAR (NTH Args 2))
						     (CAR (NTH Args 3))
						     (CAR (NTH Args 4))
						     (CAR (NTH Args 5))
						     (CAR (NTH Args 6))
						     (CAR (NTH Args 7]
					[e (etrans (QUOTE nchannel)
						     (CAR (NTH Args 1))
						     (CAR (NTH Args 2))
						     (CAR (NTH Args 3))
						     (CAR (NTH Args 4))
						     (CAR (NTH Args 5))
						     (CAR (NTH Args 6))
						     (CAR (NTH Args 7]
					(l (setinputl Args))
					(h (setinputh Args))
					(x (setinputx Args))
					(NEXTFILE (SETQ nodeoffset (ADD1 nodemax))
						  (PRINTOUT T "NextFile: " (CAR Args)
							    " @ " nodeoffset T))
					(BREAK1 NIL T (Illegal command in file)
						  NIL)))
		     (CLOSEF? file)))
    (SETQ nodeoffset 0)
    (setall CLOW)
    (PRINTOUT T "Total Nodes: " nodecount T)
    (PRINTOUT T "Total Transisters: " trancount T)
    (IF errorlist
	THEN (PRINTOUT T "Errors in simfile" T])

(queueall
  [LAMBDA NIL                                                (* rtk "11-Aug-86 20:07")
    (SETQ elist T])

(setall
  [LAMBDA (pot)                                              (* edited: "26-Aug-86 10:20")
    (SETQ gpot pot)
    [walknet (FUNCTION (LAMBDA (n)
		   (if (NOT (fetch (node input) of n))
		       then (replace (node npot) of n with gpot]
    (replace (node npot) of VDDNode with DHIGH)
    (replace (node npot) of GNDNode with DLOW])

(qnode
  [LAMBDA (n pot)                                            (* edited: " 2-Sep-86 16:20")
    (PROG ((nd (findnode n)))
	    (if nd
		then (queue (nd pot))
	      else (PRINTOUT "Cannot queue " n])
)
(* * Internal Interface Functions)

(DEFINEQ

(newtransstring
  [LAMBDA (trantype dtran? gate source drain length width xpos ypos)
                                                             (* edited: "26-Aug-86 15:16")
    (SETQ trancount (ADD1 trancount))
    (IF (NUMBERP gate)
	THEN (SETQ gate (IPLUS gate nodeoffset)))
    (IF (NUMBERP source)
	THEN (SETQ source (IPLUS source nodeoffset)))
    (IF (NUMBERP drain)
	THEN (SETQ drain (IPLUS drain nodeoffset)))
    (PROG (capacitance resistance tran (node1 (getnode gate))
			 (node2 (getnode source))
			 (node3 (getnode drain))
			 ntemp)
	    (if (OR (NOT drain)
			(AND length (NOT ypos)))
		then (PRINTOUT T "Error in Transistor Record of " trantype T)
		       (RETURN NIL))
	    (if ypos
		then (SETQ capacitance (TIMES length width CAPGA CLAMBDA2))
		       (SETQ resistance (TIMES (QUOTIENT length width)
						   RSEG))
		       (SETQ resistance 0.0)
	      else (SETQ resistance 0.0)
		     (SETQ capacitance 0.0))

          (* * Source not VDD or GND)


	    (if (OR (EQ node2 VDDNode)
			(EQ node2 GNDNode))
		then (SETQ ntemp node2)
		       (SETQ node2 node3)
		       (SETQ node3 ntemp))

          (* * Depletion Transistor?)


	    (if dtran?
		then (if (AND (EQ trantype (QUOTE nchannel))
				    (EQ node3 VDDNode))
			   then (replace (node pullup) of node2 with T)
				  (replace (node ncap) of node2
				     with (PLUS (fetch (node ncap) of node2)
						    capacitance))
				  (SETQ nion (ADD1 nion))
				  (RETURN NIL)
			 elseif (AND (EQ trantype (QUOTE pchannel))
					 (EQ node3 GNDNode))
			   then (replace (node pullup) of node2 with T)
				  (replace (node ncap) of node2
				     with (PLUS (fetch (node ncap) of node2)
						    capacitance))
				  (SETQ nion (ADD1 nion))
				  (RETURN NIL)
			 elseif (OR (EQ node1 node2)
					(EQ node1 node3))
			   then (SETQ errorlist (CONS inputlist errorlist))
				  (if (EQ node1 node3)
				      then (SETQ node2 node3)
					     (SETQ node3 VDDNode))
				  (SETQ node3 VDDNode)
				  (replace (node pullup) of node2 with T)
				  (replace (node ncap) of node2
				     with (PLUS (fetch (node ncap) of node2)
						    capacitance))
				  (SETQ nion (ADD1 nion))
				  (RETURN NIL)))

          (* * Depletion Transistor?)


	    (if dtran?
		then (SETQ errorlist (CONS inputlist errorlist))
		       (RETURN NIL)
		       (replace (node ncap) of node1 with (PLUS (fetch (node ncap)
									   of node1)
									capacitance))
		       (BREAK1 NIL T (Error in depletion Transister)
				 NIL)
		       (SETQ node1 VDDNode))

          (* * allocate new trans from free storage)


	    (SETQ tran (create trans
				   type ←(EVAL trantype)
				   gate ← node1
				   source ← node2
				   drain ← node3))
	    (replace (node ngate) of node1 with (CONS tran (fetch (node ngate)
								      of node1)))
	    (replace (node nsource) of node2 with (CONS tran (fetch (node nsource)
									of node2)))
	    (replace (node ndrain) of node3 with (CONS tran (fetch (node ndrain)
								       of node3)))
	    (replace (node ncap) of node1 with (PLUS (fetch (node ncap) of node1)
							     capacitance])

(setinputstring
  [LAMBDA (nodelist value dontforceinput)                    (* edited: "25-Aug-86 18:12")
    (if (NOT (LISTP nodelist))
	then (if (SETQ n (findnode nodelist))
		   then (setin n value dontforceinput)
		 else (PRINTOUT T "Cannot set input value " nodelist T))
      else (bind (n ← NIL) for i in nodelist do (if (SETQ n (findnode i))
							      then (setin n value dontforceinput)
							    else (PRINTOUT T 
									"Cannot set input value "
									     i T])

(getnode
  [LAMBDA (nodename)                                         (* edited: "26-Aug-86 16:04")
    (PROG ((n (findnode nodename)))
	    (if (NOT n)
		then (SETQ nodecount (ADD1 nodecount))
		       (SETQ n (create node))
		       (replace (node name) of n with nodename)
		       (if (NUMBERP nodename)
			   then (SETQ nodemax (MAX nodemax nodename))
				  (SETA netarray nodename n)
			 else (SETQ nodenames (CONS nodename nodenames))
				(PUTHASH nodename n nethash)))
	    (replace (node elink) of n with NIL)
	    (RETURN n])

(findnode
  [LAMBDA (nodename)                                         (* edited: "26-Aug-86 15:13")
    (if (NOT (TYPENAMEP nodename (QUOTE node)))
	then (PROG ((n (GETHASH nodename nethash)))
		       [if (NOT n)
			   then (IF (AND (NUMBERP nodename)
					       (SETQ n (ELTX netarray nodename)))
				      THEN NIL
				    ELSE (SETQ n (GETHASH (PACK (LIST (QUOTE N)
										nodename))
								nethash]
		       (RETURN n))
      else nodename])

(setin
  [LAMBDA (n pot dontforceinput)                             (* edited: " 2-Sep-86 16:13")
    (if (EQ pot CX)
	then (replace (node input) of n with NIL)
      else (if (NOT dontforceinput)
		 then (replace (node input) of n with T)))
    (queue n pot])

(clrin
  [LAMBDA (n pot)                                            (* edited: " 2-Sep-86 16:13")
    (replace (node input) of n with NIL)
    (queue n pot])

(queue
  [LAMBDA (n pot)                                            (* edited: " 2-Sep-86 16:06")
    (SETQ queuelist (CONS n queuelist))
    (if pot
	then (if (EQ CX pot)
		   then (outtrace n (inittbl (fetch (node npot) of n)))
		 else (outtrace n pot])
)
(* * Stepping Functions)

(DEFINEQ

(stepsetup
  [LAMBDA NIL                                                (* edited: " 2-Sep-86 16:07")
    (SETQ numsteps (ADD1 numsteps))
    (SETQ warning NIL)
    (if elist
	then (SETQ elist (SETQ elast NIL))
	       [walknet (FUNCTION (LAMBDA (n)
			      (replace (node elink) of n with NIL)
			      (replace (node nlink) of n with NIL)
			      (replace (node xqueued) of n with NIL)
                                                             (* (replace (node stepcount) of n with 0) 
							     (replace (node changecount) of n with 0))
			      (xenque n]
      else (SETQ elist (SETQ elast NIL)))
    (for n in queuelist do (xenque n))
    (SETQ queuelist NIL])

(simstep
  [LAMBDA NIL                                                (* edited: "12-Sep-86 10:02")
    (PROG (ac n nevent eptr lastdx killdxs)
	    (SETQ killdxs doreques)
	    (SETQ lastdx NIL)

          (* * Enque VDD & GND 1st 3 steps)


	    (if (GREATERP 3 tracenumber)
		then (xenque VDDNode)
		       (xenque GNDNode))
	    (if (GREATERP tracenumber 0)
		then (PRINTOUT T "Simulation Step: " tracenumber T))
	    (SETQ tracenumber (ADD1 tracenumber))
	    (SETQ nevent 0)

          (* * Start through event list, doing calc for each node in turn)


	    (while (SETQ eptr elist)
	       do 

          (* * MOSSIMFns stuff deleted ......)


		    (SETQ nevent (ADD1 nevent))          (* Only place nevent incremented)

          (* * calculate new value & construct connection list for current node)


		    (SETQ clist (QUOTE end))
		    (SETQ ac (calcval eptr INIT)) 

          (* * if current node is an input, force its value)


		    (if (fetch (node input) of eptr)
			then (SETQ ac (fetch (node npot) of eptr)))

          (* * if new value indicates charge sharing, a second calculation is needed which takes into account the relative 
	  capacitances of the involved nodes.)


		    [if (EQ ac CSHARE)
			then (PROG ((cap 0)
					(hac 0)
					(lac 0)
					(xac 0))
				       (SETQ eptr clist)
				       (while (NEQ eptr (QUOTE end))
					  do (if (EQP 0 (SETQ cap (fetch (node ncap)
									     of eptr)))
						   then (SETQ ac CX)
							  (RETURN NIL))
					       (if (EQ (SETQ ac (fetch (node npot)
									 of eptr))
							   CHIGH)
						   then (SETQ hac (PLUS hac cap))
						 elseif (EQ ac CLOW)
						   then (SETQ lac (PLUS lac cap))
						 else (SETQ xac (PLUS xac cap)))
					       (SETQ eptr (fetch (node nlink) of eptr)))

          (* * for charge charing to work, ratio must be at least 3:1 in favor of majority carier.)


				       (SETQ ac (if (OR (EQP (PLUS lac xac)
								     0)
							      (GEQ (QUOTIENT hac
										 (PLUS lac xac))
								     3.0))
						      then CHIGH
						    elseif (OR (EQP (PLUS hac xac)
									  0)
								   (GEQ (QUOTIENT lac
										      (PLUS hac xac)
										      )
									  3.0))
						      then CLOW
						    else CX]

          (* * save away new value, enquing nodes affected by change (if any))


		    (SETQ eptr clist)
		    (while (NEQ eptr (QUOTE end))
		       do (if (AND (NEQ elist eptr)
					 (fetch (node input) of eptr))
				then (GO Lnextval))
			    (if (AND killdxs (ELTX dxarray ac))
				then (GO Lnextval))

          (* * follow source links)


			    [for tran in (fetch (node nsource) of eptr)
			       do (if [AND (EQ (gatetbl (fetch (trans type) of tran)
								  (fetch (node npot)
								     of (fetch (trans gate)
									     of tran)))
						       RESIST)
						 (NEQ (transtblresist (fetch (node npot)
									     of
									      (fetch (trans drain)
										 of tran))
									  ac)
							(fetch (node npot)
							   of (fetch (trans drain) of tran]
					then (enque (fetch (trans drain) of tran]

          (* * follow drain links)


			    [for tran in (fetch (node ndrain) of eptr)
			       do (if [AND (EQ (gatetbl (fetch (trans type) of tran)
								  (fetch (node npot)
								     of (fetch (trans gate)
									     of tran)))
						       RESIST)
						 (NEQ (transtblresist (fetch (node npot)
									     of
									      (fetch (trans source)
										 of tran))
									  ac)
							(fetch (node npot)
							   of (fetch (trans source) of tran]
					then (enque (fetch (trans source) of tran]

          (* * special checks)



          (* * no pchannel checks: (NEQ (gatetbl pchannel ac) (gatetbl pchannel (fetch (node npot) of eptr))))


			    [if (OR (NEQ (gatetbl nchannel ac)
					       (gatetbl nchannel (fetch (node npot) of eptr)))
					(fetch (node xqueued) of eptr))
				then (for tran in (fetch (node ngate) of eptr)
					  do               (* BREAK1 NIL T (check?) NIL)
					       (if (EQ (gatetbl (fetch (trans type)
									 of tran)
								      ac)
							   ON)
						   then (if (fetch (node input)
								   of (fetch (trans drain)
									   of tran))
							      then (enque (fetch (trans source)
										 of tran))
							    else (enque (fetch (trans drain)
									       of tran)))
						 else (chain (fetch (trans drain) of tran))
							(chain (fetch (trans source)
								    of tran]
			    (outtrace eptr ac)
			    (replace (node xqueued) of eptr with NIL) 

          (* if (AND (queued eptr) (NEQ eptr elist)) then (bind (n ← elist) while (AND n (fetch (node elink) of n)) do 
	  (if (EQ (fetch (node elink) of n) eptr) then (* PRINTOUT T "Removing " (fetch (node name) of eptr) T) 
	  (replace (node elink) of n with (fetch (node elink) of eptr)) (if (fetch (node elink) of eptr) then 
	  (replace (node elink) of eptr with NIL) else (SETQ elast n)) (SETQ n NIL) else (SETQ n (fetch 
	  (node elink) of n)))))



          (* * set next loop values)


			    Lnextval
			    (SETQ n (fetch (node nlink) of eptr))
			    (replace (node nlink) of eptr with NIL)
			    (SETQ eptr n))

          (* * Move on to the next event on the event list)


		    (SETQ eptr elist)
		    (if eptr
			then (SETQ elist (fetch (node elink) of eptr))
			       (replace (node elink) of eptr with NIL)
			       (replace (node xqueued) of eptr with NIL)
			       (if (AND killdxs (ELTX dxarray ac))
				   then (IF showreques
					      THEN (PRINTOUT log "Requeing: " (fetch
								 (node name) of eptr)
							       T))
					  (if (NOT lastdx)
					      then (SETQ lastdx eptr)
					    elseif (EQ eptr lastdx)
					      then (SETQ killdxs NIL))
					  (enque eptr)))
		    (if (EQ 0 (LOGAND nevent 377Q))
			then (BLOCK)))
	    (SETQ elast NIL)
	    (RETURN nevent])

(calcval
  [LAMBDA (n ac)                                             (* edited: " 5-Sep-86 23:20")
    (PROG (pot gate)                                       (* PRINTOUT T "Calc: " (fetch 
							     (node name) of n) " Clist: " clist T)

          (* if (FMEMB ac (QUOTE (1 4 10Q 11Q 12Q))) then (PRINTOUT log (fetch (node name) of n) " changed from " 
	  (ELT pottoatom (fetch (node npot) of n)) " to " (ELT pottoatom pot) T) (BREAK1 NIL T (calc) NIL))


	    (replace (node nlink) of n with clist)
	    (SETQ clist n)
	    [SETQ pot (if (fetch (node input) of n)
			    then (fetch (node npot) of n)
			  elseif (fetch (node pullup) of n)
			    then PU
			  elseif (fetch (node pulldown) of n)
			    then PD
			  else (inittbl (fetch (node npot) of n]
	    (SETQ ac (transtbl ON ac pot))
	    (if (AND (NEQ elist n)
			 (fetch (node input) of n))
		then (RETURN ac))
	    [for tran in (fetch (node nsource) of n)
	       do (if [AND (EQ [SETQ gate (gatetbl (fetch (trans type) of tran)
							       (fetch (node npot)
								  of (fetch (trans gate)
									  of tran]
				       ON)
				 (NOT (fetch (node nlink) of (fetch (trans drain)
								      of tran]
			then (SETQ ac (calcval (fetch (trans drain) of tran)
						     ac))
		      elseif (EQ gate RESIST)
			then (SETQ ac (transtblresist ac (fetch (node npot)
								  of (fetch (trans drain)
									  of tran]
	    [for tran in (fetch (node ndrain) of n)
	       do (if [AND (EQ [SETQ gate (gatetbl (fetch (trans type) of tran)
							       (fetch (node npot)
								  of (fetch (trans gate)
									  of tran]
				       ON)
				 (NOT (fetch (node nlink) of (fetch (trans source)
								      of tran]
			then (SETQ ac (calcval (fetch (trans source) of tran)
						     ac))
		      elseif (EQ gate RESIST)
			then (SETQ ac (transtblresist ac (fetch (node npot)
								  of (fetch (trans source)
									  of tran]

          (* if (FMEMB ac (QUOTE (1 4 10Q 11Q 12Q))) then (PRINTOUT log (fetch (node name) of n) " changed from " 
	  (ELT pottoatom (fetch (node npot) of n)) " to " (ELT pottoatom pot) T) (BREAK1 NIL T (calc) NIL))


	    (RETURN ac])
)
(* * Walknet functions)

(DEFINEQ

(walknet
  [LAMBDA (func names)                                       (* edited: " 5-Sep-86 21:59")
    (if names
	then
	 [PROG (node name)
	         (for i in names
		    do (if (SETQ node (findnode i))
			     then (APPLY* func node)
			   else (for j from 47Q to 0 by -1
				     when
				      (SETQ node
					(if [NOT (SETQ node
						       (findnode (PACK
								     (APPEND (UNPACK i)
									       (LIST (QUOTE
											 -)
										       j]
					    then [findnode (PACK (APPEND (UNPACK i)
										 (LIST j]
					  else node))
				     do (APPLY* func node]
      else (MAPHASH nethash func)
	     (for i from nodemax to 1 by -1 do (if (ELTX netarray i)
							     then (APPLY* func (ELTX netarray i]
)

(clearlinks
  [LAMBDA (n)                                                (* rtk "12-Aug-86 09:36")
    (PROG ((sources (fetch (node nsource) of n))
	     (drain (fetch (node ndrain) of n))
	     (gate (fetch (node ngate) of n)))
	    (replace (node nsource) of n with NIL)
	    (replace (node ndrain) of n with NIL)
	    (replace (node ngate) of n with NIL)
	    (replace (node elink) of n with NIL)
	    (replace (node nlink) of n with NIL)
	    (cleartran sources)
	    (cleartran drain)
	    (cleartran gate])

(cleartran
  [LAMBDA (tran)                                             (* rtk "17-Jul-86 11:43")
    (for i in tran
       do (replace (trans source) of i with NIL)
	    (replace (trans drain) of i with NIL)
	    (replace (trans gate) of i with NIL])

(clearnet
  [LAMBDA NIL                                                (* rtk "25-Aug-86 11:11")
    (walknet (QUOTE clearlinks))
    (CLRHASH nethash])

(clearinputs
  [LAMBDA NIL                                                (* rtk "25-Aug-86 11:14")
    [walknet (FUNCTION (LAMBDA (n name)
		   (replace (node input) of n with NIL]
    (replace (node input) of VDDNode with T)
    (replace (node input) of GNDNode with T])
)
(* * chaining functions)

(DEFINEQ

(queued
  [LAMBDA (m)                                                (* rtk "19-Jun-86 15:23")
    (OR (fetch (node elink) of m)
	  (EQ elast m])

(xenque
  [LAMBDA (m)                                                (* rtk "27-Jun-86 10:27")
    (if (NOT (queued m))
	then (replace (node xqueued) of m with T)
	       (SETQ elast (if elast
				 then (replace (node elink) of elast with m)
					m
			       else (SETQ elist m])

(enque
  [LAMBDA (m)                                                (* rtk "27-Jun-86 10:27")
    (if (NOT (OR (queued m)
		       (fetch (node input) of m)))
	then (SETQ elast (if elast
				 then (replace (node elink) of elast with m)
					m
			       else (SETQ elist m])

(chain
  [LAMBDA (n)                                                (* edited: "26-Aug-86 10:25")
    (PROG (t newpot)                                       (* BREAK1 NIL T (chain) NIL)
	    (if (NOT (fetch (node input) of n))
		then (SETQ newpot (inittbl (fetch (node npot) of n)))
		       (outtrace n newpot)
		       (enque n)
		       [for tran in (fetch (node nsource) of n)
			  do (if [AND (NEQ (gatetbl (fetch (trans type) of tran)
							      (fetch (node npot)
								 of (fetch (trans gate)
									 of tran)))
						   OFF)
					    (NOT (queued (fetch (trans drain) of tran]
				   then (chain (fetch (trans drain) of tran]
		       (for tran in (fetch (node ndrain) of n)
			  do (if [AND (NEQ (gatetbl (fetch (trans type) of tran)
							      (fetch (node npot)
								 of (fetch (trans gate)
									 of tran)))
						   OFF)
					    (NOT (queued (fetch (trans source) of tran]
				   then (chain (fetch (trans source) of tran])
)
(* * Initializations & Setup)

(DEFINEQ

(initsim
  [LAMBDA NIL                                                (* edited: "12-Sep-86 15:50")
    (if (BOUNDP (QUOTE nethash))
	then (clearnet)
      else (SETQ nethash (HASHARRAY 10000)))
    (SETQ netarray (ARRAY 25000 (QUOTE POINTER)
			      NIL 0))
    (SETQ BreakOnAll NIL)
    (SETQ nodecount 0)
    (SETQ nodeoffset 0)
    (SETQ nodemax 0)
    (SETQ Cycles 100)
    (SETQ ResetCycle 0)
    (SETQ numsteps 0)
    (SETQ nion 0)
    (SETQ trancount 0)
    (SETQ tindex 0)
    (SETQ tracenumber 0)
    (SETQ tracelist NIL)
    (SETQ warning NIL)
    (SETQ queuelist NIL)
    (SETQ elast NIL)
    (SETQ elist NIL)
    (SETQ nodenames NIL)
    (SETQ includetemps NIL)
    (SETQ warningdisplay NIL)
    (SETQ nodemaplist NIL)
    (SETQ errortracefile NIL)
    (SETQ recordchanges NIL)
    (SETQ log T)
    (SETQ doreques T)
    (SETQ showdxs T)
    (SETQ showreques T)
    (SETQ ErrorCycles 0)
    (SETQ ErrorCount 0)
    (SETQ VDDNode (getnode (QUOTE VDD)))
    (SETQ GNDNode (getnode (QUOTE GND)))
    (replace (node npot) of VDDNode with DHIGH)
    (replace (node input) of VDDNode with T)
    (replace (node npot) of GNDNode with DLOW)
    (replace (node input) of GNDNode with T)
    (maketransarray)
    (makedxarray)
    (makegatearray)
    (makeinitarray)
    (makepotto01array)
    (make01topotarray)
    (makepottoatomarray)
    (RECLAIM])

(maketransarray
  [LAMBDA NIL                                                (* edited: "26-Aug-86 10:26")
    (PROG ((a1 (ARRAY (TIMES 3 (TIMES 14Q 14Q))
			  (QUOTE POINTER)
			  NIL 0)))
	    [for indexi from 0 as i in transtbllist
	       do (for indexj from 0 as j in i
		       do (for indexk from 0 as k in j
			       do (SETA a1 (IPLUS (ITIMES indexi 220Q)
							(ITIMES indexj 14Q)
							indexk)
					    (GETTOPVAL k]
	    (SETQ transtblarray a1])

(makegatearray
  [LAMBDA NIL                                                (* edited: "26-Aug-86 10:27")

          (* * turn into pot x state (OFF ON) to do shift left by 1 for gate state indexing)


    (PROG ((a1 (ARRAY 30Q (QUOTE POINTER)
			  NIL 0)))
	    [for indexi from 0 as i in gatetbllist
	       do (for indexj from 0 as j in i do (SETA a1 (IPLUS (LLSH indexj 1)
										  indexi)
								      (GETTOPVAL j]
	    (SETQ gatetblarray a1])

(makeinitarray
  [LAMBDA NIL                                                (* edited: "26-Aug-86 10:27")
    (PROG ((a1 (ARRAY 14Q (QUOTE POINTER)
			  NIL 0))
	     a2 a3)
	    (for indexi from 0 as i in inittbllist do (SETA a1 indexi (GETTOPVAL i)))
	    (SETQ inittblarray a1])

(makepotto01array
  [LAMBDA NIL                                                (* edited: "26-Aug-86 10:27")
    (PROG ((a1 (ARRAY 14Q (QUOTE POINTER)
			  NIL 0)))
	    (for i in potto01list do (SETA a1 (EVAL (CAR i))
						   (CADR i)))
	    (SETQ potto01array a1])

(makepottoatomarray
  [LAMBDA NIL                                                (* edited: "26-Aug-86 10:38")
    (SETQ pottoatom (ARRAY 14Q (QUOTE POINTER)
			       NIL 0))
    (for i in potto01list do (SETA pottoatom (EVAL (CAR i))
					   (CAR i])

(make01topotarray
  [LAMBDA NIL                                                (* edited: " 2-Sep-86 16:29")
    (PROG ((a1 (ARRAY 3 (QUOTE POINTER)
			  NIL 0)))
	    (for index from 0 as i in 01topotlist do (SETA a1 index i))
	    (SETA a1 0 DLOW)
	    (SETA a1 1 DHIGH)
	    (SETA a1 2 CX)
	    (SETQ 01topotarray a1])

(makedxarray
  [LAMBDA NIL                                                (* edited: " 8-Sep-86 18:37")
    (PROG ((a1 (ARRAY 14Q (QUOTE POINTER)
			  NIL 0)))
	    [for i from 0 to 13Q do do (SETA a1 i (FMEMB i
								       (LIST DX CX DXLOW DXHIGH 
									       CSHARE]
	    (SETQ dxarray a1])
)
(* * Service functions)

(DEFINEQ

(outtrace
  [LAMBDA (n pot)                                            (* edited: "12-Sep-86 10:00")
    (PROG NIL
	    (SETQ lastdx NIL)
	    (if (EQ (fetch (node npot) of n)
			pot)
		then 

          (* if (OR (EQ tracelist (QUOTE ALL)) (FMEMB (fetch (node name) of n) tracelist)) then (PRINTOUT log 
	  (fetch (node name) of n) " changed from " (fetch (node npot) of n) " to " pot T))


		       (RETURN NIL))

          (* (if (AND warningdisplay (EQ (fetch (node stepcount) of n) tracenumber) (NEQ newv oldv)) then 
	  (printout log "*** Node " (fetch (node name) of n) " changed more than once " (fetch (node lastpot) of n) " to " 
	  (fetch (node npot) of n) " to " pot T)) (replace (node changecount) of n with (ADD1 (fetch 
	  (node changecount) of n) (if (NEQ newv oldv) then (replace (node stepcount) of n with tracenumber)))))


	    (if [AND showdxs (FMEMB pot (QUOTE (1 4 10Q 11Q 12Q]
		then (PRINTOUT log (fetch (node name) of n)
				 " changed from "
				 (ELT pottoatom (fetch (node npot) of n))
				 " to "
				 (ELT pottoatom pot)
				 T)                          (* BREAK1 NIL T (help) NIL)
		       )
	    (if (OR (EQ tracelist (QUOTE ALL))
			(FMEMB (fetch (node name) of n)
				 tracelist))
		then (PRINTOUT log (fetch (node name) of n)
				 " changed from "
				 (ELT pottoatom (fetch (node npot) of n))
				 " to "
				 (ELT pottoatom pot)
				 T))                         (* replace (node lastpot) of n with 
							     (fetch (node npot) of n))
	    (replace (node npot) of n with pot])

(transtbl
  [LAMBDA (gatestate spot dpot)                              (* edited: "26-Aug-86 10:31")
    (ELT transtblarray (IPLUS (ITIMES gatestate 220Q)
				  (ITIMES spot 14Q)
				  dpot])

(transtblresist
  [LAMBDA (spot dpot)                                        (* edited: "26-Aug-86 10:31")
    (transtbl RESIST spot dpot])

(gatetbl
  [LAMBDA (trantype potential)                               (* edited: "26-Aug-86 10:32")
    (ELT gatetblarray (IPLUS (LLSH potential 1)
				 trantype])

(inittbl
  [LAMBDA (pot)                                              (* edited: "26-Aug-86 10:32")
    (ELT inittblarray pot])

(ELTX
  [LAMBDA (array index)                                      (* edited: "25-Aug-86 18:16")
                                                             (* ELT array index)
    (\GETBASEPTR (\GETBASEPTR array 0)
		   (LLSH index 1])
)
(* * Macros)

(DECLARE: EVAL@COMPILE 
[DEFMACRO transtbl (gatestate spot dpot)
	  (BQUOTE (ELTX transtblarray (IPLUS (ITIMES (\, gatestate)
						     220Q)
					     (ITIMES (\, spot)
						     14Q)
					     (\, dpot]
[DEFMACRO transtblresist (spot dpot)
	  (BQUOTE (transtbl RESIST (\, spot)
			    (\, dpot]
[DEFMACRO gatetbl (trantype potential)
	  (BQUOTE (ELTX gatetblarray (IPLUS (LLSH (\, potential)
						  1)
					    (\, trantype]
[DEFMACRO inittbl (pot)
	  (BQUOTE (ELTX inittblarray (\, pot]
[DEFMACRO ELTX (array index)
	  (BQUOTE (ELT (\, array)
		       (\, index)))
	  (BQUOTE (\GETBASEPTR (\GETBASEPTR (\, array)
					    0)
			       (LLSH (\, index)
				     1]
[DEFMACRO queued m (BQUOTE (OR (fetch (node elink)
				      of \, m)
			       (EQ elast \, m]
)
(PUTPROPS SIM COPYRIGHT ("Xerox Corporation" 3702Q))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (20000Q 32567Q (steps 20012Q . 20404Q) (etrans 20406Q . 20772Q) (dtrans 20774Q . 21356Q)
 (setinputh 21360Q . 21625Q) (setinputl 21627Q . 22073Q) (setinputx 22075Q . 22337Q) (setnode 22341Q
 . 23622Q) (getfile 23624Q . 31141Q) (queueall 31143Q . 31343Q) (setall 31345Q . 32206Q) (qnode 32210Q
 . 32565Q)) (32641Q 47141Q (newtransstring 32653Q . 42055Q) (setinputstring 42057Q . 43156Q) (getnode 
43160Q . 44367Q) (findnode 44371Q . 45445Q) (setin 45447Q . 46153Q) (clrin 46155Q . 46442Q) (queue 
46444Q . 47137Q)) (47201Q 73220Q (stepsetup 47213Q . 50651Q) (simstep 50653Q . 66170Q) (calcval 66172Q
 . 73216Q)) (73257Q 77755Q (walknet 73271Q . 75124Q) (clearlinks 75126Q . 76302Q) (cleartran 76304Q . 
76767Q) (clearnet 76771Q . 77245Q) (clearinputs 77247Q . 77753Q)) (100015Q 104044Q (queued 100027Q . 
100300Q) (xenque 100302Q . 101035Q) (enque 101037Q . 101564Q) (chain 101566Q . 104042Q)) (104111Q 
114651Q (initsim 104123Q . 107253Q) (maketransarray 107255Q . 110351Q) (makegatearray 110353Q . 
111404Q) (makeinitarray 111406Q . 112123Q) (makepotto01array 112125Q . 112624Q) (makepottoatomarray 
112626Q . 113302Q) (make01topotarray 113304Q . 114101Q) (makedxarray 114103Q . 114647Q)) (114710Q 
122072Q (outtrace 114722Q . 120171Q) (transtbl 120173Q . 120522Q) (transtblresist 120524Q . 120753Q) (
gatetbl 120755Q . 121244Q) (inittbl 121246Q . 121461Q) (ELTX 121463Q . 122070Q)))))
STOP