-- SimNsim.mesa
-- last edited by Suzuki: December 16, 1981 2:59 PM
DIRECTORY
ComParse,
InlineDefs,
IODefs USING [CR, Rubout, TAB],
MOSSIMFns USING [UnderJaM],
SimStep,
SimStorage,
SimTsim,
SimTTable,
stdio,
StdioImpl,
StreamDefs,
StringDefs,
SystemDefs,
TimeDefs,
WF,
WFRealImpl;
SimNsim: PROGRAM
IMPORTS ComParse, InlineDefs, IODefs, MOSSIMFns, SimStep, SimStorage, SimTsim, SimTTable, stdio, StdioImpl, StreamDefs, StringDefs, SystemDefs, TimeDefs, WF, WFRealImpl
EXPORTS MOSSIMFns, SimTsim = { OPEN SimStep, stdio, WF;
-- #include "tsim.h"
-- event driven mosfet simulator. Chris Terman (2/80)
HASHSIZE: CARDINAL = 731;
MAXBITS: CARDINAL = 50;
-- electrical parameters used for deriving capacitance info for charge sharing
--NSIL-II numbers J. Cherry
CAPMA: REAL = 3.2e-9; -- metal capacitance, pf/sq-centimicron
CAPPA: REAL = 4e-9; -- poly capacitance, pf/sq-centimicron
CAPDA: REAL = 9.6e-9; -- diffusion capacitance, pf/sq-centimicron
CAPDP: REAL = 2.4e-6; -- diffusion perimeter capacitance, pf/centimicron
CAPGA: REAL = 30e-9; -- gate capacitance, pf/sq-centimicron
LAMBDA: REAL = 2.5; -- microns/lambda
LAMBDA2: REAL = LAMBDA*LAMBDA;
LSIZE: CARDINAL = 500;
NFREE: CARDINAL = 2048;
wlist: SimTsim.wptr ← NIL;
bptr: TYPE = POINTER TO Bits;
Bits: TYPE = RECORD[
bnext: bptr, -- next bit vector in chain
bnbits: CARDINAL, -- number of bits in this vector
bbits: ARRAY [0..MAXBITS) OF SimTsim.nptr, -- pointers to the bits (nodes)
bname: STRING -- name of this vector of bits
];
LINELENGTH: CARDINAL = 80; -- line length by CMB
GNDNode: PUBLIC SimTsim.nptr;
VDDNode,PHI1Node,PHI2Node: SimTsim.nptr;
debug: PUBLIC INTEGER ← 0; -- <>0 if debugging
curpos: INTEGER ← 0; -- current output column number
ntrans: CARDINAL ← 0; -- number of transistors
nion: INTEGER ← 0; -- number of depletion mode transistors
nindex: INTEGER ← 0; -- index for nodeArray
tindex: INTEGER ← 0; -- index for transArray
blist: bptr ← NIL; -- list of watched bit arrays
hinputs: PUBLIC ARRAY [0..SimTsim.NINPUTS) OF SimTsim.nptr; -- list of nodes to be driven high
nhinputs: PUBLIC INTEGER ← 0; -- number of entries in hinputs
linputs: PUBLIC ARRAY [0..SimTsim.NINPUTS) OF SimTsim.nptr; -- list of nodes to be driven low
nlinputs: PUBLIC INTEGER ← 0; -- number of entries in linputs
xinputs: PUBLIC ARRAY [0..SimTsim.NINPUTS) OF SimTsim.nptr; -- list of nodes just removed from input lists
nxinputs: PUBLIC INTEGER ← 0; -- number of entries in xinputs
lineno: INTEGER ← 0; -- current line number
targv: PUBLIC ARRAY [0..SimTsim.MaxTargv) OF STRING; -- pointer to tokens on current command line
targc: PUBLIC CARDINAL ← 0; -- number of args on current command line
number: STRING ← [50]; -- Declared static in pnode
filename: STRING; -- current input file
outfile: PUBLIC FILE; -- current output file
sfile: FILE; -- current state file
nfree: INTEGER ← 0; -- number of bytes of free storage remaining
hash: POINTER TO ARRAY [0..HASHSIZE) OF SimTsim.nptr ← @hashBody;
hashBody: ARRAY [0..HASHSIZE) OF SimTsim.nptr;
uhash: POINTER TO ARRAY [0..HASHSIZE) OF SimTsim.uptr ← @uhashBody;
uhashBody: ARRAY [0..HASHSIZE) OF SimTsim.uptr;
-- JaM communication
JaMResult: STRING;
JaMError: PUBLIC STRING;
-- MOSSIM.log
log: PUBLIC StreamDefs.DiskHandle ← NIL;
traceNumber: PUBLIC CARDINAL ← 0;
-- Procedures
hashcode: PROC[name: STRING] RETURNS [CARDINAL] =
INLINE { i: CARDINAL ← 0;
j: CARDINAL;
char: CHARACTER;
FOR j IN [0..name.length) DO
char ← name[j];
i ← InlineDefs.BITSHIFT[i,4] +
(IF 141C<=char THEN (char - 120C) ELSE (char - '0));
ENDLOOP;
RETURN[i MOD HASHSIZE];
};
find: PROC[name: STRING] RETURNS[SimTsim.nptr] =
{ ntemp: SimTsim.nptr;
num: CARDINAL ← numberp[name];
FOR ntemp ← hash[hashcode[name]], ntemp.hnext WHILE ntemp#NIL DO
IF NOT ntemp.named
THEN IF num=LOOPHOLE[ntemp.nname, CARDINAL] THEN RETURN[ntemp]
ELSE LOOP
ELSE IF StringDefs.EquivalentString[name, ntemp.nname]
THEN RETURN[ntemp];
ENDLOOP;
RETURN[NIL];
};
ufind: PROC[name: STRING] RETURNS [SimTsim.nptr] =
{ utemp: SimTsim.uptr;
FOR utemp ← uhash[hashcode[name]], utemp.unext WHILE utemp#NIL DO
IF StringDefs.EquivalentString[name, utemp.uname] THEN RETURN[utemp.unode];
ENDLOOP;
RETURN[find[name]];
};
-- visit each node in network, calling function passed as arg with current node
walkNet: PUBLIC PROC[func: PROC[SimTsim.nptr] RETURNS[CARDINAL]] RETURNS[CARDINAL] =
{ index: INTEGER;
n: SimTsim.nptr;
total: CARDINAL ← 0;
FOR index ← 0, index+1 WHILE index<HASHSIZE DO
FOR n ← hash[index], n.hnext UNTIL n=NIL DO
total ← total+func[n]
ENDLOOP;
ENDLOOP;
RETURN[total];
};
-- see if asciz string is an integer if so, return it; otherwise return 0
numberp: PROC[s: STRING] RETURNS [CARDINAL] =
{ num: CARDINAL ← 0;
c, i, temp: CARDINAL;
FOR i IN [0..s.length) DO
IF (c ← s[i] - '0) IN [0..9] THEN {
temp ← num*10 + c;
IF temp<num THEN RETURN[0]
ELSE num ← temp}
ELSE RETURN[0]
ENDLOOP;
RETURN[num];
};
-- get node structure flag<>0 if ok to create new one
getnode: PROC [p: STRING] RETURNS [SimTsim.nptr] =
{ n: SimTsim.nptr;
f: INTEGER;
IF (n ← find[p])#NIL THEN RETURN[n];
-- allocate new node from free storage
n ← SimStorage.AllocateNode[];
nindex ← nindex + 1;
-- initialize node entries
n.ngate ← n.nsource ← n.ndrain ← NIL;
n.nlink ← NIL;
n.ncap ← 0.0;
n.marked ← n.xqueued ← n.named ← n.pullup ← n.input ← n.watched ← n.traced←n.warned ← FALSE;
n.npot ← CX;
n.changecount ← 0;
n.stepcount ← 0;
n.fpot ← NotFX;
n.elink ← NIL;
n.ndef ← n.nfuns ← NIL;
f ← hashcode[p];
n.hnext ← hash[f];
hash[f] ← n;
-- if node name is just a number, store it as such
IF (f ← numberp[p])#0 THEN {
n.nname ← LOOPHOLE[f, STRING];
n.named ← FALSE }
ELSE {
n.nname ← SystemDefs.AllocateHeapString[p.length]; -- Released by the main
StringDefs.AppendString[n.nname, p];
n.named ← TRUE;
};
RETURN[n];
};
-- return pointer to asciz name of node
pnode: PUBLIC PROC[n: SimTsim.nptr] RETURNS [STRING] =
{ liPrint: CARDINAL ← LOOPHOLE[n.nname, CARDINAL];
IF n.named THEN RETURN[n.nname];
number.length ← 0;
SWF1[number,"%u"L,liPrint];
RETURN[number];
};
-- node area and perimeter info
nodeInfoString: PUBLIC PROC =
{ n: SimTsim.nptr;
JaMError.length ← JaMResult.length ← 0;
IF targc # 8 THEN {error2String["Bad node record"L, "*n"L]; RETURN};
n ← getnode[targv[1]];
n.ncap ← n.ncap + atof[targv[4]] * (CAPMA*LAMBDA2) +
atof[targv[5]] * (CAPPA*LAMBDA2) +
atof[targv[6]] * (CAPDA*LAMBDA2) +
atof[targv[7]] * 2.0 * (CAPDP*LAMBDA2);
n.xpos ← atof[targv[2]];
n.ypos ← atof[targv[3]];
};
potential: PUBLIC ARRAY SimTsim.Potential OF STRING ← [
"initial",
"driven unknown",
"driven high",
"driven low",
"charged unknown",
"charged high",
"charged low",
"pulled up",
"unknown-low",
"unknown-high",
"shared charge"
];
newtransString: PROC[flag: CARDINAL] =
-- flag=0 => enhancement mode transistor. flag=1 => depletion...
{ node1,node2,node3,ntemp: SimTsim.nptr;
capacitance,resistance: REAL;
t: SimTsim.tptr;
ntrans ← ntrans+1; -- the only place ntrans is increased
IF ntrans MOD 100 = 0 THEN {
IF ntrans MOD 1000 = 0 THEN {
IF ntrans MOD 10000 = 0 THEN WF.WF1["%u"L, ntrans]
ELSE putc['!, outfile]}
ELSE putc['., outfile]};
JaMError.length ← JaMResult.length ← 0;
IF (targc<4 OR targc>10) THEN {
error2String["Bad transistor record"L,"*n"L]; RETURN};
node1 ← getnode[targv[1]];
node2 ← getnode[targv[2]];
node3 ← getnode[targv[3]];
IF targc = 8 THEN {
capacitance ← atof[targv[6]]*atof[targv[7]] * (CAPGA*LAMBDA2);
-- #ifdef TIMING
-- resistance ← (atof[targv[4]]/atof[targv[5]]) * RESG;
-- #endif
} ELSE {
capacitance ← 0.0;
resistance ← 0.01;
};
IF (node2=VDDNode OR node2=GNDNode) THEN
{ ntemp ← node2; node2 ← node3; node3 ← ntemp; };
IF flag#0 AND (node3 = VDDNode) THEN {
node2.pullup ← TRUE;
node2.ncap ← node2.ncap + capacitance;
nion ← nion+1;
RETURN;
};
-- allocate new transistor from free storage
t ← SimStorage.AllocateTrans[];
tindex ← tindex + 1;
IF flag#0 THEN { -- yellow transistor
node1.ncap ← node1.ncap + capacitance;
node1 ← VDDNode;
};
t.gate ← node1;
t.glink ← node1.ngate; node1.ngate ← t;
t.source ← node2;
t.slink ← node2.nsource; node2.nsource ←t;
t.drain ← node3;
t.dlink ← node3.ndrain; node3.ndrain ← t;
node1.ncap ← node1.ncap + capacitance;
};
intvalue: ARRAY SimTsim.Potential OF INTEGER = [ 4, 2, 1, 0, 2, 1, 0, 1, 2, 2, 3 ];
pNode: PROC[name: STRING, n:SimTsim.nptr] =
{ IF NOT n.watched THEN RETURN;
curpos ← curpos + name.length + 2 + (IF debug#0 THEN potential[n.npot].length ELSE 1);
IF curpos > LINELENGTH THEN {
curpos ← name.length + 2 + (IF debug#0 THEN potential[n.npot].length ELSE 1);
FWF0[outfile,"*n"L];
};
IF debug=0 THEN FWF2[outfile,"%s=%c "L, name, SimTsim.pchars[n.npot]]
ELSE FWF2[outfile,"%s=%s "L, name, potential[n.npot]];
};
pnlist: PROC =
{ b: bptr ← blist;
w: SimTsim.wptr;
ch: CHARACTER;
f,vok: CARDINAL;
val: InlineDefs.LongNumber;
WHILE b#NIL DO
FWF1[outfile,"%s="L,b.bname];
val.lc ← 0;
vok ← 1;
FOR f IN [0..b.bnbits) DO
ch ← SimTsim.pchars[b.bbits[f].npot];
FWF1[outfile,"%c"L,ch];
val.highbits ← InlineDefs.BITSHIFT[val.highbits, 1];
IF LOOPHOLE[val.lowbits, INTEGER]<0 THEN
val.highbits ← InlineDefs.BITOR[val.highbits, 1];
val.lowbits ← InlineDefs.BITSHIFT[val.lowbits, 1];
IF (ch = '1)
THEN val.lowbits ← InlineDefs.BITOR[val.lowbits,1]
ELSE IF (ch = 'X) THEN vok ← 0;
ENDLOOP;
IF (vok) # 0 THEN FWF1[outfile,"*t%lu"L,@(val.lc)];
FWF0[outfile,"*n"L];
b ← b.bnext;
ENDLOOP;
curpos ← 0;
FOR w ← wlist, w.wnext UNTIL w=NIL DO
pNode[w.wname,ufind[w.wname]]
ENDLOOP;
IF (curpos # 0) THEN FWF0[outfile,"*n"L];
fflush[outfile];
};
vectorValue: PUBLIC PROC[] RETURNS [STRING] = {
b: bptr ← blist;
ch: CHARACTER;
f: CARDINAL;
name: STRING ← targv[1];
JaMResult.length ← JaMError.length ← 0;
FOR b ← blist, b.bnext UNTIL b=NIL DO
IF StringDefs.EquivalentString[b.bname, name] THEN
{FOR f ← 0, f+1 UNTIL f>=b.bnbits DO
ch ← SimTsim.pchars[b.bbits[f].npot];
JaMResult[f] ← ch;
REPEAT
FINISHED => JaMResult.length ← f;
ENDLOOP;
EXIT};
REPEAT
FINISHED => {SWF1[JaMError, "This name is undefined: %s"L, name]};
ENDLOOP;
RETURN[JaMResult]};
putVectorValue: PUBLIC PROC[arg: LONG INTEGER] = {
b: bptr ← blist;
f: CARDINAL;
name: STRING ← targv[1];
JaMResult.length ← JaMError.length ← 0;
FOR b ← blist, b.bnext UNTIL b=NIL DO
IF StringDefs.EquivalentString[b.bname, name] THEN {
THROUGH [0..MAXBITS-b.bnbits) DO arg ← arg*2 ENDLOOP;
FOR f ← 0, f+1 UNTIL f>=b.bnbits DO
setin[b.bbits[f], IF arg<0 THEN 'h ELSE 'l];
arg ← arg*2;
ENDLOOP;
};
REPEAT
FINISHED => {SWF1[JaMError, "This name is undefined: %s"L, name]};
ENDLOOP;
};
pvalue: PUBLIC PROC[n: SimTsim.nptr] =
{ IF debug=0 THEN FWF2[outfile,"%s=%c "L, pnode[n], SimTsim.pchars[n.npot]]
ELSE FWF2[outfile,"%s=%s "L,pnode[n], potential[n.npot]];
};
ptrans: PUBLIC PROC[t: SimTsim.tptr] =
{ FWF0[outfile,"trans "L];
pvalue[t.gate];
pvalue[t.source];
pvalue[t.drain];
FWF0[outfile,"*n"L];
};
idelete: PROC[n: SimTsim.nptr, list: POINTER TO ARRAY OF SimTsim.nptr, cnt: POINTER TO INTEGER] =
{ i:INTEGER ← cnt↑;
j, k: INTEGER;
FOR j IN [0..i) DO
IF list[j] = n THEN {
FOR k IN [j..i-1) DO
list[k] ← list[k+1]
ENDLOOP;
cnt↑ ← cnt↑ - 1;
RETURN;
};
ENDLOOP;
};
iinsert: PROC[n: SimTsim.nptr, list: POINTER TO ARRAY OF SimTsim.nptr, cnt: POINTER TO INTEGER] =
{ i: INTEGER ← cnt↑;
j:INTEGER;
FOR j IN [0..i) DO
IF list[j] = n THEN RETURN;
ENDLOOP;
IF (cnt↑ ← i + 1) > SimTsim.NINPUTS THEN
{ error2String["Too many inputs"L,"*n"L]; cnt↑ ← i; RETURN; };
list[i] ← n
};
setin: PROC[n: SimTsim.nptr, which: CHARACTER] =
{ idelete[n,LOOPHOLE[@hinputs, POINTER TO ARRAY OF SimTsim.nptr],@nhinputs];
idelete[n,LOOPHOLE[@linputs, POINTER TO ARRAY OF SimTsim.nptr],@nlinputs];
idelete[n,LOOPHOLE[@xinputs, POINTER TO ARRAY OF SimTsim.nptr],@nxinputs];
SELECT which FROM
'h => { iinsert[n,LOOPHOLE[@hinputs, POINTER TO ARRAY OF SimTsim.nptr],@nhinputs];
n.input ← TRUE};
'l => { iinsert[n,LOOPHOLE[@linputs, POINTER TO ARRAY OF SimTsim.nptr],@nlinputs];
n.input ← TRUE;};
'x => { iinsert[n,LOOPHOLE[@xinputs, POINTER TO ARRAY OF SimTsim.nptr],@nxinputs];
n.input ← FALSE};
ENDCASE;
};
setInputString: PROC[which: CHARACTER] =
{ n: SimTsim.nptr;
i:CARDINAL;
JaMError.length ← JaMResult.length ← 0;
FOR i IN [1..targc) DO
IF (n ← ufind[targv[i]])=NIL THEN
{ error3String["Cannot set input value"L,"%s*n"L,targv[i]]; LOOP; };
setin[n,which];
ENDLOOP;
};
setWatchString: PUBLIC PROC =
{ n: SimTsim.nptr;
p: STRING;
w: SimTsim.wptr;
i: CARDINAL;
flag:INTEGER;
JaMError.length ← JaMResult.length ← 0;
FOR i←1, i+1 WHILE i<targc DO
p ← targv[i];
IF p[0] = '- THEN { flag ← 1; StringShiftLeft[p, 1]; } ELSE flag ← 0;
IF (n ← ufind[p]) = NIL THEN
{ error3String["Cannot watch node"L,"%s*n"L,p]; LOOP; };
IF (flag)#0 THEN {
n.watched ← FALSE;
IF StringDefs.EquivalentString[p,wlist.wname] THEN wlist ← wlist.wnext
ELSE FOR w ← wlist, w.wnext WHILE w.wnext#NIL DO
IF StringDefs.EquivalentString[p,w.wnext.wname] THEN { w.wnext ← w.wnext.wnext; EXIT; }
ENDLOOP
} ELSE IF n.watched THEN LOOP
ELSE {
n.watched ← TRUE;
w ← SimStorage.AllocateWnode[];
w.wnext ← wlist;
wlist ← w;
w.wname ← SystemDefs.AllocateHeapString[p.length]; -- Released by main
StringDefs.AppendString[w.wname,p];
};
ENDLOOP;
FOR w ← wlist, w.wnext WHILE w#NIL DO
n ← ufind[w.wname];
n.watched ← TRUE;
ENDLOOP;
};
setBitsString: PUBLIC PROC =
{ n: SimTsim.nptr;
b: bptr;
i: CARDINAL;
JaMError.length ← JaMResult.length ← 0;
IF targc - 2>=MAXBITS THEN {
error2String["Too many bits to watch (%d)"L,targc - 2];
RETURN};
b ← SystemDefs.AllocateHeapNode[SIZE[Bits]]; -- Released by main
b.bnext ← blist;
blist ← b;
b.bnbits ← targc - 2;
b.bname ← SystemDefs.AllocateHeapString[targv[1].length]; -- Released by main
StringDefs.AppendString[b.bname, targv[1]];
FOR i IN [2..targc) DO
IF (n ← ufind[targv[i]]) = NIL THEN
{ error3String["Cannot watch node"L,"%s*n"L,targv[i]]; LOOP; };
b.bbits[i - 2] ← n;
ENDLOOP;
};
writeValue: PROC[n: SimTsim.nptr] RETURNS[CARDINAL] =
{ putc[LOOPHOLE[n.npot, CARDINAL] + 40C,sfile];
RETURN[0];
};
writeStateString: PUBLIC PROC =
{ JaMError.length ← JaMResult.length ← 0;
IF targc # 2 THEN {
error2String["No file specified for output"L,"*n"L];
RETURN;
};
IF (sfile ← fopen[targv[1],"w"L]) = NIL THEN {
error3String["Cannot open state file for output"L,"%s*n"L,targv[1]];
RETURN;
};
FWF1[sfile,"%d*n"L,nindex];
[] ← walkNet[writeValue];
extWrite[sfile];
fclose[sfile];
};
readValue: PROC[n: SimTsim.nptr] RETURNS[CARDINAL] =
{ ch: CHARACTER;
WHILE (ch ← getch[sfile]) < ' DO ENDLOOP;
n.npot ← LOOPHOLE[ch - ' , SimTsim.Potential];
RETURN[0];
};
readStateString: PUBLIC PROC =
{ rline: STRING ←[100];
JaMError.length ← JaMResult.length ← 0;
IF (targc # 2) THEN {
error2String["No file specified for input"L,"*n"L];
RETURN;
};
IF (sfile ← fopen[targv[1],"r"L]) = NIL THEN {
SWF1[JaMError,"Cannot open state file for input: %s*n"L,targv[1]];
RETURN;
};
[] ← fgets[rline,100,sfile];
rline.length ← rline.length - 1;
IF atoi[rline] # nindex THEN {
SWF1[JaMError,"State file has wrong number of nodes: %d*n"L,nindex];
RETURN;
};
[] ← walkNet[readValue];
extRead[sfile];
fclose[sfile];
};
infoResult: PUBLIC PROC[which: CARDINAL] =
{ n,m: SimTsim.nptr;
t: SimTsim.tptr;
p: LONG POINTER TO SimTsim.nptr;
realForPrint: REAL;
i: CARDINAL;
offset:LONG INTEGER ← LOOPHOLE[@n.changecount, LONG INTEGER] - 1 - LOOPHOLE[n, LONG INTEGER];
JaMError.length ← JaMResult.length ← 0;
FOR i ← 1, i + 1 WHILE i < targc DO
IF (n ← ufind[targv[i]]) = NIL THEN
{ error3String["Cannot find node"L,"%s*n"L,targv[i]]; LOOP; };
pvalue[n];
IF n.input THEN
FWF0[outfile,"[NOTE: node is an input] "L];
realForPrint ← n.ncap;
IF n.ncap # 0.0 THEN FWF1[outfile,"(capacitance = %f pf) "L,@realForPrint];
FWF1[outfile,"%s:*n"L,IF which#0 THEN "affects"L ELSE "is computed from"L];
IF which = 0 THEN {
IF (p ← LOOPHOLE[n.ndef, LONG POINTER TO SimTsim.nptr])#NIL THEN {
FWF0[outfile," (nor"L];
WHILE p↑ # NIL DO
FWF0[outfile,"*t(and "L];
DO
p ← p+2;
IF (m ← p↑) = NIL THEN EXIT;
pvalue[LOOPHOLE[LOOPHOLE[m, LONG INTEGER] - offset, SimTsim.nptr]];
ENDLOOP;
FWF0[outfile,")*n"L];
ENDLOOP;
FWF0[outfile," )*n"L];
} ELSE IF n.pullup THEN FWF0[outfile,"pulled up*n"L];
FOR t ← n.nsource, t.slink WHILE t#NIL DO
IF (t.drain = GNDNode) THEN {
FWF0[outfile,"pulled down by "L];
pvalue[t.gate];
FWF0[outfile,"*n"L];
} ELSE ptrans[t];
ENDLOOP;
FOR t←n.ndrain, t.dlink WHILE t#NIL
DO ptrans[t] ENDLOOP;
} ELSE FOR t←n.ngate, t.glink WHILE t#NIL DO ptrans[t] ENDLOOP;
ENDLOOP;
};
-- save user name(s) as pseudonym for node(s)
userNameString: PUBLIC PROC =
{ n: SimTsim.nptr;
utemp: SimTsim.uptr;
i:CARDINAL;
h:INTEGER;
JaMError.length ← JaMResult.length ← 0;
FOR i←1, i+2 WHILE i<targc DO
IF i+1 = targc THEN { error2String["Bad = syntax"L,"*n"L]; };
IF (n ← ufind[targv[i]]) = NIL THEN
{ error3String["cannot find node name in ="L,"%s*n"L,targv[i]]; LOOP; };
IF ufind[targv[i+1]] # NIL THEN
{ error3String["redefinition of user name"L,"%s*n"L,targv[i+1]]; LOOP; };
utemp ← SimStorage.AllocateUsymbol[];
h ← hashcode[targv[i+1]];
utemp.unext ← uhash[h];
uhash[h] ← utemp;
utemp.unode ← n;
utemp.uname ← SystemDefs.AllocateHeapString[targv[i+1].length]; -- Released by main
StringDefs.AppendString[utemp.uname,targv[i+1]];
ENDLOOP;
};
-- check that node(s) has specified value(s), return true if all results matched
checkVal: PROC RETURNS[INTEGER] =
{ n: SimTsim.nptr;
b: bptr;
i, f:CARDINAL;
FOR i IN [1..targc) DO
IF i+1 = targc THEN { error2String["Bad check syntax"L,"*n"L]; RETURN[1]; };
IF (n ← ufind[targv[i]])#NIL AND targv[i+1][1]=0C THEN {
IF SimTsim.pchars[n.npot] = targv[i+1][0] THEN LOOP;
error5String["Check mismatch"L,
"node %s: found %c, wanted %c*nReverting to tty input...*n"L,
pnode[n],SimTsim.pchars[n.npot],targv[i+1][0]];
RETURN[0];
};
FOR b←blist, b.bnext WHILE b#NIL DO
IF StringDefs.EquivalentString[targv[i],b.bname] THEN {
FOR f IN [0..b.bnbits) DO
IF SimTsim.pchars[b.bbits[f].npot] = targv[i+1][f] THEN LOOP;
error6String["Check mismatch"L,
"vector %s, bit %d: found %c, wanted %c*nReverting to tty input...*n"L,
b.bname,f,SimTsim.pchars[b.bbits[f].npot],targv[i+1][f]];
RETURN[0];
ENDLOOP;
EXIT;
};
ENDLOOP;
ENDLOOP;
RETURN[1];
};
resetChangeCount: PUBLIC PROC = {
index: CARDINAL;
n: SimTsim.nptr;
FOR index IN [0..HASHSIZE) DO
FOR n ← hash[index], n.hnext UNTIL n=NIL DO
n.changecount ← 0
ENDLOOP;
ENDLOOP;
};
Swap: PROC[left, right: CARDINAL, quick: DESCRIPTOR FOR ARRAY OF LONG POINTER] = {
temp: SimTsim.nptr ← quick[left];
quick[left] ← quick[right];
quick[right] ← temp
};
quickSort: PROC [left, right: CARDINAL, quick: DESCRIPTOR FOR ARRAY OF SimTsim.nptr] = {
comp: CARDINAL ← quick[left].changecount;
oldLeft: CARDINAL ← left;
oldRight: CARDINAL ← right;
-- scan right to left
DO
UNTIL left = right DO
IF quick[right].changecount < comp THEN EXIT;
right ← right - 1;
REPEAT
FINISHED => {
IF oldLeft + 1 < left THEN quickSort[oldLeft, left - 1, quick];
IF right + 1 < oldRight THEN quickSort[right + 1, oldRight, quick]; RETURN};
ENDLOOP;
Swap[left, right, quick];
left ← left + 1;
UNTIL left = right DO
IF quick[left].changecount > comp THEN EXIT;
left ← left + 1;
REPEAT
FINISHED => {
IF oldLeft + 1 < left THEN quickSort[oldLeft, left - 1, quick];
IF right + 1 < oldRight THEN quickSort[right + 1, oldRight, quick]; RETURN};
ENDLOOP;
Swap[left, right, quick];
right ← right - 1;
ENDLOOP;
};
sortNodes: PROC[quick: DESCRIPTOR FOR ARRAY OF SimTsim.nptr] = {
sub, index: CARDINAL;
n: SimTsim.nptr;
sub ← 0;
FOR index IN [0..HASHSIZE) DO
FOR n ← hash[index], n.hnext UNTIL n=NIL DO
quick[sub] ← n; sub ← sub + 1
ENDLOOP;
ENDLOOP;
quickSort[0, LENGTH[quick] - 1, quick];
};
PrintNode: PROC[node: SimTsim.nptr] = {
FWF1[log, "%s"L, pnode[node]]
};
PrintCount: PROC[num: CARDINAL] = {
FWF1[log, "%u: "L, num];
};
printNodes: PROC[quick: DESCRIPTOR FOR ARRAY OF SimTsim.nptr] = {
currentCount, index: CARDINAL;
currentCount ← quick[0].changecount;
PrintCount[currentCount];
PrintNode[quick[0]];
FOR index IN [1..LENGTH[quick]) DO
IF quick[index].changecount = currentCount THEN {
FWF0[log, ","L];
PrintNode[quick[index]]}
ELSE {
FWF0[log, ";*n"L];
currentCount ← quick[index].changecount;
PrintCount[currentCount];
PrintNode[quick[index]]}
ENDLOOP;
FWF0[log, ";*n"L];
};
nodeCount: PROC RETURNS[CARDINAL] = {
count, index: CARDINAL;
n: SimTsim.nptr;
count ← 0;
FOR index IN [0..HASHSIZE) DO
FOR n ← hash[index], n.hnext UNTIL n=NIL DO
count ← count + 1
ENDLOOP;
ENDLOOP;
RETURN[count];
};
displayChangedNodes: PUBLIC PROC = { OPEN StreamDefs;
date: STRING ← [30];
IF log = NIL THEN log ← StreamDefs.NewByteStream["MOSSIM.log"L,StreamDefs.Append];
SetPosition[log, IndexToPosition[FileLength[log]]];
FWF0[log, "*nStatistics of Nodes that Changed Potential*n"L];
TimeDefs.AppendDayTime[date,
TimeDefs.UnpackDT[TimeDefs.CurrentDayTime[]],];
FWF1[log, "%s*n*n"L, date];
BEGIN
quick: DESCRIPTOR FOR ARRAY OF SimTsim.nptr;
count: CARDINAL ← nodeCount[];
quick ← DESCRIPTOR[SystemDefs.AllocateHeapNode[count*2], count];
sortNodes[quick];
printNodes[quick];
SystemDefs.FreeHeapNode[BASE[quick]];
END;
log.destroy[log];
log ← NIL;
};
traceNodes: PUBLIC PROC = {
i: CARDINAL;
n: SimTsim.nptr;
IF log = NIL THEN log ← StreamDefs.NewByteStream["MOSSIM.log"L,StreamDefs.Append];
FOR i←1, i+1 WHILE i<targc DO
IF (n ← ufind[targv[i]]) = NIL THEN
{ error3String["Cannot trace node"L,"%s*n"L,targv[i]]; LOOP};
IF NOT n.traced THEN
{n.traced ← TRUE; traceNumber ← traceNumber+1};
ENDLOOP;
};
unTraceNodes: PUBLIC PROC = {
i: CARDINAL;
n: SimTsim.nptr;
FOR i←1, i+1 WHILE i<targc DO
IF (n ← ufind[targv[i]]) = NIL THEN
{ error3String["Cannot untrace node"L,"%s*n"L,targv[i]]; LOOP};
IF n.traced THEN
{n.traced ← FALSE; traceNumber ← traceNumber-1};
ENDLOOP;
};
error2String: PROC[a: STRING, b: UNSPECIFIED] =
{ SWF3[JaMError,"[%s,%d] %s: "L,filename,lineno,a];
SWF0[JaMError,b];
WF3["[%s,%d] %s: "L,filename,lineno,a];
WF0[b];
};
error3String: PROC[a: STRING,b,c: UNSPECIFIED] =
{ SWF3[JaMError,"[%s,%d] %s: "L,filename,lineno,a];
SWF1[JaMError,b,c];
WF3["[%s,%d] %s: "L,filename,lineno,a];
WF1[b,c];
};
error4String: PROC[a: STRING,b,c,d: UNSPECIFIED] =
{ SWF3[JaMError,"[%s,%d] %s: "L,filename,lineno,a];
SWF2[JaMError,b,c,d];
WF3["[%s,%d] %s: "L,filename,lineno,a];
WF2[b,c,d];
};
error5String: PROC[a: STRING,b,c,d,e: UNSPECIFIED] =
{ SWF3[JaMError,"[%s,%d] %s: "L,filename,lineno,a];
SWF3[JaMError,b,c,d,e];
WF3["[%s,%d] %s: "L,filename,lineno,a];
WF3[b,c,d,e];
};
error6String: PROC[a: STRING,b,c,d,e,f: UNSPECIFIED] =
{ SWF3[JaMError,"[%s,%d] %s: "L,filename,lineno,a];
SWF4[JaMError,b,c,d,e,f];
WF3["[%s,%d] %s: "L,filename,lineno,a];
WF4[b,c,d,e,f];
};
-- parse input line into tokens, filling up targv and setting targc
parseLine: PUBLIC PROC[line: STRING] =
{ pos: CARDINAL ← 0;
Get: PROC[s: STRING] RETURNS[STRING] = {
char: CHARACTER;
end, length: CARDINAL;
s.length ← length ← 0;
IF (end ← pos)>=line.length THEN RETURN[NIL];
DO
SELECT (char ← line[end]) FROM
' , IODefs.TAB, ', => EXIT;
IODefs.CR => IF end=0 THEN RETURN[NIL] ELSE EXIT;
ENDCASE => {s[length] ← char; end ← end + 1; length ← length + 1}
ENDLOOP;
s.length ← length;
pos ← end + 1;
RETURN[s]
};
FOR targc ← 0, targc + 1 UNTIL Get[targv[targc]]=NIL DO
ENDLOOP;
};
MOSSIMEnter: PUBLIC PROC = {
input[stdin];
CleanUp[]};
input: PROC[in: FILE] =
{
i, nsteps: CARDINAL;
line: STRING ← [LSIZE];
DO
IF in = stdin THEN FWF0[stderr,"sim> "L];
line.length ← 0;
IF fgets[line,LSIZE,in
!IODefs.Rubout => {IF in = stdin THEN FWF0[stderr,"*n"L]; LOOP}] # line THEN EXIT;
lineno ← lineno + 1; -- this is the only place lineno is increased
parseLine[line];
IF (targv[0] = NIL) THEN LOOP;
SELECT targv[0][0] FROM
'@ => readFileString[];
'D => Debug[];
'< => readStateString[];
'> => writeStateString[];
'| => NULL;
'e => eTrans[];
'd => dTrans[];
'N => nodeInfoString[];
'h, 'l , 'x => setInputString[targv[0][0]];
'= => userNameString[];
'w => setWatchString[];
'W => setBitsString[];
'v => viewString[];
'I => initialization[];
'c => IF targv[0][1] = 'h AND checkVal[]=0
THEN in ← stdin
ELSE {
IF (targc = 1) THEN i ← 1
ELSE { i ← atoi[targv[1]]; IF (i <= 0) THEN i ← 1; };
nsteps ← 0;
WHILE i#0 DO
i ← i-1;
setin[PHI1Node,'h];
setin[PHI2Node,'l];
nsteps ← nsteps + step[];
setin[PHI1Node,'l];
nsteps ← nsteps + step[];
setin[PHI2Node,'h];
nsteps ← nsteps + step[];
setin[PHI2Node,'l];
nsteps ← nsteps + step[];
ENDLOOP;
pnlist[];
FWF1[outfile,"cycle took %d events*n"L,nsteps];
};
's => {FWF1[outfile,"step took %d events*n"L,step[]];
pnlist[]
};
'i => NULL;
'? => infoResult[0];
'! => infoResult[1];
'X => SimTsim.extension[targc,@targv];
'q => RETURN;
ENDCASE => error3String["Unrecognized input line"L,"%s*n"L,line];
ENDLOOP; -- infinite loop
};
viewString: PROC = {
list: POINTER TO ARRAY OF SimTsim.nptr;
i: INTEGER;
JaMError.length ← 0;
pnlist[];
FWF0[outfile,"h inputs: "L];
list←LOOPHOLE[@hinputs, POINTER TO ARRAY OF SimTsim.nptr];
FOR i IN [0..nhinputs) DO
FWF1[outfile,"%s "L,pnode[list[i]]];
ENDLOOP;
FWF0[outfile,"*nl inputs: "L];
list←LOOPHOLE[@linputs, POINTER TO ARRAY OF SimTsim.nptr];
FOR i IN [0..nlinputs) DO
FWF1[outfile,"%s "L,pnode[list[i]]];
ENDLOOP;
FWF0[outfile,"*n"L];
};
readFileString: PUBLIC PROC = {
next: FILE;
ofname: STRING;
olineno: INTEGER;
AppendOptionalSuffix: PROC[name: STRING] RETURNS [STRING] = {
i: CARDINAL;
ret: STRING ← SystemDefs.AllocateHeapString[name.length+4];
FOR i←0, i+1 UNTIL i>=name.length DO
c: CHARACTER ← name[i];
StringDefs.AppendChar[ret, c];
IF c='. THEN GOTO DotFound;
REPEAT
DotFound => {
FOR i←i+1, i+1 UNTIL i>=name.length DO
StringDefs.AppendChar[ret, name[i]];
ENDLOOP};
FINISHED => StringDefs.AppendString[ret, ".sim"L];
ENDLOOP;
RETURN[ret]};
JaMError.length ← JaMResult.length ← 0;
IF targc # 2 THEN
error3String["wrong number of args to '@' command"L,"%d*n"L,targc]
ELSE {
simfile: STRING ← AppendOptionalSuffix[targv[1]]; -- this is storage-leak free
IF (next ← fopen[simfile,"r"L]) = NIL THEN
error3String["cannot open for input"L,"%s*n"L,simfile]
ELSE {
ofname ← filename; olineno ← lineno;
filename ← targv[1]; lineno ← 0;
input[next];
fclose[next];
filename ← ofname; lineno ← olineno};
SystemDefs.FreeHeapString[simfile]; -- this is checked
};
WF.WF0["*n"L]
};
Debug: PUBLIC PROC = { debug ← 1-debug };
eTrans: PUBLIC PROC = { newtransString[0] };
dTrans: PUBLIC PROC = { newtransString[1] };
setInputH: PUBLIC PROC = {setInputString['h]};
setInputL: PUBLIC PROC = {setInputString['l]};
setInputX: PUBLIC PROC = {setInputString['x]};
question: PUBLIC PROC = {infoResult[0]};
exclamation: PUBLIC PROC = {infoResult[1]};
getNodeValue: PUBLIC PROC RETURNS[INTEGER] = {
n: SimTsim.nptr ← ufind[targv[1]];
JaMError.length ← JaMResult.length ← 0;
IF n=NIL THEN error2String["This node is not defined"L, "*n"L];
RETURN[intvalue[n.npot]]};
initialization: PROC = {
FWF1[outfile,"initialization took %d steps*n"L,einit[]]};
initializationResult: PUBLIC PROC RETURNS[CARDINAL] = {
JaMError.length ← JaMResult.length ← 0;
RETURN[einit[]]};
cycleResult: PUBLIC PROC RETURNS[CARDINAL] = {
i, nsteps: CARDINAL;
JaMError.length ← JaMResult.length ← 0;
IF (targc = 1) THEN i ← 1
ELSE { i ← atoi[targv[1]]; IF (i <= 0) THEN i ← 1; };
nsteps ← 0;
WHILE i#0 DO
i ← i-1;
setin[PHI1Node,'h];
setin[PHI2Node,'l];
nsteps ← nsteps + step[];
setin[PHI1Node,'l];
nsteps ← nsteps + step[];
setin[PHI2Node,'h];
nsteps ← nsteps + step[];
setin[PHI2Node,'l];
nsteps ← nsteps + step[];
ENDLOOP;
pnlist[];
RETURN[nsteps];
};
StringShiftLeft: PROC[st: STRING, offset: CARDINAL] = {
i: CARDINAL;
FOR i IN [offset..st.length) DO
st[i-offset] ← st[i]
ENDLOOP;
st.length ← st.length - offset };
-- MAIN PROGRAM
main: PROC = {
i: INTEGER;
START StdioImpl;
START SimTTable;
START WFRealImpl;
outfile ← stdout;
-- #ifdef TIMING
-- trace ← fopen["trace.out"L,"w"L];
-- #endif
FOR i ← 0, i+1 UNTIL i>=HASHSIZE DO
uhash[i] ← NIL;
hash[i] ← NIL;
ENDLOOP;
-- Allocates JaM communication: These storage are released by main
JaMResult ← SystemDefs.AllocateHeapString[400];
JaMError ← SystemDefs.AllocateHeapString[200];
-- Allocates targv
FOR i IN [0..SimTsim.MaxTargv) DO
targv[i] ← SystemDefs.AllocateHeapString[50];
ENDLOOP;
-- Allocates predefined nodes
VDDNode ← getnode["VDD"L];
setin[VDDNode,'h];
VDDNode.npot ← DHIGH;
GNDNode ← getnode["GND"L];
setin[GNDNode,'l];
GNDNode.npot ← DLOW;
PHI1Node ← getnode["phi1"L];
PHI2Node ← getnode["phi2"L];
-- Read from the command line
IF NOT MOSSIMFns.UnderJaM THEN {
argc, argno: CARDINAL;
argv: POINTER TO ARRAY [0..10) OF STRING;
argarray: ARRAY [0..10) OF STRING;
in: FILE;
argc ← 1;
argv ← @argarray;
ComParse.Open[,,];
UNTIL (argv[argc] ← ComParse.Get[ ])=NIL DO argc ← argc+1 ENDLOOP;
ComParse.Close[];
FOR argno ← 1, argno + 1 WHILE argno < argc DO
filename ← argv[argno];
IF filename[0] = '- THEN {
IF outfile # stdout THEN fclose[outfile];
IF filename.length=1 THEN { outfile ← stdout; LOOP; };
StringShiftLeft[filename, 1];
outfile ← fopen[filename,"w"L];
IF outfile = NIL THEN {
FWF1[stderr,"Cannot open output file: %s*n"L,filename];
outfile ← stdout;
};
LOOP;
};
lineno ← 0;
in ← fopen[filename,"r"L];
IF in = NIL THEN {
FWF1[stderr,"Cannot open input file: %s*n"L,filename];
LOOP;
} ELSE input[in];
fclose[in];
ENDLOOP;
FWF3[outfile,"%d transistors, %d nodes (%d pulled up)*n"L, tindex, nindex, nion];
IF outfile # stdout THEN fclose[outfile];
outfile ← stdout;
};
filename ← "tty";
lineno ← 0
}; -- end main
CleanUp: PROC = {
-- Frees all the storage
-- Frees JaM communcation area
SystemDefs.FreeHeapString[JaMResult];
SystemDefs.FreeHeapString[JaMError];
-- Frees targv
{i: CARDINAL;
FOR i IN [0..SimTsim.MaxTargv) DO
SystemDefs.FreeHeapString[targv[i]];
ENDLOOP};
-- Frees the data structures accessible from hash table
{ hnext: SimTsim.nptr; i: CARDINAL;
FOR i IN [0..HASHSIZE) DO
IF (hnext ← hash[i])#NIL THEN {
hash[i] ← NIL;
DO
IF hnext.named THEN SystemDefs.FreeHeapString[hnext.nname];
hnext ← hnext.hnext;
IF hnext = NIL THEN EXIT;
ENDLOOP}
ENDLOOP
};
{ wnext: SimTsim.wptr;
FOR wnext ← wlist, wnext.wnext UNTIL wnext=NIL DO
SystemDefs.FreeHeapString[wnext.wname];
ENDLOOP};
{ before: bptr;
DO
IF blist = NIL THEN EXIT;
before ← blist;
SystemDefs.FreeHeapString[blist.bname];
blist ← blist.bnext;
SystemDefs.FreeHeapNode[before];
ENDLOOP};
{ unext: SimTsim.uptr; i: CARDINAL;
FOR i IN [0..HASHSIZE) DO
IF (unext ← uhash[i])#NIL THEN {
uhash[i] ← NIL;
DO
SystemDefs.FreeHeapString[unext.uname];
unext.uname ← NIL;
unext ← unext.unext;
IF unext = NIL THEN EXIT;
ENDLOOP}
ENDLOOP};
-- Release all the nodes
SimStorage.FreeNodes[];
}; -- ClenaUp
-- Main program
main[];
}. -- MOSSIM