-- File: [Thyme]<Thyme>System>CSIM01>spInput.mesa
-- Last editted:
-- Wilhelm April 6, 1982 9:59 AM, reformated by Barth and stored under
-- [Cherry]<Barth>Thyme>1.97> .
DIRECTORY spGlobals, spModelDefs, AltoDefs, CWF, Real, AbsAllocDefs;
spInput: PROGRAM
IMPORTS spGlobals, CWF, Real, AbsAllocDefs
EXPORTS spGlobals, spModelDefs =
BEGIN
OPEN spGlobals;
printString: STRING = [256];
gndNodeName: PUBLIC namePtr;
undefNode: namePtr;
cktRoot: PUBLIC circuitNamePtr ← NIL;
currentCkt: circuitNamePtr ← NIL;
ModelTablePtr: TYPE = LONG POINTER TO ModelTableBlk;
ModelTableBlk: TYPE = RECORD[next: ModelTablePtr,
name: LONG STRING,
proc: spGlobals.model,
numArgs: CARDINAL,
numParms,
numResults: CARDINAL];
ModelTable: ModelTablePtr ← NIL;
FuncTablePtr: TYPE = LONG POINTER TO FuncTableBlk;
FuncTableBlk: TYPE = RECORD[next: FuncTablePtr,
name: LONG STRING,
proc: spGlobals.function,
numArgs: CARDINAL,
numParms: CARDINAL];
FuncTable: FuncTablePtr ← NIL;
EnterModels: PUBLIC PROCEDURE[name: LONG STRING,
proc: model,
numArgs: CARDINAL,
numParms,
numResults: CARDINAL] =
BEGIN
new: ModelTablePtr;
new ← AbsAllocDefs.Allocate[SIZE[ModelTableBlk]];
new↑ ← [ModelTable, name, proc, numArgs, numParms, numResults];
ModelTable ← new
END;
EnterFunctions: PUBLIC PROCEDURE[name: LONG STRING,
proc: function,
numArgs: CARDINAL,
numParms: CARDINAL] =
BEGIN
new: FuncTablePtr;
new ← AbsAllocDefs.Allocate[SIZE[FuncTableBlk]];
new↑ ← [FuncTable, name, proc, numArgs, numParms];
FuncTable ← new
END;
findModel: PROCEDURE[name: LONG STRING]
RETURNS[model, CARDINAL, CARDINAL, CARDINAL] =
BEGIN
m: ModelTablePtr;
FOR m ← ModelTable, m↑.next UNTIL m = NIL DO
IF LongEqualStrings[m↑.name, name] THEN
RETURN[m↑.proc, m↑.numArgs, m↑.numParms, m↑.numResults]
ENDLOOP;
error[501, FALSE];
RETURN[NIL, 0, 0, 0]
END;
findFunc: PROCEDURE[name: LONG STRING]
RETURNS[function, CARDINAL, CARDINAL] =
BEGIN
f: FuncTablePtr;
FOR f ← FuncTable, f↑.next UNTIL f = NIL DO
IF LongEqualStrings[f↑.name, name] THEN
RETURN[f↑.proc, f↑.numArgs, f↑.numParms]
ENDLOOP;
error[502, FALSE];
RETURN[NIL, 0, 0]
END;
enterName: PROCEDURE RETURNS[newNamePtr: namePtr] =
BEGIN
ns: LONG STRING;
newNamePtr ← searchName[newString, TRUE];
IF newNamePtr = NIL THEN
BEGIN
newNamePtr ← makeName[currentCkt↑.names];
ns ← makeLongString[newString.length];
LongStringGetsString[ns, newString];
newNamePtr↑.name ← ns;
currentCkt↑.names ← newNamePtr
END
ELSE error[250];
RETURN[newNamePtr]
END;
searchName: PROCEDURE[n: LONG STRING, oneLevel: BOOLEAN]
RETURNS[np: namePtr ← NIL] =
BEGIN
ckt: circuitNamePtr ← currentCkt;
lastName: namePtr;
UNTIL ckt = NIL DO
np ← ckt↑.names;
lastName ← NIL;
UNTIL np = NIL DO
IF LongEqualStrings[n, np↑.name] THEN GOTO found;
lastName ← np;
np ← np↑.srchLink
ENDLOOP;
IF oneLevel THEN EXIT;
ckt ← ckt↑.father
REPEAT
found =>
IF lastName # NIL THEN
BEGIN
lastName↑.srchLink ← np↑.srchLink;
np↑.srchLink ← ckt↑.names;
ckt↑.names ← np
END
ENDLOOP
END;
getNames: PROCEDURE[new: BOOLEAN] RETURNS[names: namePtr ← NIL,
nameCount: CARDINAL ← 0] =
BEGIN
nPtr: namePtr;
UNTIL item # name DO
nPtr ← IF new THEN enterName[] ELSE searchName[newString, TRUE];
IF nPtr # NIL THEN
BEGIN
nPtr↑.nextName ← names;
names ← nPtr
END;
nameCount ← nameCount + 1;
next[];
IF item # comma THEN EXIT ELSE next[];
IF item # name THEN error[208]
ENDLOOP
END;
getName: PROCEDURE[new: BOOLEAN] RETURNS[nPtr: namePtr ← NIL] =
BEGIN
IF item # name THEN error[208]
ELSE
nPtr ← IF new THEN enterName[] ELSE searchName[newString, FALSE];
IF nPtr = NIL THEN error[251];
next[]
END;
variable: PUBLIC PROCEDURE[context: circuitNamePtr]
RETURNS[nPtr: namePtr ← NIL] =
BEGIN
oldContext: circuitNamePtr;
IF context # NIL THEN
BEGIN
oldContext ← currentCkt;
currentCkt ← context;
nPtr ← searchName[newString, TRUE];
currentCkt ← oldContext
END
ELSE nPtr ← searchName[newString, FALSE];
IF nPtr = NIL THEN error[252]
ELSE
IF nPtr↑.nType # parmName AND
nPtr↑.nType # nodeName AND
nPtr↑.nType # conName THEN error[221];
next[]
END;
findNode: PROCEDURE RETURNS[n: namePtr ← undefNode] =
BEGIN
nName: namePtr;
nName ← getName[FALSE];
IF nName # NIL THEN
IF nName↑.nType # nodeName AND
nName↑.nType # conName THEN error[222]
ELSE n ← nName
END;
getFunction: PROCEDURE[na, np: CARDINAL]
RETURNS[args: argNames ← NIL,
actual: expressionPtr ← NIL] =
BEGIN
index,
index2: CARDINAL ← 0;
aname: namePtr;
newExpr: expressionPtr;
IF item = leftB THEN
BEGIN
next[];
IF na > 0 THEN
BEGIN
args ← makeArgNames[na];
UNTIL index = na DO
aname ← getName[FALSE];
args[index] ← aname;
IF aname # NIL THEN
IF aname↑.nType # conName AND
aname↑.nType # nodeName THEN error[222];
IF item = quote THEN
BEGIN
next[];
error[299]
END;
index ← index + 1;
IF item = comma THEN next[] ELSE EXIT
ENDLOOP
END;
IF na = 0 OR item = vertical THEN
BEGIN
IF item = vertical THEN next[];
UNTIL index2 = np DO
newExpr ← expression[];
newExpr↑.nextExpression ← actual;
actual ← newExpr;
index2 ← index2 + 1;
IF item = comma THEN next[] ELSE EXIT
ENDLOOP
END;
IF item = rightB THEN next[] ELSE error[202,, TRUE]
END;
IF index # na THEN error[231];
IF index2 # np THEN error[232]
END;
controlFunc: PROCEDURE[b: branchNamePtr] =
BEGIN
nptr: namePtr;
f: functionNamePtr;
na, np: CARDINAL;
next[];
IF item = name THEN
BEGIN
nptr ← searchName[newString, FALSE];
IF nptr = NIL THEN
BEGIN
f ← LOOPHOLE[makeName[NIL]];
f↑.forms ← functionName[,,,,];
[f↑.functionProc, na, np] ← findFunc[newString];
next[];
f↑.branch ← b;
b↑.controller ← f;
[f↑.funcArgs, f↑.funcParms] ← getFunction[na, np];
f↑.funcArgVec ← makeArgList[na]
END
ELSE
WITH n: nptr↑ SELECT FROM
modelName =>
BEGIN
b↑.controller ← nptr;
next[];
IF item = leftB THEN next[] ELSE error[201,, TRUE];
IF item = number THEN
BEGIN
b↑.modelIndex ← Real.FixC[value];
IF value >= LENGTH[n.modelResults] THEN
error[233];
next[]
END
ELSE error[209];
IF item = rightB THEN next[] ELSE error[202,, TRUE]
END
ENDCASE => error[223]
END
ELSE error[208]
END;
enterBranches: PROCEDURE[bName: branchNamePtr, key: keys] =
BEGIN
pNode, nNode: namePtr;
kind: elements;
IF item = leftB THEN next[] ELSE error[201,, TRUE];
pNode ← findNode[];
IF item = comma THEN next[] ELSE error[200,, TRUE];
nNode ← findNode[];
IF item = rightB THEN next[] ELSE error[202,, TRUE];
SELECT key FROM
resKey => kind ← resistor;
capKey => kind ← capacitor;
indKey => kind ← inductor;
vsKey => kind ← vSource;
isKey => kind ← iSource
ENDCASE => error[224, TRUE];
IF pNode = nNode THEN error[241];
IF bName # NIL THEN
bName↑.forms ← branchName[kind, pNode, nNode, NIL, 0, NIL];
IF item = equal THEN
BEGIN
next[];
bName↑.valExpr ← expression[]
END
ELSE
IF item = leftArrow THEN controlFunc[bName]
ELSE error[205];
END;
enterModel: PROCEDURE[mName: modelNamePtr] =
BEGIN
na, np, nr: CARDINAL;
IF item = leftArrow THEN next[] ELSE error[210];
IF item = name THEN
BEGIN
mName↑.forms ← modelName[,,,,];
[mName↑.modelProc, na, np, nr] ← findModel[newString];
next[];
[mName↑.modelArgs, mName↑.modelParms] ← getFunction[na, np];
mName↑.modelResults ← makeArgList[nr];
mName↑.modelArgVec ← makeArgList[na]
END
ELSE error[208]
END;
circuitError: PROCEDURE RETURNS[STRING] =
BEGIN
oldProc: PROCEDURE[CHARACTER];
printString.length ← 0;
oldProc ← CWF.WriteToString[printString];
printCircuitTree[currentCkt];
[] ← CWF.SetWriteProcedure[oldProc];
RETURN[printString]
END;
printCircuitTree: PROCEDURE[c: circuitNamePtr] =
BEGIN
IF c # NIL AND c↑.father # NIL THEN
BEGIN
printCircuitTree[c↑.father];
CWF.WF1["%s.", c↑.name]
END
END;
getNewParameters: PROCEDURE RETURNS[plist: parmNamePtr ← NIL,
nparms: CARDINAL ← 0] =
BEGIN
n: namePtr;
IF item = vertical THEN next[];
UNTIL item # name DO
n ← enterName[];
next[];
nparms ← nparms + 1;
IF item = leftArrow THEN
BEGIN
ENABLE
ErrorSignal =>
BEGIN
ErrorStrings[error, circuitError[], s];
n.forms ← parmName[FALSE, 0.0, plist];
GOTO badEnd
END;
next[];
n.forms ← parmName[TRUE, eval[expression[]], plist]
EXITS
badEnd => NULL
END
ELSE n.forms ← parmName[FALSE, 0.0, plist];
plist ← LOOPHOLE[n];
IF item = comma THEN next[] ELSE EXIT;
IF item # name THEN error[208]
ENDLOOP;
END;
defineCircuit: PROCEDURE[names: namePtr, root: BOOLEAN] =
BEGIN
exp: expressionPtr;
names↑.forms ← circuitName[NIL, NIL, 0, NIL, currentCkt, NIL];
currentCkt ← LOOPHOLE[names];
IF root THEN
BEGIN
cktRoot ← currentCkt;
newString ← "Undefined";
undefNode ← enterName[];
undefNode↑.forms ← nodeName[];
currentCkt↑.names ← NIL;
newString ← "Gnd";
gndNodeName ← enterName[];
gndNodeName↑.forms ← nodeName[];
next[]
END;
IF item = leftB THEN
BEGIN
next[];
IF ~root AND item # vertical THEN
BEGIN
[names, currentCkt↑.conCount] ← getNames[TRUE];
currentCkt↑.fakeNodes ← names;
UNTIL names = NIL DO
names↑.forms ← conName[];
names ← names↑.nextName
ENDLOOP
END;
IF root OR item = vertical THEN
[currentCkt↑.parms,] ← getNewParameters[];
IF item = rightB THEN next[] ELSE error[202,, TRUE]
END;
IF item = name AND searchKey[] = assertsKey THEN
BEGIN
next[];
IF item = leftB THEN
BEGIN
next[];
DO
exp ← expression[];
exp↑.nextExpression ← currentCkt↑.assertions;
currentCkt↑.assertions ← exp;
IF item = comma THEN next[] ELSE EXIT
ENDLOOP;
IF item = rightB THEN next[] ELSE error[202,, TRUE]
END
ELSE error[201]
END;
IF item = equal THEN next[] ELSE error[205, TRUE, TRUE];
IF item = leftC THEN next[] ELSE error[203, TRUE, FALSE];
DO
IF item = name THEN enterDefinition[];
IF item = rightC OR item = eof THEN EXIT;
IF item = semi THEN next[] ELSE error[206, TRUE, FALSE]
ENDLOOP;
currentCkt ←
currentCkt↑.father;
next[]
END;
getActualParameters: PROCEDURE[ckt: circuitNamePtr]
RETURNS[apList: expressionPtr ← NIL] =
BEGIN
e: expressionPtr;
IF item = vertical THEN next[];
DO
IF item # name THEN GOTO nameErr;
e ← assignExpr[ckt];
e↑.nextExpression ← apList;
apList ← e;
IF item = comma THEN next[] ELSE EXIT
REPEAT
nameErr => error[208]
ENDLOOP
END;
defCktInstance: PROCEDURE[cn: LONG STRING, iName: namePtr] =
BEGIN
cktName: namePtr;
n: namePtr;
cons: conLinkPtr ← NIL;
cCnt: CARDINAL ← 0;
noConnections: BOOLEAN;
actuals: expressionPtr ← NIL;
cktName ← searchName[cn, FALSE];
IF cktName # NIL THEN
WITH c: cktName↑ SELECT FROM
circuitName =>
BEGIN
IF item = leftB THEN
BEGIN
next[];
noConnections ← c.conCount = 0;
IF ~noConnections THEN
WHILE item = name DO
n ← findNode[];
cons ← makeConLink[cons, n];
cCnt ← cCnt + 1;
IF item = comma THEN next[] ELSE EXIT
ENDLOOP;
IF noConnections OR item = vertical THEN
actuals ← getActualParameters[@c];
IF item = rightB THEN next[] ELSE error[202,, TRUE]
END;
IF cCnt # c.conCount THEN error[260];
iName↑.forms ← cktInstance[@c, cons, actuals]
END
ENDCASE => error[225, TRUE]
ELSE error[251, TRUE]
END;
enterDefinition: PROCEDURE =
BEGIN
key: keys;
nameCount: CARDINAL;
names: namePtr;
s: STRING = [256];
explodeExpr: expressionPtr ← NIL;
[names, nameCount] ← getNames[TRUE];
IF names = NIL THEN error[208];
IF item # colon THEN error[207,, TRUE] ELSE next[];
IF item = leftP THEN
BEGIN
explodeExpr ← expression[];
IF names # NIL THEN names↑.expExpr ← explodeExpr;
IF item # implies THEN error[215,, TRUE] ELSE next[]
END;
IF item = name THEN
BEGIN
key ← searchKey[];
LongStringGetsString[s, newString];
next[];
IF key # nodeKey AND nameCount # 1 THEN error[261];
SELECT key FROM
nodeKey =>
BEGIN
IF names↑.expExpr # NIL THEN error[253];
UNTIL names = NIL DO
names↑.forms ← nodeName[];
names ← names↑.nextName
ENDLOOP;
END;
resKey, capKey, indKey, vsKey, isKey =>
enterBranches[LOOPHOLE[names], key];
circuitKey =>
BEGIN
IF names↑.expExpr # NIL THEN error[253];
defineCircuit[names, FALSE];
END;
modelKey =>
BEGIN
IF names↑.expExpr # NIL THEN error[253];
enterModel[LOOPHOLE[names]]
END;
ENDCASE =>
defCktInstance[s, names]
END
ELSE error[208, TRUE]
END;
input: PUBLIC PROCEDURE =
BEGIN
n: namePtr;
IF item # name OR searchKey[] # circuitKey THEN error[225];
n ← makeName[NIL];
n↑.name ← "Main Circuit";
defineCircuit[n, TRUE]
END;
levelSpace: PROCEDURE[level: CARDINAL] =
BEGIN
UNTIL level = 0 DO
CWF.WF0[" "];
level ← level - 1
ENDLOOP
END;
output: PUBLIC PROCEDURE[ckt: circuitNamePtr, level: CARDINAL] =
BEGIN
cLink: conLinkPtr;
np: namePtr;
np ← ckt↑.names;
UNTIL np = NIL DO
levelSpace[level];
CWF.WF1["%s", np↑.name];
WITH n: np↑ SELECT FROM
nodeName => NULL;
branchName =>
BEGIN
CWF.WF2[": branch[%s, %s]",
n.posNode↑.name,
n.negNode↑.name]
END;
circuitName =>
BEGIN
CWF.WF0[": circuit.*n"];
output[@n, level + 1]
END;
conName => NULL;
parmName =>
BEGIN
CWF.WF0[": parameter"];
IF n.default THEN CWF.WF1[" ← %13.5f", @n.dfltValue]
END;
cktInstance =>
BEGIN
CWF.WF1[": %s[", n.of↑.name];
cLink ← n.connections;
UNTIL cLink = NIL DO
CWF.WF1["%s", cLink↑.namedNode↑.name];
cLink ← cLink↑.nextLink;
IF cLink # NIL THEN CWF.WF0[", "]
ENDLOOP;
CWF.WFC[']]
END
ENDCASE;
np ← np↑.srchLink;
CWF.WF0[".*n"]
ENDLOOP
END;
END.